Delphi 实现最近打开文件记录菜单

unit UntOpenMenu;
//download by http://wwww.NewXing.com
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus,registry;
 
type
  TFrmMain = class(TForm)
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    open: TMenuItem;
    RecentMenu: TMenuItem;
    OpenDialog1: TOpenDialog;
    filename0: TMenuItem;
    filename1: TMenuItem;
    filename2: TMenuItem;
    filename3: TMenuItem;
    filename4: TMenuItem;
    exit1: TMenuItem;
     procedure FormCreate(Sender:TOBject);
     procedure FormDestroy(sender:TObject);
    procedure openClick(Sender: TObject);
    procedure filename0Click(Sender: TObject);
    procedure exit1Click(Sender: TObject);
  private
    { Private declarations }
//     procedure AddRecentMenu(const FileName: String);
     procedure UpdateRCList(const FileName: String);
     procedure UpdateRCMenu;
     procedure OpenFile(FileName:String);
     procedure WriteRegistry;
     procedure ReadRegistry;
  public
    { Public declarations }
 
  private
     recentList:TStrings;
  end;
 
var
  FrmMain: TFrmMain;
 
implementation
 
{$R *.DFM}
 
 
{完成部份}
 
//更新临时存储最近文件列表的RecentList
procedure TFrmMain.UpdateRCList(const FileName: String);
var
  Position:integer;
begin
  Position:=RecentList.IndexOf(FileName);
   {TStrings的IndexOf(s:string)方法返回s在TStrings对象中第一次出现的位置}
  if Position>=0 then  RecentList.Delete(Position);
 //如果该文件名已在列表中存在，则将它从原来的位置移到最上面
  RecentList.Insert(0,FileName);
  if RecentList.Count>5 then
    RecentList.Delete(5);
end;
 
//用RecentList来更新最近文件列表菜单
procedure TFrmMain.UpdateRCMenu;
Var
  I:integer;
begin
   For I:=0 to RecentList.Count - 1 do
   begin
     RecentMenu.items[I].Visible:=true;
     RecentMenu.items[I].Caption:=Format('&%d ',[I])+RecentList[i];
     //使最近文件列表菜单项具有加速键
   end;
end;
 
//具体打开文件操作，
procedure   TFrmMain.OpenFile(FileName:String);
begin
  UpdateRCList(filename);
  UpdateRCMenu;
  showmessage(filename);
end;
 
{应用程序启动时读注册表}
procedure TFrmMain.FormCreate(Sender:TOBject);
begin
  ReadRegistry;
end;
 
//从注册表中读取最近文件列表信息
procedure TFrmMain.ReadRegistry;
var
  I:integer;
  MyReg:TRegistry;
begin
  RecentList:=TStringList.Create;
  MyReg:=TRegistry.create;
  try
    MyReg.RootKey := HKEY_CURRENT_USER;
    if MyReg.OpenKey('Software可视化油藏动态分析最近文件列表',false)    then
    begin
      RecentMenu.Visible:=true;
      MyReg.GetValueNames(RecentList);
        for I:=0 to RecentList.Count - 1 do
          RecentList[i]:=MyReg.ReadString(RecentList[i]);
        UpdateRCMenu;
   end;
  finally
    MyReg.CloseKey;
    MyReg.Free;
    inherited;
  end;
end;
 
 
//向注册表中写入最近文件列表信息
procedure TFrmMain.WriteRegistry;
Var
 I:Integer;
 MyReg:TRegistry;
begin
  MyReg:=TRegistry.create;
  try
    MyReg.RootKey := HKEY_CURRENT_USER;
    if MyReg.OpenKey('Software可视化油藏动态分析最近文件列表',true)  then
    begin
       For I:=0 to RecentList.Count - 1 do
          MyReg.WriteString('File'+Inttostr(I),RecentList[i]);
    end;
  finally
    MyReg.CloseKey;
    MyReg.Free;
    inherited;
  end;
end;
 
//应用程序关闭时，写注册表
procedure TFrmMain.formdestroy(sender:TObject);
begin
  WriteRegistry;
  recentlist.free;
