Delphi 最小化到托盘

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShellAPI;
const
WM_BARICON=WM_USER+200;
type
TForm1 = class(TForm)
private
    procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
    procedure WMBarIcon(var Message:TMessage);message WM_BARICON;
public
    { Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMSysCommand (var Message:TMessage);
var
    lpData:PNotifyIconData;
begin
   if Message.WParam = SC_ICON then
   begin
      //如果用户最小化窗口则将窗口隐藏并在任务栏上添加图标
     lpData := new(PNotifyIconDataA);
     lpData.cbSize := 88;
     lpData.Wnd := Form1.Handle;
     lpData.hIcon := Form1.Icon.Handle;
     lpData.uCallbackMessage := WM_BARICON;
     lpData.uID :=0;
     lpData.szTip := '托管';
     lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
     Shell_NotifyIcon(NIM_ADD,lpData);
     dispose(lpData);
     Form1.Visible := False;
   end
   else
   begin//如果是其它的SystemCommand消息则调用系统缺省处理函数处理之。
     DefWindowProc(Form1.Handle,Message.Msg,Message.WParam,Message.LParam);
   end;
end;

procedure TForm1.WMBarIcon(var Message:TMessage);
var
lpData:PNotifyIconData;
begin
if (Message.LParam = WM_LBUTTONDOWN) then
begin//如果用户点击任务栏图标则将图标删除并回复窗口。
    lpData := new(PNotifyIconDataA);
    lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
    lpData.Wnd := Form1.Handle;
    lpData.hIcon := Form1.Icon.Handle;
    lpData.uCallbackMessage := WM_BARICON;
    lpData.uID :=0;
    lpData.szTip := '托管';
    lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    Shell_NotifyIcon(NIM_DELETE,lpData);
    dispose(lpData);
    Form1.Visible := True;
   end;
end;

end.

 

F9，测试通过！

 

********************************清除多余托盘图标***********************************

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShellAPI;
const
WM_BARICON=WM_USER+200;
type
   TOSVersion = (osUnknown, os95, os98, osME, osNT3, osNT4, os2K, osXP, os2K3);

TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
private
    procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
    procedure WMBarIcon(var Message:TMessage);message WM_BARICON;
public
    { Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMSysCommand (var Message:TMessage);
var
    lpData:PNotifyIconData;
begin
   if Message.WParam = SC_ICON then
   begin
      //如果用户最小化窗口则将窗口隐藏并在任务栏上添加图标
     lpData := new(PNotifyIconDataA);
     lpData.cbSize := 88;
     lpData.Wnd := Form1.Handle;
     lpData.hIcon := Form1.Icon.Handle;
     lpData.uCallbackMessage := WM_BARICON;
     lpData.uID :=0;
     lpData.szTip := '应用程序1.0';
     lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
     Shell_NotifyIcon(NIM_ADD,lpData);
     dispose(lpData);
     Form1.Visible := False;
   end
   else
   begin//如果是其它的SystemCommand消息则调用系统缺省处理函数处理之。
     DefWindowProc(Form1.Handle,Message.Msg,Message.WParam,Message.LParam);
   end;
end;

procedure TForm1.WMBarIcon(var Message:TMessage);
var
lpData:PNotifyIconData;
begin
if (Message.LParam = WM_LBUTTONDOWN) then
begin//如果用户点击任务栏图标则将图标删除并回复窗口。
    lpData := new(PNotifyIconDataA);
    lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
    lpData.Wnd := Form1.Handle;
    lpData.hIcon := Form1.Icon.Handle;
    lpData.uCallbackMessage := WM_BARICON;
    lpData.uID :=0;
    lpData.szTip := '托管';
    lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    Shell_NotifyIcon(NIM_DELETE,lpData);
    dispose(lpData);
    Form1.Visible := True;
   end;
end;

function GetOS: TOSVersion; //获得系统类型，用来取得托盘句柄
var
    OS: TOSVersionInfo;
begin
    ZeroMemory(@OS, SizeOf(OS));
    OS.dwOSVersionInfoSize := SizeOf(OS);
    GetVersionEx(OS);
    Result := osUnknown;
    if OS.dwPlatformId = VER_PLATFORM_WIN32_NT then begin
        case OS.dwMajorVersion of
            3: Result := osNT3;
            4: Result := osNT4;
            5: begin
                    case OS.dwMinorVersion of
                        0: Result := os2K;
                        1: Result := osXP;
                        2: Result := os2K3;
                    end;
                end;
        end;
    end
    else if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 0) then
        Result := os95
    else if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 10) then
        Result := os98
    else if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 90) then
        Result := osME
end;

function GetSysTrayWnd(): HWND; //返回系统托盘的句柄，适合于Windows各版本
var OS: TOSVersion;
begin
    OS := GetOS;
    Result := FindWindow('Shell_TrayWnd', nil);
    Result := FindWindowEx(Result, 0, 'TrayNotifyWnd', nil);
    if (OS in [osXP, os2K3]) then
        Result := FindWindowEx(Result, 0, 'SysPager', nil);
    if (OS in [os2K, osXP, os2K3]) then
        Result := FindWindowEx(Result, 0, 'ToolbarWindow32', nil);
end;

procedure KillTrayIcons (Sender: TObject);
var
    hwndTrayToolBar: HWND;
    rTrayToolBar: tRect;
    x, y: Word;
begin
    hwndTrayToolBar := GetSysTrayWnd;
    Windows.GetClientRect(hwndTrayToolBar, rTrayToolBar);
    for x := 1 to rTrayToolBar.right - 1 do begin
        for y := 1 to rTrayToolBar.bottom - 1 do begin
            SendMessage(hwndTrayToolBar, WM_MOUSEMOVE, 0, MAKELPARAM(x, y));
        end;
    end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 KillTrayIcons(self);
end;

end.