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()添加到邮件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挂钩而不是操纵窗口消息：

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;

如何使TPopupmenu透明？

1 个答案: