S3软件 › DELPHI › DELPHI 应用程序图标托盘至右下角

S3_Leo 发表于 2024-6-15 17:25:00

DELPHI 应用程序图标托盘至右下角

unit MSTSCUnit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.IniFiles,Winapi.ShellAPI,Vcl.AppEvnts;

const
MouseMsg =WM_USER + 1;

type
TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
    { Private declarations }
    procedure MouseMessage(var message: tmessage); message mousemsg;    //这里要复制，系统创建少最后一段内容。
public
    { Public declarations }
end;

var
Form1: TForm1;
ntida:TNotifyIcondataA;

implementation

{$R *.dfm}


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone; //不对窗体进行任何操作
ShowWindow(Handle, SW_HIDE); //隐藏主窗体
//隐藏应用程序窗口在任务栏上的显示
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
not (GetWindowLong(Application.handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ntida.cbSize := sizeof(tnotifyicondataa); //指定ntida的长度
ntida.Wnd := handle; //取应用程序主窗体的句柄
ntida.uID := 100; //用户自定义的一个数值，在uCallbackMessage参数指定的消息中使
ntida.uFlags := nif_icon + nif_tip +
nif_message; //指定在该结构中uCallbackMessage、hIcon和szTip参数都有效
ntida.uCallbackMessage := mousemsg;
//指定的窗口消息
ntida.hIcon := Application.Icon.handle;
//指定系统状态栏显示应用程序的图标句柄
ntida.szTip := 'MSTSC';
//当鼠标停留在系统状态栏该图标上时，出现该提示信息
shell_notifyicona(NIM_ADD, @ntida);
//在系统状态栏增加一个新图标
end;

procedure TForm1.MouseMessage(var message: tmessage);
var
mousept: TPoint; //鼠标点击位置
begin
inherited;
if message.LParam = wm_rbuttonup then begin //用鼠标右键点击图标
if MessageBox(Handle, '你确定要退出吗？', '信息提示', MB_OKCANCEL + MB_ICONQUESTION) = IDOK then
begin
    ntida.cbSize := sizeof(tnotifyicondataa);
    ntida.wnd := handle;
    ntida.uID := 100;
    ntida.uFlags := nif_icon + nif_tip + nif_message;
    ntida.uCallbackMessage := mousemsg;
    ntida.hIcon := Application.Icon.handle;
    ntida.szTip := 'MSTSC';
    shell_notifyicona(NIM_DELETE, @ntida);
    //删除已有的应用程序图标
    Application.Terminate;
    //中断应用程序运行，退出应用程序
end;
end;
if message.LParam = wm_lbuttonup then begin //用鼠标左键点击图标
    //显示应用程序窗口
    ShowWindow(Handle, SW_SHOW);
   //在任务栏上显示应用程序窗口
   // ShowWindow(Application.handle, SW_SHOW);
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
    not (GetWindowLong(Application.handle, GWL_EXSTYLE)
    or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW));
end;
    message.Result := 0;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
//显示位置
Form1.top:=(screen.height-form1.height) div 5;
Form1.left:=(screen.width-form1.width) div 1;
end;

end.

查看完整版本: DELPHI 应用程序图标托盘至右下角