程序任务栏指示图表的实现-（例如输入法）delphi

安装下面的控件，就可以了。
unit TrayIcon;interfaceuses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus,
  StdCtrls, ExtCtrls;type
  ENotifyIconError = class(Exception);  TTrayNotifyIcon = class(TComponent)
  private
    FDefaultIcon: THandle;
    FIcon: TIcon;
    FHideTask: Boolean;
    FHint: string;
    FIconVisible: Boolean;
    FPopupMenu: TPopupMenu;
    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FNoShowClick: Boolean;
    FTimer: TTimer;
    Tnd: TNotifyIconData;
    procedure SetIcon(Value: TIcon);
    procedure SetHideTask(Value: Boolean);
    procedure SetHint(Value: string);
    procedure SetIconVisible(Value: Boolean);
    procedure SetPopupMenu(Value: TPopupMenu);
    procedure SendTrayMessage(Msg: DWORD; Flags: UINT);
    function ActiveIconHandle: THandle;
    procedure OnButtonTimer(Sender: TObject);
  protected
    procedure Loaded; override;
    procedure LoadDefaultIcon; virtual;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Icon: TIcon read FIcon write SetIcon;
    property HideTask: Boolean read FHideTask write SetHideTask default False;
    property Hint: String read FHint write SetHint;
    property IconVisible: Boolean read FIconVisible write SetIconVisible default False;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  end;implementationtype
  TIconManager = class
  private
    FHWindow: HWnd;
    procedure TrayWndProc(var Message: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    property HWindow: HWnd read FHWindow write FHWindow;
  end;var
  IconMgr: TIconManager;
  DDGM_TRAYICON: Cardinal;constructor TIconManager.Create;
begin
  FHWindow := AllocateHWnd(TrayWndProc);
end;destructor TIconManager.Destroy;
begin
  if FHWindow <> 0 then DeallocateHWnd(FHWindow);
  inherited Destroy;
end;procedure TIconManager.TrayWndProc(var Message: TMessage);
{ This allows us to handle all tray callback messages }
{ from within the context of the component. }
var
  Pt: TPoint;
  TheIcon: TTrayNotifyIcon;
begin
  with Message do
  begin
    { if it's the tray callback message }
    if (Msg = DDGM_TRAYICON) then
    begin
      TheIcon := TTrayNotifyIcon(WParam);
      case lParam of
        WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;
        WM_LBUTTONDBLCLK:
          begin
            TheIcon.FNoShowClick := True;
            if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);
          end;
        WM_RBUTTONDOWN:
          begin
            if Assigned(TheIcon.FPopupMenu) then
            begin
              { Call to SetForegroundWindow is required by API }
              SetForegroundWindow(IconMgr.HWindow);
              { Popup local menu at the cursor position. }
              GetCursorPos(Pt);
              TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
              { Message post required by API to force task switch }
              PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
            end;
          end;
      end;
    end
    else
      Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
  end;
end;{ TTrayNotifyIcon }constructor TTrayNotifyIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon := TIcon.Create;
  FTimer := TTimer.Create(Self);
  with FTimer do
  begin
    Enabled := False;
    Interval := GetDoubleClickTime;
    OnTimer := OnButtonTimer;
  end;
  { Keep default windows icon handy... }
  LoadDefaultIcon;
end;destructor TTrayNotifyIcon.Destroy;
begin
  if FIconVisible then SetIconVisible(False);    // destroy icon
  FIcon.Free;                                    // free stuff
  FTimer.Free;
  inherited Destroy;
end;function TTrayNotifyIcon.ActiveIconHandle: THandle;
{ Returns handle of active icon }
begin
  { If no icon is loaded, then return default icon }
  if (FIcon.Handle <> 0) then
    Result := FIcon.Handle
  else
    Result := FDefaultIcon;
end;procedure TTrayNotifyIcon.LoadDefaultIcon;
begin
  FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;procedure TTrayNotifyIcon.Loaded;
begin
  inherited Loaded;
  { if icon is supposed to be visible, create it. }
  if FIconVisible then
    SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;procedure TTrayNotifyIcon.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = PopupMenu) then
    PopupMenu := nil;
end;procedure TTrayNotifyIcon.OnButtonTimer(Sender: TObject);
begin
  { Disable timer because we only want it to fire once. }
  FTimer.Enabled := False;
  { if double click has not occurred, then fire single click. }
  if (not FNoShowClick) and Assigned(FOnClick) then
    FOnClick(Self);
  FNoShowClick := False;   // reset flag
end;procedure TTrayNotifyIcon.SendTrayMessage(Msg: DWORD; Flags: UINT);
begin
  { Fill up record with appropriate values }
  with Tnd do
  begin
    cbSize := SizeOf(Tnd);
    StrPLCopy(szTip, PChar(FHint), SizeOf(szTip));
    uFlags := Flags;
    uID := UINT(Self);
    Wnd := IconMgr.HWindow;
    uCallbackMessage := DDGM_TRAYICON;
    hIcon  := ActiveIconHandle;
  end;
  Shell_NotifyIcon(Msg, @Tnd);
end;procedure TTrayNotifyIcon.SetHideTask(Value: Boolean);
{ Write method for HideTask property }
const
  { Flags to show application normally or hide it }
  ShowArray: array[Boolean] of integer = (sw_ShowNormal, sw_Hide);
