Registriert seit: 22. Sep 2003
20 Beiträge
Delphi 10 Seattle Professional
|
Re: Auf nonVCL Button Zeichnen Wie?
11. Okt 2004, 01:19
Hallo,
wollte gerade Posten das ich herausgefunden habe wie es geht. Aber trotzdem besten dank für eure Posts es war genau das was ich gesucht habe. Habe es so wie scp beschrieben hat gemacht. Obendrein war da noch das Problem dass wenn die Maus über dem Button schwebt kein WM_DRAWITEM ausgelöst wurde und ebenso nicht wenn Sie ihn verläst. Musste dies selbst implementieren in dem ich dem Button die WndProc geklaut habe. Poste dies mal hier noch mit falls noch jemand dieses Problem hat.
Delphi-Quellcode:
uses
XPTheme,
Windows,
Messages,
...;
const
IDC_BUTTON_1 = 19;
var
hButton_1 : DWORD;
//
// "BtnWndProc"
//
var
MsInBtn1,
BtnLM : Boolean;
DefBtnProc : Pointer;
function BtnWndProc(wnd: HWND; uMsg: UINT; wp: wParam; lp: LParam): LRESULT;
stdcall;
var
TME : TTrackMouseEvent;
TME_Proc : function(var EventTrack: TTrackMouseEvent): BOOL; stdcall;
begin
Result := 0;
case uMsg of
WM_LBUTTONDOWN:
begin
BtnLM := True;
Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
end;
WM_LBUTTONUP:
begin
BtnLM := False;
Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
end;
WM_MOUSEHOVER:
begin
if MsInBtn1 or BtnLM then exit;
MsInBtn1 := True;
RedrawWindow(wnd, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME);
Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
end;
WM_MOUSELEAVE:
begin
if not MsInBtn1 or BtnLM then exit;
MsInBtn1 := False;
RedrawWindow(wnd, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME);
Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
end;
WM_MOUSEMOVE:
begin
TME.cbSize := sizeof(TTrackMouseEvent);
TME.dwFlags := TME_HOVER or TME_LEAVE;
TME.dwHoverTime := 10;
TME.hwndTrack := hButton_1;
TME_Proc := @TrackMouseEvent;
TME_Proc(TME);
Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
end;
else
Result := CallWindowProc(DefBtnProc, wnd, uMsg, wp, lp);
end;
end;
//
// "WndProc"
//
function WndProc(wnd: HWND; uMsg: UINT; wp: wParam; lp: LParam): LRESULT;
stdcall;
var
Details : TThemedElementDetails;
begin
Result := 0;
case uMsg of
WM_CREATE:
begin
...
// Button erzeugen
hButton_1 := CreateWindowEx(0, 'BUTTON', 'x', WS_VISIBLE or WS_CHILD or
BS_OWNERDRAW, 255,0,13,13, Wnd, IDC_BUTTON_1, hInstance,nil);
DefBtnProc := Pointer(GetWindowLong(hButton_1, GWL_WNDPROC));
SetWindowLong(hButton_1, GWL_WNDPROC, Integer(@BtnWndProc));
...
end;
WM_THEMECHANGED:
UpdateThemes;
WM_DRAWITEM:
case wp of
IDC_BUTTON_1:
begin
with PDrawItemStruct(lp)^ do
if MsInBtn1 and not BtnLM then
itemState := itemState or ODS_HOTLIGHT
else
itemState := itemState and not ODS_HOTLIGHT;
Details := GetElementDetails(ttbButtonNormal);
DrawParentBackground(hButton_1, hDC, @Details, True);
DrawButton(hButton_1, PDrawItemStruct(lp)^);
end;
end;
end;
WM_COMMAND:
case LOWORD(wp) of
IDC_BUTTON_1:
begin
if HIWORD(wp) = BN_CLICKED then SendMessage(wnd,WM_CLOSE,0,0);
end;
end;
WM_DESTROY:
begin
SetWindowLong(hButton_1, GWL_WNDPROC, Integer(DefBtnProc));
DestroyThemeServices;
PostQuitMessage(0);
end;
else
Result := DefWindowProc(wnd,uMsg,wp,lp);
end;
end;
Gruß Thomas
|