这个办法主要是针对Delphi2010或者更高版本, 利用自带的TTrayIcon来实现最小化到托盘的功能, 至于低版本, 比如D7, 使用RZ的Tray控件就好了
主要修改点:
1.2010或者更高版本, 自带了一个TTrayIcon控件来实现托盘图标, 但是这个控件没有实现最小化时隐藏的功能
2.2010或者更高版本增加了MainFormOnTaskbar功能, 众所周知, delphi的任务栏按钮一直都不是标准的windows风格, 有了这个设置后, 任务栏按钮正常了, 但是也为我们的这个功能的实现增加了一些障碍
注意: 由于有MainFormOnTaskbar的区别, 所以要看当前状态是需要隐藏主窗体还是隐藏Application
另外, 在MainFormOnTaskbar模式下, Application.Restore无法触发OnRestore事件, 所以只能用代码去执行了
以下为窗体元素:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 243 ClientWidth = 472 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnCloseQuery = FormCloseQuery OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object ApplicationEvents1: TApplicationEvents OnMinimize = ApplicationEvents1Minimize OnRestore = ApplicationEvents1Restore Left = 128 Top = 96 end object TrayIcon1: TTrayIcon PopupMenu = PopupMenu1 Visible = True OnDblClick = actActionExecute Left = 176 Top = 96 end object ActionList1: TActionList Left = 128 Top = 144 object actAction: TAction Caption = 'actAction' OnExecute = actActionExecute end end object PopupMenu1: TPopupMenu Left = 176 Top = 144 object miVisible: TMenuItem Action = actAction end object N1: TMenuItem Caption = '-' end object miClose: TMenuItem Caption = #20851#38381 OnClick = miCloseClick end end end
以下为实现代码, 注意事项写到注释里了
unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Actions, Vcl.ActnList, Vcl.Menus, Vcl.ExtCtrls, Vcl.AppEvnts; type TForm1 = class(TForm) ApplicationEvents1: TApplicationEvents; TrayIcon1: TTrayIcon; ActionList1: TActionList; PopupMenu1: TPopupMenu; miVisible: TMenuItem; N1: TMenuItem; miClose: TMenuItem; actAction: TAction; procedure ApplicationEvents1Minimize(Sender: TObject); procedure actActionExecute(Sender: TObject); procedure miCloseClick(Sender: TObject); procedure ApplicationEvents1Restore(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormCreate(Sender: TObject); private { Private declarations } FAppClose: Boolean; {程序是否关闭} FAppMinimized: Boolean; {程序是否最小化} public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.actActionExecute(Sender: TObject); begin if FAppMinimized then begin {在MainFormOnTaskBar模式下, 不能直接执行Application.Restore, 无法触发OnRestore事件, 需要手动触发, 个人感觉是delphi的BUG, 没有深入研究} if Application.MainFormOnTaskBar then ApplicationEvents1.OnRestore(ApplicationEvents1) else Application.Restore; end else Application.Minimize; end; procedure TForm1.ApplicationEvents1Minimize(Sender: TObject); var nDoHandle: HWND; begin FAppMinimized := True; actAction.Caption := '显示'; {要做到在任务栏上隐藏, 需要吧任务栏按钮的对应窗体隐藏掉} if Application.MainFormOnTaskBar then nDoHandle := Application.MainForm.Handle else nDoHandle := Application.Handle; ShowWindow(nDoHandle, SW_HIDE) end; procedure TForm1.ApplicationEvents1Restore(Sender: TObject); var nDoHandle: HWND; begin FAppMinimized := False; actAction.Caption := '隐藏'; {恢复显示, 吧任务栏对应窗体显示, 考虑到MainForm窗口有普通和最大化的模式区别, 所以使用SW_RESTORE来恢复显示 显示后激活并置前窗体} if Application.MainFormOnTaskBar then nDoHandle := Application.MainForm.Handle else nDoHandle := Application.Handle; ShowWindow(nDoHandle, SW_RESTORE); SetForegroundWindow(nDoHandle); end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); function _CanClose: Boolean; var nStr: string; begin nStr := '确定要关闭' + Application.Title +'?'; Result := MessageBox(Handle, PChar(nStr), PChar(Application.Title), MB_ICONQUESTION + MB_YESNO) = IDYES; end; begin {设置了点击窗体关闭按钮时也是最小化到托盘的功能, 所以需要一个FAppClose变量来区别是最小化还是关闭} if FAppClose then begin CanClose := _CanClose; if not CanClose then FAppClose := False; end else begin Application.Minimize; CanClose := False; end; end; procedure TForm1.FormCreate(Sender: TObject); begin FAppClose := False; FAppMinimized := False; end; procedure TForm1.miCloseClick(Sender: TObject); begin FAppClose := True; Close; end; end.