<pre>
var
FHook: hHook = 0;
FAtom: TAtom = 0;<br>
function MenuWndProc(hWnd: hWnd; Msg: Integer; wParam: WParam; lParam: LParam): LResult; stdcall;<br>
// alle Messages eines TPopupMenu->Windows->Fensterhandle
var
PrevFunc: Pointer;
DC: hDC;
B: hBrush;
R: TRect;
begin
THandle(PrevFunc) := GetProp(hWnd, MakeIntAtom(FAtom));
case Msg of
wm_Paint:
begin
end;
wm_NCPaint:
begin
DC := GetWindowDC(hWnd);
if DC <> 0 then
try
GetWindowRect(hWnd, R);
OffsetRect(R, -R.Left, -R.Top);
B := CreateSolidBrush(ColorToRGB(clMenu));
try
// zeichne eine schwarzen 1 Pixel Rahmen um's PopupMenu
FrameRect(DC, R, GetStockObject(BLACK_BRUSH));
InflateRect(R, -1, -1);
FrameRect(DC, R, B);
InflateRect(R, -1, -1);
FrameRect(DC, R, B);
finally
DeleteObject(B);
end;
finally
ReleaseDC(hWnd, DC);
end;
Result := 0;
Exit;
end;
wm_NCDestroy, wm_Destroy:
begin
RemoveProp(hWnd, MakeIntAtom(FAtom)); // wichtig sonst leaks !
end;
end;
if PrevFunc <> nil then Result := CallWindowProc(PrevFunc, hWnd, Msg, wParam, lParam)
else Result := 0;
end;<br>
function CallWndProcHook(Code: Integer; wParam: WParam; lParam: LParam): LResult; stdcall;
var
PrevWndProc: THandle;
Style: Integer;
begin
if lParam <> 0 then
with PCWPStruct(lParam)^ do
begin
case Message of
// 1. Methode, dynamisches SubClassing !
wm_Create:
with PCreateStruct(lParam)^ do
if lpszClass = MakeIntResource(32768) then // ist eine #POPUP# class
begin
PrevWndProc := GetProp(hWnd, MakeIntResource(FAtom));
if (PrevWndProc = 0) and (GetWindowLong(hWnd, gwl_WndProc) <> Integer(@MenuWndProc)) then
begin
PrevWndProc := GetWindowLong(hWnd, gwl_WndProc);
SetProp(hWnd, MakeIntResource(FAtom), PrevWndProc);
SetWindowLong(hWnd, gwl_WndProc, Integer(@MenuWndProc));
end;
end;
end;
end;
Result := CallNextHookEx(FHook, Code, wParam, lParam);
end;<br>
initialization
FAtom := GlobalAddAtom(PChar(Format('POPUPMENUHOOK_PREVWNDP ROC_%0.8x', [MainThreadID])));
FHook := SetWindowsHookEx(WH_CALLWNDPROC, CallWndProcHook, 0, MainThreadID);
finalization
UnhookWindowsHookEx(FHook);
GlobalDeleteAtom(FAtom);
end.<br>
</pre>
Gruß Hage
var
FHook: hHook = 0;
FAtom: TAtom = 0;<br>
function MenuWndProc(hWnd: hWnd; Msg: Integer; wParam: WParam; lParam: LParam): LResult; stdcall;<br>
// alle Messages eines TPopupMenu->Windows->Fensterhandle
var
PrevFunc: Pointer;
DC: hDC;
B: hBrush;
R: TRect;
begin
THandle(PrevFunc) := GetProp(hWnd, MakeIntAtom(FAtom));
case Msg of
wm_Paint:
begin
end;
wm_NCPaint:
begin
DC := GetWindowDC(hWnd);
if DC <> 0 then
try
GetWindowRect(hWnd, R);
OffsetRect(R, -R.Left, -R.Top);
B := CreateSolidBrush(ColorToRGB(clMenu));
try
// zeichne eine schwarzen 1 Pixel Rahmen um's PopupMenu
FrameRect(DC, R, GetStockObject(BLACK_BRUSH));
InflateRect(R, -1, -1);
FrameRect(DC, R, B);
InflateRect(R, -1, -1);
FrameRect(DC, R, B);
finally
DeleteObject(B);
end;
finally
ReleaseDC(hWnd, DC);
end;
Result := 0;
Exit;
end;
wm_NCDestroy, wm_Destroy:
begin
RemoveProp(hWnd, MakeIntAtom(FAtom)); // wichtig sonst leaks !
end;
end;
if PrevFunc <> nil then Result := CallWindowProc(PrevFunc, hWnd, Msg, wParam, lParam)
else Result := 0;
end;<br>
function CallWndProcHook(Code: Integer; wParam: WParam; lParam: LParam): LResult; stdcall;
var
PrevWndProc: THandle;
Style: Integer;
begin
if lParam <> 0 then
with PCWPStruct(lParam)^ do
begin
case Message of
// 1. Methode, dynamisches SubClassing !
wm_Create:
with PCreateStruct(lParam)^ do
if lpszClass = MakeIntResource(32768) then // ist eine #POPUP# class
begin
PrevWndProc := GetProp(hWnd, MakeIntResource(FAtom));
if (PrevWndProc = 0) and (GetWindowLong(hWnd, gwl_WndProc) <> Integer(@MenuWndProc)) then
begin
PrevWndProc := GetWindowLong(hWnd, gwl_WndProc);
SetProp(hWnd, MakeIntResource(FAtom), PrevWndProc);
SetWindowLong(hWnd, gwl_WndProc, Integer(@MenuWndProc));
end;
end;
end;
end;
Result := CallNextHookEx(FHook, Code, wParam, lParam);
end;<br>
initialization
FAtom := GlobalAddAtom(PChar(Format('POPUPMENUHOOK_PREVWNDP ROC_%0.8x', [MainThreadID])));
FHook := SetWindowsHookEx(WH_CALLWNDPROC, CallWndProcHook, 0, MainThreadID);
finalization
UnhookWindowsHookEx(FHook);
GlobalDeleteAtom(FAtom);
end.<br>
</pre>
Gruß Hage
Comment