end;
 
//从打开文件对话框打开文件
procedure TFrmMain.openClick(Sender: TObject);
begin
   if  OpenDialog1.Execute then
   begin
     OpenFile(OpenDialog1.FileName);
     RecentMenu.Visible:=true;
   end;
end;
 
//从最近文件列表菜单项打开文件
procedure TFrmMain.filename0Click(Sender: TObject);
var
  i:integer;
begin
  i:=(Sender as TMenuItem).Tag;
  OpenFile(RecentList[i]);    //调用打开文件过程
end;
 
procedure TFrmMain.exit1Click(Sender: TObject);
begin
  close;
end;
 
end.

Delphi编程制作托盘图标

一．新建一个应用程序：File->New Applicaton 在Interface部分定义一个消息常量：const WM_NID=WM_USER+1000; 系统规定从WM_USER开始为用户自定义消息。
二．定义一个全局变量： NotifyIcon:TNotifyIconData，NotifyIcon是非常重要的一个变量，整个程序基本上是围着这个变量在转。TNotifyIconData是一个记录类型，按住Ctrl键，在TNotifyIconData 双击即进入ShellAPI.pas单元。（注：在Delphi中，这是一个非常好的对源代码进行分析的方法，源代码说明一切，你要想知道程序背后的内幕，最好的方法就是分析源代码！）此时出现了以下赋值语句：
TNotifyIconData = TNotifyIconDataA，这个意思很明显，就是说TNotifyIconData和TNotifyIconDataA是同种数据类型，接着往下看有：
TNotifyIconDataA = _NOTIFYICONDATAA，意思与刚才的一样，再往下看：
type
_NOTIFYICONDATAA = record
       cbSize: DWORD;
       Wnd: HWND;
       uID: UINT;
       uFlags: UINT;
       uCallbackMessage: UINT;
       hIcon: HICON;
szTip: array [0..63] of AnsiChar;
end;
这可真是“千呼万唤始出来，犹抱琵琶半遮面”。现在大家很清楚了，我们刚才定义的全局变量NotifyIcon其实是一个包含有7个成分的记录类型变量，就相当于C/C++中的结构体变量（C/C++的程序员应该是再熟悉不过了）。下面我们逐个来解释记录类型中的7个部分各有什么功能。
1>        cbSize就是你定义的NotifyIcon变量的大小，用SizeOf(TNotifyIconData)可以取得，如果你是一个熟练的C/C++程序员，你应该不会陌生。在C/C++中，每当要为一个结构体变量分配内存的时候都要：通过 SizeOf(Struct type) 来获知存放一个这样的结构体变量要多少内存。
2>        Wnd是一个句柄，你希望托盘程序产生的消息有哪个窗体来处理就让Wnd指向那个窗体。
例如：你准备在任务栏的托盘小图标上单击时窗体是窗体在“显示”和“隐藏”之间切换，则把Wnd指向主窗体。
3> uID:如果你要创建多个托盘小程序，那么怎么区分它们呢？就是靠这个ID号来区分。
3>        uFlags是一个标志位，它表示当前所创建的托盘程序具有哪些性质：
NIF_ICON          表示当前所设置的图标（即hIcon的值）是有效的
NIF_MESSAGE 表示当前所设置的系统消息（即uCallBackMessage的值）是有效的
NIF_TIP          表示当前所设置的提示条（即szTip的值）是有效的。
4>        uCallBackMessage这是7个部分里面最重要的一个。这里指定一个回调消息，也就是说这里定义一个消息名，当你单击或者右击托盘图标的时候就会向你在Wnd所指向的窗体发送一个在uCallBackMessage中定义的消息名，然后你在程序中定义一个消息出来函数来处理这个消息。这样就把Windows关于消息的整套流程都处理好了。
6>   hIcon为托盘图标的句柄，根据这个句柄你就可以增加、修改、删除图标。
7>       szTip就是当你的鼠标放到任务栏托盘的小图标上的时候弹出来的提示信息。
在这里我花了大量的笔墨介绍TNotifyIconData的内幕，把这部分搞清楚了，后面的东西就顺理成章了。
三． 双击主窗体，进入FormCreate的代码区域：
TForm1.FormCreate(Sender:TObject);
    Begin
        //NotifyIcon为全局变量，在程序的开头已经定义了
        with NotifyIcon do
        begin
