Reputation: 16492
I'm adding the WS_EX_LAYERED
style to the menu window handle in order to make the TPopupMenu transparent but the code is not working, I mean a the menu is not transparent.
This is the code which I'm using
var
hHookID: HHOOK;
function HookCallWndProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
var
cwps: TCWPStruct;
lRet: THandle;
szClass: array[0..256] of char;
dwNewLong : NativeInt;
begin
if (nCode = HC_ACTION) then
begin
CopyMemory(@cwps, Pointer(lParam), SizeOf(CWPSTRUCT));
case cwps.message of
WM_CREATE:
begin
GetClassName(cwps.hwnd, szClass, Length(szClass)-1);
if (lstrcmpi(szClass, '#32768') = 0) then
begin
dwNewLong := GetWindowLongPtr(cwps.hwnd, GWL_EXSTYLE);
if (dwNewLong and WS_EX_LAYERED) = 0 then
begin
SetWindowLongPtr(cwps.hwnd, GWL_EXSTYLE, dwNewLong or WS_EX_LAYERED);
SetLayeredWindowAttributes(cwps.hwnd, 0, 180, LWA_ALPHA);
end;
end;
end;
end;
end;
Result := CallNextHookEx(WH_CALLWNDPROC, nCode, wParam, lParam);
end;
procedure TForm4.FormDestroy(Sender: TObject);
begin
if (hHookID<>0) then
UnhookWindowsHookEx(hHookID);
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
hHookID := SetWindowsHookEx(WH_CALLWNDPROC, @HookCallWndProc, 0, GetWindowThreadProcessId(Handle, 0));
end;
Any ideas of how make a TPopupmenu transparent or why the above code is not working?
Upvotes: 2
Views: 348
Reputation: 598448
The last parameter of SetWindowsHookEx()
should be changed to GetCurrentThreadId()
.
Inside your hook, WM_CREATE
has not been processed by the window yet, so instead of using Get/SetWindowLongPtr()
, try adding WS_EX_LAYERED
to the message's dwExStyle
field before then calling CallNextHookEx()
(which you need to fix). And since the window is still being created and its style has not been applied yet, you will have to delay the call to SetLayeredWindowAttributes()
.
Try this:
var
hHookID: HHOOK = 0;
function HookCallWndProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
cwps: PCWPStruct;
szClass: array[0..256] of Char;
begin
if (nCode = HC_ACTION) then
begin
cwps := PCWPStruct(lParam);
case cwps.message of
WM_CREATE, WM_NCCREATE:
begin
GetClassName(cwps.hwnd, szClass, Length(szClass)-1);
if (lstrcmpi(szClass, '#32768') = 0) then
begin
with PCreateStruct(cwps.lParam)^ do
dwExStyle := dwExStyle or WS_EX_LAYERED;
end;
end;
WM_ACTIVATE:
begin
GetClassName(cwps.hwnd, szClass, Length(szClass)-1);
if (lstrcmpi(szClass, '#32768') = 0) then
SetLayeredWindowAttributes(cwps.hwnd, 0, 180, LWA_ALPHA);
end;
end;
end;
Result := CallNextHookEx(hHookID, nCode, wParam, lParam);
end;
procedure TForm4.FormDestroy(Sender: TObject);
begin
if (hHookID<>0) then
UnhookWindowsHookEx(hHookID);
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
hHookID := SetWindowsHookEx(WH_CALLWNDPROC, @HookCallWndProc, 0, GetCurrentThreadId());
end;
With that said, I would suggest using a WH_CBT
hook instead of manipulating window messages:
var
hHookID: HHOOK = 0;
function HookCBTProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
szClass: array[0..256] of Char;
dwNewLong: LONG_PTR;
begin
if (nCode = HCBT_ACTIVATE) then
begin
GetClassName(HWND(wParam), szClass, Length(szClass)-1);
if (lstrcmpi(szClass, '#32768') = 0) then
begin
dwNewLong := GetWindowLongPtr(HWND(wParam), GWL_EXSTYLE);
if (dwNewLong and WS_EX_LAYERED) = 0 then
begin
SetWindowLongPtr(HWND(wParam), GWL_EXSTYLE, dwNewLong or WS_EX_LAYERED);
SetLayeredWindowAttributes(HWND(wParam), 0, 180, LWA_ALPHA);
end;
end;
end;
Result := CallNextHookEx(hHookID, nCode, wParam, lParam);
end;
procedure TForm4.FormDestroy(Sender: TObject);
begin
if (hHookID<>0) then
UnhookWindowsHookEx(hHookID);
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
hHookID := SetWindowsHookEx(WH_CBT, @HookCBTProc, 0, GetCurrentThreadId());
end;
Upvotes: 1