程序启动后直接最小化到托盘栏(delphi)

unit   ServerMain;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Classes,   Graphics,   Controls,   Forms,   Dialogs,  
      StdCtrls,   IniFiles,   ExtCtrls,   bsSkinData,   BusinessSkinForm,   Menus,  
      bsSkinMenus,shellapi,   ImgList;  
   
  type  
      Tmain   =   class(TForm)  
          bsSkinData:   TbsSkinData;  
          bsBusinessSkinForm1:   TbsBusinessSkinForm;  
          Image1:   TImage;  
          Timer1:   TTimer;  
          Label1:   TLabel;  
          PopupMenu1:   TbsSkinPopupMenu;  
          N1:   TMenuItem;  
          N2:   TMenuItem;  
          N3:   TMenuItem;  
          N4:   TMenuItem;  
          Timer2:   TTimer;  
          ImageList1:   TImageList;  
          procedure   FormCreate(Sender:   TObject);  
          procedure   FormDestroy(Sender:   TObject);  
          procedure   N3Click(Sender:   TObject);  
          procedure   N4Click(Sender:   TObject);  
          procedure   FormClose(Sender:   TObject;   var   Action:   TCloseAction);  
      private  
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
          procedure   WndProc(var   Msg:   TMessage);   override;  
      end;  
   
  const  
      TrayMsgStr   =   'TrayNotifyIconMsg';  
   
  var  
      main:   Tmain;  
      shi,fen,miao:integer;  
      nd0,nd1:   NotifyIconData;  
      hs:   array[0..1]of   LongWord;  
      WM_TRAYNOTIFY:   Cardinal;  
      IconFlag:   integer;  
   
  implementation  
   
  {$R   *.DFM}  
   
  procedure   TMain.WndProc(var   Msg:   TMessage);  
  var  
      pt:TPoint;  
  begin  
      with   Msg   do  
          begin  
              if   Msg   =   WM_TRAYNOTIFY   then  
                  begin  
                      case   lParam   of  
                          WM_LBUTTONDOWN:  
                              begin  
                                  hs[1]:=LoadIcon(hInstance,   'Icon1');  
                                  nd1.cbSize   :=   sizeof(NotifyIconData);  
                                  nd1.Wnd   :=   Handle;  
                                  nd1.uID   :=   1;  
                                  nd1.uFlags   :=   NIF_MESSAGE   or   NIF_ICON   or   NIF_TIP;  
                                  nd1.uCallbackMessage   :=   WM_TRAYNOTIFY;  
                                  nd1.hIcon   :=   hs[1];  
                                  StrPLCopy(nd1.szTip,   'Thank   You   !',63);  
                                  Shell_NotifyIcon(NIM_MODIFY,@nd1);  
                                  IconFlag   :=1;  
                                    Main.Show   ;  
                              end;  
                          WM_LBUTTONDBLCLK:  
                              begin  
                                  ShowMessage('double   click');  
                              end;  
                          WM_RBUTTONDOWN:  
                              begin  
                                  SetForegroundWindow(Handle);  
                                  GetCursorPos(pt);  
                                  PopupMenu1.Popup(Pt.X,   Pt.Y);  
                              end;  
                      end;  
                  end;  
          end;  
      inherited;  
  end;  
   
  procedure   Tmain.FormCreate(Sender:   TObject);  
  begin  
      setwindowlong(application.handle,gwl_exstyle,ws_ex_toolwindow);  
      WM_TRAYNOTIFY   :=   RegisterWindowMessage(TrayMsgStr);  
      hs[0]:=LoadIcon(hInstance,   'MainIcon');  
      nd0.cbSize   :=   sizeof(NotifyIconData);  
      nd0.Wnd   :=   Handle;  
      nd0.uID   :=   0;  
      nd0.uFlags   :=   NIF_MESSAGE   or   NIF_ICON   or   NIF_TIP;  
      nd0.uCallbackMessage   :=   WM_TRAYNOTIFY;  
      nd0.hIcon   :=   hs[0];  
      StrPLCopy(nd0.szTip,   '速普得应用服务器,正在运行...',63);  
      Shell_NotifyIcon(NIM_ADD,@nd0);  
      IconFlag   :=0;  
      with   Timer2   do  
      begin  
          Enabled   :=   False;  
          Interval   :=   GetDoubleClickTime;  
      end;  
  end;  
   
  procedure   Tmain.FormDestroy(Sender:   TObject);  
  begin  
      if     (IconFlag=0)     then  
          Shell_NotifyIcon(NIM_DELETE,   @nd0)  
      else  
          Shell_NotifyIcon(NIM_DELETE,   @nd1);  
  end;  
   
  procedure   Tmain.N3Click(Sender:   TObject);  
  begin  
      main.Show;  
  end;  
   
  procedure   Tmain.N4Click(Sender:   TObject);  
  begin  
      beep;  
      if   messagedlg('如果你退出该服务,ERP系统将无法正常运行!'+#13+'你确定要强行退出应用服务器吗?   Y/N',mtwarning,[mbyes,mbno],0)   =   mryes   then  
          Application.Terminate;  
  end;  
   
  procedure   Tmain.FormClose(Sender:   TObject;   var   Action:   TCloseAction);  
  begin  
      Action   :=   caNone;  
      main.Hide;  
  end;  
   
  end.
posted @ 2009-09-02 17:21  苔苔以苔苔以苔  阅读(1641)  评论(0编辑  收藏  举报
猪先飞