如何使 TPopupmenu 透明？

Question

我将WS_EX_LAYERED 样式添加到菜单窗口句柄以使 TPopupMenu 透明但代码不起作用，我的意思是菜单不透明。

这是我正在使用的代码

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;

关于如何使 TPopupmenu 透明或为什么上述代码不起作用的任何想法？

Answer 1

SetWindowsHookEx()的最后一个参数要改成GetCurrentThreadId()。

在你的钩子中，WM_CREATE 还没有被窗口处理，所以不要使用Get/SetWindowLongPtr()，而是尝试在消息的dwExStyle 字段中添加WS_EX_LAYERED，然后再调用CallNextHookEx()（你需要使固定）。而且由于窗口仍在创建中，其样式尚未应用，您将不得不延迟对SetLayeredWindowAttributes() 的调用。

试试这个：

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;

话虽如此，我建议使用WH_CBT 挂钩而不是操纵窗口消息：

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;