Delphi Tips 
-----------------------------

0289  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/12/19 Atsushi Shinoda rev 1.3
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/12/28 osamu 編集
Windows2000の新APIを使った半透明ウィンドウ

最近、雑誌の付録についていたWin2kRC2をインストールして「半透明ウィンドウを作ってみよう」と思い立ち、TClock(KAZUBON氏作のフリーソフト)のソースファイルを参考に作ってみたので紹介します。
ウィンドウの拡張スタイルにWS_EX_LAYEREDを指定して、SetLayeredWindowAttributesというAPIを使います。このAPIの詳細は http://msdn.microsoft.com/library/psdk/winui/windows_1p6b.htm を参照してください。(英語)
Win2kを使っている方は、ちょっとした遊びのつもりで試してみてください。(^^;;;

FormにScrollBarを1つ置いて、FormCreate, FormDestroy, ScrollBar1Changeのイベントを使っています。ScrollBarを動かすと、Formの透明度が変化します。


{API宣言}
type
  TSetLayeredWindowAttributes
    = function(wnd: HWND; crKey: DWORD;
        bAlpha: BYTE; dwFlag: DWORD): Boolean; stdcall;

const
  WS_EX_LAYERED = $80000;
  LWA_ALPHA = 2;

var
  hLibUser32: THandle;
  MySetLayeredWindowAttributes: TSetLayeredWindowAttributes;


implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  p: Pointer;
begin
  hLibUser32 := LoadLibraryA('user32.dll');
  MySetLayeredWindowAttributes := nil;
  if hLibUser32 <> 0 then begin
    p := GetProcAddress(hLibUser32, 'SetLayeredWindowAttributes');
    if p = nil then begin
      FreeLibrary(hLibUser32);
      hLibUser32 := 0;
    end else begin
      MySetLayeredWindowAttributes := TSetLayeredWindowAttributes(p);
    end;
  end;
  if hLibUser32 <> 0 then begin
    SetWindowLong(Handle, GWL_EXSTYLE,
      GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
    ScrollBar1.Position := ScrollBar1.Max;
    ScrollBar1Change(Self);
  end else begin
    ShowMessage('OSが半透明ウィンドウに対応していません!');
    Application.Terminate;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if hLibUser32 <> 0 then begin
     FreeLibrary(hLibUser32);
     hLibUser32 := 0;
  end;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
var
  alpha: Integer;
begin
  if hLibUser32 <> 0 then begin
    alpha := ScrollBar1.Position;
    alpha := alpha * 255 div (ScrollBar1.Max - ScrollBar1.Min);
    if alpha < 8 then alpha := 8;
    if alpha > 255 then alpha := 255;
    MySetLayeredWindowAttributes(Handle, 0, Byte(alpha), LWA_ALPHA);
  end;
end;

参照: [Delphi-ML:44902] <その他Windows関連> <Windows>

[新規作成] [最新の情報に更新]

How To
Lounge
KeyWords


Tips
Delphi
Home
Osamu Takeuchi osamu@big.or.jp