delphi设置窗体透明度

窗体上的控件

PopupMenu; TrackBar1; Label1;

窗体上的代码

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, ShellAPI, Menus;

const WM_TRAYICON = WM_APP+0;

type

PRec = ^TRec;

TRec = record

Wnd:THandle;

bBlend : Boolean;

ClsName:String;

WndName:String;

pNID : PNOTIFYICONDATA;

end;

TForm1 = class(TForm)

PopupMenu: TPopupMenu;

TrackBar1: TTrackBar;

Label1: TLabel;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure TrackBar1Change(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure TrackBar1Exit(Sender: TObject);

private

{ Private declarations }

nid : TNOTIFYICONDATA;

WndList : TList;

procedure WMTrayIcon(var message: TMessage); message WM_TRAYICON;

procedure UpdatePopupMenu;

procedure DeActivate(Sender : TOBject);

procedure MenuItemOnClick(Sender : TObject);

procedure ExitMenuItemOnClick(Sender : TObject);

protected

procedure CreateParams(var Params: TCreateParams); OVERRIDE;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

WndList := TList.Create;

with nid do

begin

cbSize := sizeof(TNotifyIconData);

UID := UINT(-1);

uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;

Wnd := Handle;

// 璝祇ネヴㄆン, 癟肚患倒 Wnd 跌怠

uCallBackMessage := WM_TRAYICON;

// 籔祘Αセōㄏノ妓瓜ボ

HICON := Application.Icon.Handle;

// 矗ボゅ籔祘Α夹肈

StrPCopy(szTip, Application.Title);

end;

Shell_NotifyIcon(NIM_ADD, @nid);

Width := 80;

Application.OnDeactivate := DeActivate;

end;

procedure TForm1.FormDestroy(Sender: TObject);

var

iLoop : integer;

begin

for iLoop := 0 to WndList.Count-1 do

Dispose(WndList.items[iLoop]);

Shell_NotifyIcon(NIM_DELETE,@nid);

end;

procedure TForm1.UpdatePopupMenu;

var

clsname,wndname : array [0..100] of char;

iLoop,iTag : integer;

hCurWnd : HWND;

iMenu : TMenuItem;

Rec : PRec;

begin

PopupMenu.Items.Clear;

iLoop := 0;

iTag := 0;

{ 穝 WndList 戈才ヘ玡跌怠篈 }

while ( iLoop < WndList.Count-1 ) do

begin

Rec := WndList.Items[iLoop];

if not IsWindow(Rec^.Wnd) then

begin

Dispose(WndList.Items[iLoop]);

WndList.Delete(iLoop);

continue;

end;

iMenu := TMenuItem.Create(PopupMenu);

iMenu.Caption := Rec^.WndName;

iMenu.Tag := iTag;

iMenu.Checked := Rec^.bBlend;

iMenu.OnClick := MenuItemOnClick;

PopupMenu.Items.Add(iMenu);

Inc(iLoop);

inc(iTag);

end;

{ 穝苯磞┮Τ跌怠盢穝糤跌怠 WndList い }

hCurWnd := GetWindow(Handle,GW_HWNDFIRST);

while( hCurWnd <> 0 ) do

begin

GetClassName( hCurWnd, clsname, 100 );

if( GetWindowText( hCurWnd, Wndname, 100) > 0 ) and IsWindowVisible( hCurWnd ) and

( WndName <> 'Program Manager') then

begin

if PopupMenu.Items.Find( Wndname ) = nil then

begin

New(Rec);

Rec^.Wnd := hCurWnd;

Rec^.bBlend := FALSE;

Rec^.ClsName := clsname;

Rec^.WndName := WndName;

WndList.Add(Rec);

iMenu := TMenuItem.Create(PopupMenu);

iMenu.Caption := WndName;

iMenu.OnClick := MenuItemOnClick;

iMenu.Tag := iTag;

PopupMenu.Items.add(iMenu);

inc(iTag);

end

else

begin

iMenu := PopupMenu.Items.Find( WndName );

for iLoop := iMenu.Tag to WndList.Count-1 do

begin

Rec := WndList.Items[ iLoop ];

if (Rec^.Wnd = hCurWnd) and (Rec^.WndName = iMenu.Caption) then

break;

end;

if( iLoop >= (WndList.Count-1) ) and ( Rec^.Wnd <> hCurWnd ) then

begin

New(Rec);

Rec^.Wnd := hCurWnd;

Rec^.bBlend := FALSE;

Rec^.ClsName := clsname;

Rec^.WndName := WndName;

WndList.Add(Rec);

iMenu := TMenuItem.Create(PopupMenu);

iMenu.Caption := WndName;

iMenu.OnClick := MenuItemOnClick;

iMenu.Tag := iTag;

PopupMenu.Items.add(iMenu);

inc(iTag);

end;

end;

end;

hCurWnd := GetWindow( hCurWnd, GW_HWNDNEXT );

end;

{ だ筳絬 PopupMenu }

iMenu := TMenuItem.Create(PopupMenu);

iMenu.Caption := '-';

PopupMenu.Items.Add(iMenu);

{  Exit  PopupMenu }

iMenu := TMenuItem.create(PopupMenu);

iMenu.Caption := 'Close';

iMenu.OnClick := ExitMenuItemOnClick;

PopupMenu.Items.Add(iMenu);

end;

procedure TForm1.WMTrayIcon(var message: TMessage);

var

MousePos: TPoint;

begin

if message.LPARAM = WM_RBUTTONDOWN then

begin

ShowWindow(Handle,SW_HIDE);

UpdatePopupMenu;

GetCursorPos(MousePos);

SetForegroundWindow(Handle); // 琵 PopupMenu 瞷ㄤ跌怠笆ア

PopupMenu.Popup(MousePos.X, MousePos.Y);

end

else if message.LParam = WM_LBUTTONDOWN then

begin

GetCursorPos(MousePos);

SetForegroundWindow(Handle); // 琵Form1 瞷ㄤ跌怠笆ア

ShowWindow(Handle,SW_NORMAL);

MoveWindow(Handle,MousePos.X-Width,MousePos.Y-Height-16,Width,Height,TRUE);

end;

end;

procedure TForm1.MenuItemOnClick(Sender: TObject);

var

Menu : TMenuItem;

Rec : PRec;

begin

Menu := TMenuItem(Sender);

Rec := WndList.Items[Menu.Tag];

Rec^.bBlend := not Rec^.bBlend;

if( Rec^.bBlend ) then

begin

{ 盢跌怠砞硓 }

SetWindowLong( Rec^.Wnd,GWL_EXSTYLE,GetWindowLong(Rec^.Wnd,GWL_EXSTYLE) or WS_EX_LAYERED);

SetLayeredWindowAttributes(Rec^.Wnd,RGB(0,0,0),TrackBar1.Position,LWA_ALPHA);

end

else

begin

{ 临跌怠硓砞﹚ }

SetLayeredWindowAttributes(Rec^.Wnd,RGB(0,0,0),255,LWA_ALPHA);

SetWindowLong( Rec^.Wnd,GWL_EXSTYLE,GetWindowLong(Rec^.Wnd,GWL_EXSTYLE) and (NOT WS_EX_LAYERED) );

end;

end;

procedure TForm1.FormActivate(Sender: TObject);

begin

ShowWindow(Handle,SW_HIDE);

ShowWindow(Application.Handle, SW_HIDE );

end;

procedure TForm1.TrackBar1Change(Sender: TObject);

var

iLoop :integer;

Rec : PRec;

begin

for iLoop := 0 to WndList.Count-1 do

begin

Rec := WndList.Items[iLoop];

if Rec^.bBlend then

SetLayeredWindowAttributes(Rec^.Wnd,RGB(0,0,0),TrackBar1.Position,LWA_ALPHA)

end;

end;

procedure TForm1.ExitMenuItemOnClick(Sender: TObject);

begin

Close;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

var

iLoop : integer;

Rec : PRec;

begin

for iLoop := 0 to WndList.Count-1 do

begin

Rec := WndList.Items[iLoop];

if Rec^.bBlend then

begin

SetWindowLong( Rec^.Wnd,GWL_EXSTYLE,GetWindowLong(Rec^.Wnd,GWL_EXSTYLE) xor WS_EX_LAYERED);

end;

end;

end;

procedure TForm1.TrackBar1Exit(Sender: TObject);

begin

ShowWindow(Handle, SW_HIDE);

end;

procedure TForm1.DeActivate(Sender: TOBject);

begin

ShowWindow(Handle, SW_HIDE);

end;

procedure TForm1.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

With Params do

Style := (Style or WS_POPUP) and (not WS_DLGFRAME) ;

end;

end.