cbSize:=SizeOf(TNotifyIconData);
Wnd:=Handle;   //指向当前窗体Form1的句柄
uID:=1;
uFlags:=NIM_ICON or NIM_MESSAGE or NIM_TIP;
uCallBackMessage:=WM_NID;
hIcon:=Application.Icon.Handle;
szTip:=”张家恶少”；
end;.
//把设置好的变量NotifyIcon加入到系统中以便处理
Shell_NotifyIcon(NIM_ADD,@NotifyIcon);
   End;
四．接下来就是定义一个消息处理函数：系统给窗体发来了一个消息，就由下面这个函数来处理。每个消息处理函数都是处理某一类消息的，大家仔细地看看下面函数体的定义和一般的函数定义有什么不一样：消息处理函数要在后面加上消息的名称，这样当系统发来WM_NID消息时，就是自动触发WMNID消息处理函数。
procedure WMNID(var msg:TMessage);message WM_NID;
       begin
        case msg.LParam of
          WM_LBUTTONUp; Form1.Visible:=not Form1.Visible;
           WM_RBUTTONUP: ShowMessage(‘您点击的是右键’);
        End;
End;
好了，一个最简单的程序诞生了，大家自己设置好自己喜欢的图标.
Project->Options,选中Application页面，在Icon项中加载自己喜欢的图标，这样程序运行时，在任务栏里显示的就是你喜欢的图标了。当你单击图标时，窗体Form1会在可见与不可见之间切换，也就是说单击一下显示，再单击一下又隐藏。当你右击图标的时候会弹出一条消息：“你点击的是右键”。
五．最后要记住在关闭应用程序的时候要释放掉建立的托盘程序，否则会占用系统资源。
TForm1.FormDestroy(Sender:TObject);
Begin
Shell_NotifyIcon(NIM_DELETE,@NotifyIcon);
End;
http://www.xuedelphi.cn/wenzhang/yytg/2008/03/200803052086.htm
 
 

