CODEWITHSUNDEEP
delphidelphi-xe4
Salvador
Salvador

Reputation: 16492

How make a TPopupmenu transparent?

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

Answers (1)

Remy Lebeau
Remy Lebeau

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

Related Questions