delphi - 如何使 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()。

在您的 Hook 内，WM_CREATE 尚未被窗口处理，因此不要使用 Get/SetWindowLongPtr()，而是尝试添加 WS_EX_LAYERED > 到消息的 dwExStyle 字段，然后调用 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 Hook 而不是操作窗口消息:

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;