如何设置delphi程序托盘图标2006-11-29 13:03
//单元接口部分引用 SHELLAPI 函数:
//以下注释为我自己添加上去的,如果有描述错误的地方还需要更正
unit Unit1;
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, shellapi, Menus, StdCtrls;
const
wi_iconeven = wm_user + 1000;//定义消息常量,用来接受系统返回的消息.
type
   TForm1 = class(TForm)
     PopupMenu1: TPopupMenu;//有"显示"."隐藏","关闭"三种选项
     N1: TMenuItem;
     N2: TMenuItem;
     N3: TMenuItem;
     Label1: TLabel;
     Label2: TLabel;
     Label3: TLabel;
     procedure FormCreate(Sender: TObject);
     procedure N3Click(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure N1Click(Sender: TObject);
     procedure N2Click(Sender: TObject);
     procedure iconclick(var message : TMessage); message wi_iconeven;
   private
     { Private declarations }
   public
     { Public declarations }
   end;
var
   Form1: TForm1;
   nodedate : Tnotifyicondata;
implementation
{$R *.dfm}
//程序运行即显示托盘图标:
procedure TForm1.FormCreate(Sender: TObject);
begin
   nodedate.cbSize := sizeof(tnotifyicondata);
   nodedate.Wnd := handle;
   nodedate.uID := 1;
   nodedate.uFlags := Nif_Icon or Nif_Message or Nif_Tip;
   nodedate.uCallbackMessage := wi_iconeven;
   nodedate.hIcon := application.Icon.Handle;
   nodedate.szTip := '托盘图标测试';
   Shell_NotifyIcon(NIM_ADD,@nodedate);
   n1.Checked := true;
end;
//"关闭"
procedure TForm1.N3Click(Sender: TObject);
begin
   Shell_NotifyIcon(NIM_DELETE,@nodedate);
   Application.Terminate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
//释放内存
   Shell_NotifyIcon(NIM_DELETE,@nodedate);
end;
//点击'显示'
procedure TForm1.N1Click(Sender: TObject);
begin
   n1.Checked := true;
   n2.Checked := false;
   ShowWindow(Application.Handle,SW_SHOW);
   ShowWindow(form1.Handle, SW_SHOW);
end;
//"隐藏" 窗口
procedure TForm1.N2Click(Sender: TObject);
begin
   n1.Checked := false;
   n2.Checked := true;
   ShowWindow(Application.Handle, SW_HIDE);
   ShowWindow(form1.Handle, SW_HIDE);
end;
//接受消息
procedure TForm1.iconclick(var message: TMessage);
var P: Tpoint;
begin
   if message.LParam = WM_RButtonUP then   // 按下鼠标右键:
   begin
     SetForegroundWindow(From1.Handle); // 这句一定要加,否则弹出菜单不会自动隐藏

     GetCursorPos(P);//获取鼠标坐标
     PopupMenu1.Popup(P.x, P.y);//将 Popupmenu 与鼠标关联
   end;
   if message.LParam = WM_LButtonUP then
   begin
     if form1.Showing then
       form1.Hide
     else if not form1.Showing then
       form1.Show;
   end;
end;
end.
注 : 如果想讓你的托盤圖標可以在想更換的時候更換,可以通過一下方式修改.
   nodedate.hIcon := icon.Handle;
   Shell_NotifyIcon(NIM_MODIFY,@nodedate);
另:如何加載自定義的圖片?
   var icon : Ticon;
   .....
   icon := Ticon.Create;
   icon.LoadFromFile(extractfilepath(application.ExeName) + 'icon1.ico');//加載本目錄下的ico文件;
 
系统状态栏图标是指在Windows桌面系统下边的任务栏右边区域内显示的小图标，通常包括时间和输入法，另外，还会包括一些应用程序，如金山词霸或其它一些杀毒软件等的小图标。通常用鼠标右键点击这些小图标时会弹出菜单，通过选择这些菜单可以灵活地实现程序的各项功能。
下面本文以一个具体的例子，详细介绍一下利用Delphi实现系统状态栏图标的步骤和方法。
首先，介绍一下本实例要实现的功能：程序开始运行时会在系统状态栏生成一个小图标，同时会打开应用程序窗口，并在任务栏上显示相应的程序窗口；当用户关闭应用程序窗口时，该窗口和任务栏上相应的应用程序窗口都会消失，但应用程序并没有退出；当用户用鼠标左健单击该图标时，会再次打开应用程序窗口，同时在任务栏上显示应用程序窗口；当用户用鼠标右键单击系统状态栏中应用程序的小图标时，会弹出菜单，选择菜单项“退出”可以完全退出应用程序。
一、 实现步骤
1． 创建一个应用程序，在主窗体上增加一个TpopupMenu组件。并为该弹出菜单组件增加菜单项Exit，标题为“退出”。
2． 在Uses中添加ShellAPI，因为在系统状态栏中增加图标时需调用ShellAPI函数Shell_NotifyIconA。该函数需要2个参数，其中一个是TnotifyIconDataA结构，需在主窗体中增加TnotifyIconDataA类型全局变量ntida。
3． 定义消息mousemsg，并编写主窗体的mousemessage消息处理函数，此函数说明在图标上用鼠标左键单击时，会打开应用程序窗口；用鼠标右键单击时，会弹出一个菜单。
下面给出步骤2和3的实现代码：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Menus, shellapi;
const
mousemsg = wm_user+1; //自定义消息，用于处理用户在图标上点击鼠标的事件
iid = 100; //用户自定义数值，在TnotifyIconDataA类型全局变量ntida中使用。
type
TForm1 = class(TForm)
......
private
//自定义消息处理函数，处理鼠标点击图标事件
procedure mousemessage(var message: tmessage); message mousemsg;
public
{ Public declarations }
end;
var
Form1: TForm1;
ntida: TNotifyIcondataA; //用于增加和删除系统状态图标
implementation
{$R *.DFM}
procedure TForm1.mousemessage(var message: tmessage);
var
mousept: TPoint; //鼠标点击位置
begin
inherited;
if message.LParam = wm_rbuttonup then begin //用鼠标右键点击图标
getcursorpos(mousept); //获取光标位置
popupmenu1.popup(mousept.x, mousept.y); //在光标位置弹出菜单
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;
4． 编辑TForm1.FormCreate(Sender: TObject)
应用程序开始运行时，在系统状态栏上生成图标显示，代码如下：
procedure TForm1.FormCreate(Sender: TObject);
begin
ntida.cbSize := sizeof(tnotifyicondataa); //指定ntida的长度
ntida.Wnd := handle; //取应用程序主窗体的句柄
ntida.uID := iid; //用户自定义的一个数值，在uCallbackMessage参数指定的消息中使用
ntida.uFlags := nif_icon+nif_tip+nif_message;//指定在该结构中uCallbackMessage、hIcon、szTip参数都有效

ntida.uCallbackMessage := mousemsg;//指定的窗口消息
ntida.hIcon := Application.Icon.handle;//指定系统状态栏显示应用程序的图标句柄
ntida.szTip := 'Icon'; //当鼠标停留在系统状态栏该图标上时，出现该提示信息
shell_notifyicona(NIM_ADD, @ntida); //在系统状态栏增加一个新图标
end;
5． 编辑Tform1.OnClose
当用户关闭应用程序窗口时，该窗口和任务栏上相应的应用程序窗口都消失，但程序并没有退出。代码如下：
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,
GetWindowLong(Application.handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW);
end;
6． 编辑弹出菜单Exit
当用户点击该菜单时完全退出应用程序。代码如下：
procedure TForm1.ExitClick(Sender: TObject);
begin
//为ntida赋值，指定各项参数
ntida.cbSize := sizeof(tnotifyicondataa);
ntida.wnd := handle;
ntida.uID := iid;
ntida.uFlags := nif_icon+nif_tip+nif_message;
ntida.uCallbackMessage := mousemsg;
ntida.hIcon := Application.Icon.handle;
ntida.szTip := 'Icon';
shell_notifyicona(NIM_DELETE, @ntida); //删除已有的应用程序图标
Application.Terminate; //中断应用程序运行，退出应用程序
end;
二、 技术要点
1．程序中在增加或删除系统状态栏图标时，需调用ShellAPI函数Shell_NotifyIconA，该函数有两个参数，其中一个是TnotifyIconDataA结构，在前面的程序注释中已经对其进行了介绍；另一个参数是dwMessage，通过不同的取值表示是增加图标、修改图标或删除图标。
2．通过调用一组API函数，实现在任务栏上显示或隐藏应用程序窗口。这些函数分别为ShowWindow、SetWindowLong和GetWindowLong。其中，ShowWindow用于设置指定窗口的显示状态；SetWindowLong和GetWindowLong分别用于改变和检索指定窗体的一个属性。
 
 

任务栏（Taskbar）是微软公司在Windows 95中引入的一种特殊的桌面工具条，它为用户快速访问计算机资源提供了极大的方便，而状态栏（以下称通知栏）无疑是任务栏上较为特殊的一个窗口。编程人员可以调用API函数Shell_NotifyIcon向通知栏发送消息来添加、删除或修改图标，当在图标上发生鼠标或键盘事件时，系统会向应用程序发送编程时预先定义的消息，通知栏处理回调函数就会被自动调用以做出相应的处理。实现上述功能的相关文章俯仰即拾，此处不再赘述。本文将讨论两个较为深入的问题及其在Delphi中的实现方法。
     Windows发生错误导致外壳Explorer.exe重启时通知栏图标的自动恢复
　外壳Explorer重启时通知栏图标的自动恢复
相信很多Windows用户都碰到过这种情况：运行某个程序时出现意外错误，导致外壳程序Explorer.exe崩溃而发生重启（即Explorer.exe被关闭后重新运行），任务栏也在消失后重新生成，但应用程序在通知栏添加的图标消失了，虽然这些程序仍在运行，但再也无法通过通知栏图标与用户交互。为避免这种情况出现，Windows提供了相应的机制。
在安装了Internet Explorer 4.0及以上版本的Windows操作系统中，当任务栏建立后，外壳会向所有顶层的应用程序发出通知消息，该消息是外壳以字符串"TaskbarCreated"为参数向系统注册获得的，应用程序窗口接收到该消息后就应该重新添加的通知栏图标
原文章是《具有自动恢复功能的通知栏图标控件》，但是把这小功能做成控件有点小题大做了，实现起来很简单
以下是一个实例：

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI; //加入shellapi
const
  wm_traynotify = 3000;
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    MINIFTPFF: TNotifyIconData;
    MsgTaskbarRestart: Cardinal;
    { Private declarations }
  public
    procedure WndProc(var Msg: TMessage); override;
    procedure MiniToTaskbar; //最小化到托盘
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.MiniToTaskbar;
begin
  MsgTaskbarRestart := RegisterWindowMessage('TaskbarCreated');
  ShowWindow(Application.Handle, SW_SHOWMINIMIZED);
  ShowWindow(Application.Handle, SW_HIDE);
  MINIFTPFF.cbSize := SizeOf(TNotifyIconData);
  MINIFTPFF.Wnd := Handle;
  MINIFTPFF.uID := 1985629;
  MINIFTPFF.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  MINIFTPFF.uCallbackMessage := wm_traynotify;
  MINIFTPFF.hIcon := Application.Icon.Handle;
  MINIFTPFF.szTip := '这是个测试程序';
  Shell_NotifyIcon(NIM_ADD, @MINIFTPFF);
end;
procedure TForm1.WndProc(var Msg: TMessage);
begin
  inherited;
  if Msg.LParam = WM_LBUTTONDBLCLK then
  begin //双击图片图标还原窗体
    ShowWindow(Application.Handle, SW_SHOW);
    ShowWindow(Application.Handle, SW_SHOWNORMAL);
    Shell_NotifyIcon(NIM_Delete, @MINIFTPFF);
  end;
// 响应任务栏托盘重建消息
  if Msg.Msg = MsgTaskbarRestart then
    MiniToTaskbar; // 最小化到托盘
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  MiniToTaskbar;
end;
end.
UID160 帖子961 精华0 积分0 阅读权限200 在线时间93 小时 注册时间2008-6-9 最后登录2010-5-21 查看详细资料
 TOP
 
竹叶青对女儿红
管理员
 
个人空间 发短消息 加为好友 当前离线  14# 大 中 小 发表于 2009-2-9 14:29  只看该作者
delphi 托盘图标2008-05-20 19:44procedure TForm1.FormResize(Sender: TObject);
begin
if form1.WindowState=wsminimized then
begin
   trayicon1.Visible:=true;
   form1.Hide;
end;
end;
procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
   form1.Visible:=true;
   form1.WindowState:=wsnormal;
end;
至于右键菜单   trayicon1.PopupMenu:=popupmenu1;就行了.

unit ClsTrayIcon;
interface
uses
Windows, Menus, Messages, Graphics, Classes, Global;
type
TTrayIcon = class(TComponent)
private
FPopupMenu: TPopupMenu;
FActiveIcon: TIcon;
FDeActiveIcon: TIcon;
FParent: TComponent;
function TrayMessage(hDlg: THandle; dwMessage: DWORD; uID: UINT; hIcon: HICON): boolean;
public
property ActiveIcon: TIcon read FActiveIcon Write FActiveIcon;
property DeActiveIcon: TIcon read FDeActiveIcon write FDeActiveIcon;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure NotifyAdd(hDlg: HWND; State: Boolean);
procedure StateChange(hDlg: HWND; State: Boolean);
procedure NotifyDelete(hDlg: HWND);
end;
var
TrayIcon: TTrayIcon;
implementation
uses
SysUtils, ShellApi, Forms;
resourcestring
Res_TrayIconTip = '看好你的鴨子！ ';
const
TrayIconID = 2052;
function TTrayIcon.TrayMessage(hDlg: THandle; dwMessage: DWORD; uID: UINT; hIcon: HICON): boolean;
var
tnd: NOTIFYICONDATA;
begin
tnd.cbSize := sizeof(tnd);
tnd.Wnd := hDlg;
tnd.uID := uID;
tnd.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
tnd.uCallbackMessage := MYWM_NOTIFYICON;
tnd.hIcon := hIcon;
lstrcpyn(tnd.szTip, PChar(Res_TrayIconTip), SizeOf(tnd.szTip) div SizeOf(tnd.szTip[0]));
Result := Shell_NotifyIcon(dwMessage, @tnd);
if hIcon = 0 then
DestroyIcon(hIcon);
end;
procedure TTrayIcon.StateChange(hDlg: HWND; State: Boolean);
var
MyIcon: HICON;
begin
if State then
MyIcon := ActiveIcon.Handle
else
MyIcon := DeActiveIcon.Handle;
TrayMessage(hDlg, NIM_MODIFY, TrayIconID, MyIcon);
end;
procedure TTrayIcon.NotifyDelete(hDlg: HWND);
begin
TrayMessage(hDlg, NIM_DELETE, TrayIconID, 0);
end;
procedure TTrayIcon.NotifyAdd(hDlg: HWND; State: Boolean);
var
MyIcon: HICON;
begin
if State then
MyIcon := ActiveIcon.Handle
else
MyIcon := DeActiveIcon.Handle;
TrayMessage(hDlg, NIM_ADD, TrayIconID, MyIcon);
end;
constructor TTrayIcon.Create(AOwner: TComponent);
begin
inherited;
FParent := AOwner;
FActiveIcon := TIcon.Create;
FDeActiveIcon := TIcon.Create;
end;
destructor TTrayIcon.Destroy;
begin
FActiveIcon.Free;
FDeActiveIcon.Free;
inherited;
end;
initialization
finalization
end.
==================================================================================
type
TfMain = class(TfInternationalizationForm)
pmTrayIcon: TPopupMenu;
protected
procedure WndProc(var MyMessage: TMessage); override;
end;
var
WM_TASKBARCREATED : LongWord; //防崩溃消息
procedure TfMain.WndProc(var MyMessage: TMessage);
var
pt: TPoint;
begin
case MyMessage.Msg of
WM_CLOSE: //关闭事件
begin
application.Minimize;
end;
WM_CREATE:
begin
WM_TASKBARCREATED := RegisterWindowMessage( 'TaskbarCreated ');
//创建托盘栏图标类
TrayIcon := TTrayIcon.Create(self);
TrayIcon.ActiveIcon.Handle := LoadIcon(HInstance, 'Tray0 ');
TrayIcon.DeActiveIcon.Handle := LoadIcon(HInstance, 'Tray1 ');
end;
WM_DESTROY: // 窗体销毁消息
begin
//释放托盘栏图标
TrayIcon.NotifyDelete(self.Handle);
//释放托盘栏图标类
TrayIcon.Free;
end;
WM_SYSCOMMAND: begin
case MyMessage.WParam of
SC_MINIMIZE: // 窗体最小化
application.Minimize
else
inherited;
end;
end;
MYWM_NOTIFYICON:
case MyMessage.lParam of
WM_LBUTTONDBLCLK: //鼠标左键双击
begin
if self.Showing = true then
begin
application.Minimize;
self.Hide;
end
else
begin
self.Show;
application.Restore;
SetForegroundWindow(self.Handle);
end;
end;
WM_RBUTTONDOWN: //鼠标右键被按下
begin
GetCursorPos(pt);
SetForegroundWindow(self.Handle);
pmTrayIcon.Popup(pt.x,pt.y);
end
else
//调用父类的WndProc方法处理其它消息
inherited;
end;
else
if MyMessage.Msg = WM_TASKBARCREATED then //托盘栏防崩溃处理
begin
TrayIcon.NotifyDelete(self.Handle);
TrayIcon.NotifyAdd(self.Handle, self.Showing);
end
else
//调用父类的WndProc方法处理其它消息
inherited;
end;
end;