chain_server_main.pas

delphi的一个开发实例

unit Chain_Server_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,shellapi, StdCtrls, Menus;
const
    ICON_ID = 1;                     // 图标在本应用程序中的编号
    CM_nTaskIcoMsg = WM_USER + 78;   //托盘图标返回消息
    MM_SHOW = WM_USER + 199;         //托盘图标返回消息
type
  Tfrm_Chain_Server_Main = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    status1: TMenuItem;
    PopupMenu1: TPopupMenu;
    Show1: TMenuItem;
    N1: TMenuItem;
    About1: TMenuItem;
    N2: TMenuItem;
    Close1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure status1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Show1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);


  private
     {Private declarations }
     FpNotify : PNotifyIconDataA;
     Index:Integer;
     procedure OnMinimize(Sender: TObject);      //定义托盘图标结构
     procedure TaskIcoMsgDo(var Msg : TMessage); Message CM_nTaskIcoMsg;
     procedure MMSHOW(var Msg : TMessage); Message MM_SHOW;
     procedure WMHotKey(var message:TMessage);message WM_HotKey;
  public
    { Public declarations }
  end;

var
  frm_Chain_Server_Main: Tfrm_Chain_Server_Main;
  IconData: TNotifyIconData;
  tags:boolean;

implementation

{$R *.dfm}
Const Tips='［连锁管理。。。 服务器］';

procedure Tfrm_Chain_Server_Main.OnMinimize(Sender: TObject);
begin
    if IsWindowEnabled(Handle) then
    begin
        Hide;
    end;
end;


procedure Tfrm_Chain_Server_Main.TaskIcoMsgDo(var Msg: TMessage);
Var P:TPoint;
begin
    if not IsWindowEnabled(Handle) then
      Exit;

    if Msg.LParam = WM_LBUTTONDBLCLK then  //双击图标，显示(隐藏)窗口
      frm_Chain_Server_Main.Visible:=not frm_Chain_Server_Main.Visible;

    if Msg.LParam = WM_RBUTTONUP then
    begin  //右键单击，显示菜单
      GetCursorPos(P);
      PopupMenu1.Popup(P.x, P.y);
    end;
end;


procedure Tfrm_Chain_Server_Main.MMSHOW(var Msg: TMessage);
begin
    Show1Click(Show1);
end;

procedure Tfrm_Chain_Server_Main.WMHotKey(var message: TMessage);
begin
    Show1.Click;
end;
//******************************************************************************
procedure Tfrm_Chain_Server_Main.FormCreate(Sender: TObject);
begin
    Index:=0;
    Application.Title:=Tips;
    Caption:=Application.Title;
    Application.Icon.Handle:=LoadIcon(HInstance,'NEXT');
    Icon.Assign(Application.Icon);
    New(FpNotify);
    with FpNotify^ do
    begin
        Wnd := Handle;
        uID := 0;
        uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
        hIcon := Application.Icon.Handle;
        uCallbackMessage := CM_nTaskIcoMsg;
        StrPCopy(szTip,Tips);
    end;
    Shell_NotifyIcon(NIM_ADD, FpNotify);
    //注册任务栏图标。
    Application.OnMinimize:=OnMinimize;
    Application.ShowMainForm:=False;
    RegisterHotKey(Handle,0,MOD_ALT or MOD_CONTROL,$41);
  //注册热键。ALT_CTROL_BACKSPACE
end;

procedure Tfrm_Chain_Server_Main.status1Click(Sender: TObject);
begin
    //status := not status;
    //if status then status1.Caption := 'Enable'
    //else status1.Caption := 'Disable';
end;

procedure Tfrm_Chain_Server_Main.N1Click(Sender: TObject);
begin
    //UnInstallIcon;
   // self.WindowState:=wsNormal;
    //ShowWindow(Application.handle, SW_SHOWNORMAL);
end;

procedure Tfrm_Chain_Server_Main.FormDestroy(Sender: TObject);
begin
    UnregisterHotKey(handle,0);
  //释放热键。ALT_CTROL_BACKSPACE
  Shell_NotifyIcon(NIM_DELETE, FpNotify);
  //释放任务栏图标。
end;

procedure Tfrm_Chain_Server_Main.N2Click(Sender: TObject);
begin
    Close;
    system.Halt;
end;

procedure Tfrm_Chain_Server_Main.Show1Click(Sender: TObject);
begin
    frm_Chain_Server_Main.Visible:=not frm_Chain_Server_Main.Visible;
end;

procedure Tfrm_Chain_Server_Main.Timer1Timer(Sender: TObject);
begin
    if Index=0 then
    begin
        Application.Icon.Handle:=LoadIcon(HInstance,'NEXT');
        Index:=1;
    end else
    begin
        Application.Icon.Handle := LoadIcon(HInstance,'MAINICON');
        Index:=0;
    end;
    Icon.Assign(Application.Icon);
    with FpNotify^ do
    begin
        Wnd := Handle;
        uID := 0;
        uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
        hIcon := Application.Icon.Handle;
        //hIcon := Application.Icon.Handle;
        uCallbackMessage := CM_nTaskIcoMsg;
        StrPCopy(szTip,Tips);
    end;
    Shell_NotifyIcon(NIM_MODIFY, FpNotify);
end;
procedure Tfrm_Chain_Server_Main.Close1Click(Sender: TObject);
begin
    Close;
end;

procedure Tfrm_Chain_Server_Main.FormShow(Sender: TObject);
begin
    Application.Restore;
end;

procedure Tfrm_Chain_Server_Main.Panel1Click(Sender: TObject);
begin
    frm_Chain_Server_Main.Visible:=not frm_Chain_Server_Main.Visible;
end;

procedure Tfrm_Chain_Server_Main.About1Click(Sender: TObject);
begin
    Application.MessageBox('［连锁管理系统］由四川盖达尔研制！'+#13#10+'服务器模块，请勿关闭！','［连锁管理系统］',mb_ok);
end;

end.