[BlueLeaf1336]> PROGRAM>

透き通るメニュー

historyTOP

2005/03/21:作成

overviewTOP

Windows2000以降では、フォームのプロパティに「AlphaBlend / AlphaBlendValue」というのがありまして、フォームを透き通らせることができます。ところが、メインメニューやポップアップメニューは透き通りません。コレを透き通らせましょう、というのが目的です。

まず、一つ目に、Windows2000でしか試していません。XPではどうなるか知りません。また、メニューに効果をつけていると駄目です(フェードとか)。

次に、これは The Code Project - Free Source Code and Tutorials からのパクリだということです。単なるバージョンダウンを含んだ C => Delphi 翻訳物です。

ソースコードTOP

基本方針は非常に簡単です。それは結果だけを掠め取らせてもらったからですが。要は、メニューが作られるたびに、透明な効果をつけるということです。 

var
    HookHandle: HHOOK = 0;
const
    FORM_ALPHA = 255;
    MENU_ALPHA = 220;

//-----------------------------------------------------------------------------
//  フック中
function HookCallWndProc(nCode: Integer; wParam: WPARAM; pEvnt: PEventMsg): LRESULT; stdcall;
var
    cwps: TCWPStruct;
    szClass: array[0..127] of Char;
begin
    //  規則どおり
    if (nCode = HC_ACTION) then
    begin
        //  使いにくいのでキャストする
        cwps := PCWPStruct(pEvnt)^;
        //  作成のタイミングで
        if (cwps.message = WM_CREATE) then
        begin
            //  作成されるウィンドウのクラス名を取得する
            FillChar(szClass, SizeOf(szClass), 0);
            GetClassName(cwps.hwnd, szClass, 127);
            //  コレがダイアログ(メニューもダイアログと同じクラス名)なら
            if (szClass = '#32768') then
            begin
                //  今のスタイルに透き通るスタイルを付け加えて
                SetWindowLong(cwps.hwnd, GWL_EXSTYLE,
                              GetWindowLong(cwps.hwnd, GWL_EXSTYLE) or WS_EX_LAYERED);
                //  透明度を設定する
                SetLayeredWindowAttributes(cwps.hwnd, 0, MENU_ALPHA, LWA_ALPHA);
            end;
        end;
    end;
    //  ちゃんとやってくれる人に任せる
    Result := CallNextHookEx(WH_CALLWNDPROC, nCode, wParam, Longint(pEvnt));
end;

//-----------------------------------------------------------------------------
//  フックする
procedure TForm1.FormCreate(Sender: TObject);
begin
    Self.AlphaBlendValue := FORM_ALPHA;
    HookHandle := SetWindowsHookEx(WH_CALLWNDPROC, @HookCallWndProc, 0,
                                    GetWindowThreadProcessId(Handle));
end;

//-----------------------------------------------------------------------------
//  フックをやめる
procedure TForm1.FormDestroy(Sender: TObject);
begin
    if (HookHandle <> 0) then UnhookWindowsHookEx(HookHandle);
    HookHandle := 0;
end;

実行結果・ダウンロードTOP

GlassMenu.zip(163,863bytes)

EOFTOP