窗体上的控件
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.