begin
  if FHideTask <> Value then
  begin
    FHideTask := Value;
    { Don't do anything in design mode }
    if not (csDesigning in ComponentState) then
      ShowWindow(Application.Handle, ShowArray[FHideTask]);
  end;
end;procedure TTrayNotifyIcon.SetHint(Value: string);
begin
  if FHint <> Value then
  begin
    FHint := Value;
    if FIconVisible then
      { Change hint on icon on tray notification area }
      SendTrayMessage(NIM_MODIFY, NIF_TIP);
  end;
end;procedure TTrayNotifyIcon.SetIcon(Value: TIcon);
begin
  FIcon.Assign(Value);  // set new icon
  { Change icon on notification tray }
  if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;procedure TTrayNotifyIcon.SetIconVisible(Value: Boolean);
const
  { Flags to add or delete a tray notification icon }
  MsgArray: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
  if FIconVisible <> Value then
  begin
    FIconVisible := Value;
    { Set icon as appropriate }
    SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
  end;
end;procedure TTrayNotifyIcon.SetPopupMenu(Value: TPopupMenu);
begin
  FPopupMenu := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;const
  { String to identify registered window message }
  TrayMsgStr = 'DDG.TrayNotifyIconMsg';initialization
  { Get a unique windows message ID for tray callback }
  DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
  IconMgr := TIconManager.Create;
finalization
  IconMgr.Free;
end.
定义    procedure OnIconNotify(var Message: TMessage);
    message MY_MESSAGE;////////////////////
procedure TForm1.OnIconNotify(var Message: TMessage);
var
  Busy: Boolean ;
  nid: TNotifyIconData;
begin
  Busy:=false;
  if not Busy then begin
    Busy := true;
    if Message.LParam=WM_LBUTTONDOWN then
      self.show   //左健事件
    else if  Message.LParam=WM_RBUTTONDOWN then
    begin
        self.Close;   //右健事件
    end;
    Busy := false;
  end;
end;
procedure TForm1.up_modtask(as_tip:string);
var
ls_time:string;
li_tmp:integer  ;
nid: TNotifyIconData;
larr_tip:array[0..63] of char;
lc_tmp:char;
begin
        nid.cbSize := sizeof(nid); // nid变量的字节数
        li_tmp:=-1;
        nid.uID := li_tmp; //内部标识，与加入小图标时的数一致
        for li_tmp:=0 to length(as_tip)-1 do
        begin
            lc_tmp:=as_tip[li_tmp+1] ;
            nid.szTip[li_tmp]:=lc_tmp ;
        end;
        for li_tmp:=length(as_tip) to 63 do
        nid.szTip[li_tmp]:=char(0);
        nid.Wnd := Handle; //主窗口句柄
        nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息
        nid.uFlags := NIF_TIP ; // 指明哪些字段有效
        Shell_NotifyIcon(NIM_MODIFY, @nid);
end;
procedure TForm1.up_addicon;
var
nid: TNotifyIconData;
li_tmp:integer;
begin
  nid.cbSize := sizeof(nid); // nid变量的字节数
  nid.Wnd := Handle; // 主窗口句柄
  li_tmp:=-1;
  nid.uID := li_tmp; // 内部标识，可设为任意数
  nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄，可任意指定
  nid.szTip := '123456789'; // 提示字符串
  nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息
  nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有效
  if not Shell_NotifyIcon(NIM_ADD, @nid) then
   begin
    ShowMessage('Failed!');
    Application.Terminate;
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  up_addicon;
end;
……
var
  LinkServerForm: TLinkServerForm;
  lpData: NotifyIconData;
  SysHMenu:HMENU;
  RHMenu:HMENU;
implementationuses AddEdit,About;
{$R *.DFM}procedure TLinkServerForm.FormCreate(Sender: TObject);
begin
   /////////////////////////////////////////////////////////////
   //               修改系统菜单，添加一“关于”菜单          //
   /////////////////////////////////////////////////////////////
   SysHMenu:=GetSystemMenu(Handle,False);
   AppendMenu(SysHMenu,MF_SEPARATOR,0,'');
   AppendMenu(SysHMenu,MF_STRING,WM_MYMENU,'关于(&A)...'); //添加系统菜单<退出>   /////////////////////////////////////////////////////////////
   //               在状态栏指示区中添加一程序图标            //
   /////////////////////////////////////////////////////////////
   with lpData do
   Begin
      cbSize :=sizeof(NotifyIconData);
      Wnd :=handle;
      uID :=1;
      uFlags:=NIF_MESSAGE OR NIF_ICON OR NIF_TIP;
      uCallBackMessage :=WM_TRAYNOTIFY;
      hIcon :=application.Icon.Handle ;
      StrPLCopy(szTip,'杭华网络连接利器',63);
   End;
   Shell_NotifyIcon(NIM_ADD,@lpData);  //添加程序图标.   if AdoCAccess.connected=False then
      AdoCAccess.connected:=True;
   if TableNetLink.Active =False then
      TableNetLink.Active :=True;
end;procedure TLinkServerForm.FormDestroy(Sender: TObject);
begin
   Shell_NotifyIcon(NIM_DELETE,@lpData);  //删除程序图标.
end;procedure TLinkServerForm.WndProc(var Msg: TMessage);
var
   MousePos:TPoint;
begin
   GetCursorPos(MousePos);
   if Msg.Msg = WM_TRAYNOTIFY then
     case Msg.LParam of
       WM_LBUTTONDOWN:
       begin
          //MessageBox(handle,'You Click Left Button!','inf',MB_OK);
       end;
       WM_RBUTTONDOWN:
       begin
          RMenu.Popup(MousePos.x,MousePos.y);
       end;
       WM_LBUTTONDBLCLK:
       begin
          if Visible=True then
             Visible:=False
          else
          begin
             Visible:=True;
             application.BringToFront;
          end;
       end;
     end
   else
     if Msg.Msg = WM_MYMENU then   //
        About.NetAbout.showmodal
     else
        inherited;
end;procedure TLinkServerForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   Visible:=False;
   CanCLose:=False;
end;
……

调试易

程序任务栏指示图表的实现-（例如输入法）delphi

解决方案 »