Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 65. - Průhledná menu v systému Windows XP

Jan Šindelář - 6.11.2002

Průhledná menu v systému Windows XP

Kdysi jsme si v našem seriálu ukazovali, jak se v systémech Windows 2000 a XP dají vytvářet průhledná či spíše poloprůhledná okna. Dost práce jsme si přitom ušetřili použitím Delphi 6, které již sami podporují interně tuto vlastnost u oken.

Dnes je na řadě hlavní menu aplikace, které rovněž může být poloprůhledné, i když to již musíme provést sami bez "pomoci" Delphi. Vytvořte si tedy nový projekt a na prázdný formulář přidejte komponentu MainMenu. Doplňte do něj nějaké testovací položky, abychom mohli vidět výsledek našeho pokusu a pak již stačí jen přidat do kódu několik funkcí a nastavit události OnCreate a OnDestroy formuláře. Výsledný kód tedy může vypadat například takto (rozdíly budou pochopitelně v položkách a názvu menu, které si zvolíte):

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    estovacimenu1: TMenuItem;
    Prvnpoloka1: TMenuItem;
    Druhpoloka1: TMenuItem;
    etpoloka1: TMenuItem;
    DruheMenu1: TMenuItem;
    N211: TMenuItem;
    N221: TMenuItem;
    N231: TMenuItem;
    retimenu1: TMenuItem;
    N311: TMenuItem;
    N31: TMenuItem;
    Ctvrtemenu1: TMenuItem;
    N411: TMenuItem;
    N421: TMenuItem;
    N431: TMenuItem;
    Patemenu1: TMenuItem;
    N511: TMenuItem;
    N521: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
      hHookID: HHOOK;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function MakeWndTrans(Wnd: HWND; nAlpha: Integer = 10): Boolean;
type
  TSetLayeredWindowAttributes = function(hwnd: HWND; crKey: COLORREF; bAlpha: Byte; dwFlags: Longint): Longint; stdcall;
const
  LWA_COLORKEY = 1;
  LWA_ALPHA = 2;
  WS_EX_LAYERED = $80000;
var
  hUser32: HMODULE;
  SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
begin
  Result := False;
  hUser32 := GetModuleHandle(`USER32.DLL`);
  if hUser32 <> 0 then
  begin
    @SetLayeredWindowAttributes := GetProcAddress(hUser32,`SetLayeredWindowAttributes`);
    if @SetLayeredWindowAttributes <> nil then
    begin
      SetWindowLong(Wnd, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE) or WS_EX_LAYERED);
      SetLayeredWindowAttributes(Wnd, 0, Trunc((255 / 100) * (100 - nAlpha)), LWA_ALPHA);
      Result := True;
    end;
  end;
end;

function HookCallWndProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
const
  MENU_CLASS = `#32768`;
  N_ALPHA = 60;
var
  cwps: TCWPStruct;
  szClass: array[0..8] of char;
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, MENU_CLASS) = 0) then MakeWndTrans(cwps.hwnd, N_ALPHA);
        end;
    end;
  end;
  Result := CallNextHookEx(WH_CALLWNDPROC, nCode, wParam, lParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  tpid: DWORD;
begin
  tpid := GetWindowThreadProcessId(Handle, nil);
  hHookID := SetWindowsHookEx(WH_CALLWNDPROC, HookCallWndProc, 0, tpid);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if (hHookID <> 0) then UnhookWindowsHookEx(hHookID);
end;

end.

Nezapomeňte přiřadit události OnCreate a OnDestroy a příklad by již měl fungovat. Ještě zbývá říci několik detailů. Kromě samotného hlavního menu, které si do aplikace přidáte, tato průhlednost "postihne" i menu systémové, tedy to, které se zobrazí po kliknutí na ikonku aplikace na jejím titulkovém pruhu. Příklad by měl teoreticky fungovat i pod Windows 2000, které tuto funkci rovněž podporují, ale bohužel na mém počítači fungoval příklad dobře jen pod Windows XP a v systému Windows 2000 se menu chovalo velmi podivně - průhledně se zobrazovalo každé druhé submenu, ostatní byla zobrazena normálně. Budu rád, pokud se někdo pokusí odhalit v kódu nedostatek či chybu a toto podivné chování pod Windows 2000 tím vysvětlit. Co se týče ostatních starších systémů řady 9x, stejně jako u předchozích tipů se není třeba obávat nekompatibility či chybových hlášení. Menu se prostě bez problému zobrazí klasickým způsobem.