如何使程序运行时，用图标显示在计算机的右下脚？

Question

你用Application的画布Canvas来画，或者到网上找第三方控件（很多）。

Answer 1

const
    WM_TrayMessage=WM_User+100;  protected
      procedure AppMinimized(Sender: TObject);
      procedure WMTrayMessage(var msg:TMessage);message WM_TrayMessage;uses ShellApivar
  NID:TNotifyIconData{点击了任务栏的图标}
procedure TMainForm.WMTrayMessage(var msg:TMessage);
var
  p:TPoint;
begin
  if msg.LParam=WM_LButtonDown then '按了左键，显示主界面
  begin
    ShowWindow(Application.Handle,SW_Show);
    Application.Restore;
  end
  else if msg.LParam=WM_RButtonDown then '按了右键，显示弹出菜单
  begin
    GetCursorPos(p);
    pmTray.Popup(p.x,p.y);
  end;
end;{应用程序最小化时图标显示在任务栏}
procedure TMainForm.AppMinimized(Sender:TObject);
begin
  NID.cbSize:=SizeOf(TNotifyIconData);
  NID.hIcon:=Application.Icon.Handle;
  NID.szTip:= '彩虹2.0 Beta ';
  NID.uCallbackMessage:=WM_TrayMessage;
  NID.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
  NID.uID:=0;
  NID.Wnd:=Handle;
  Shell_NotifyIcon(NIM_ADD,@NID);
  ShowWindow(Application.Handle,SW_Hide);
end;procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnMinimize:=AppMinimized;
  AppMinimized(nil);
end;procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE,@NID);
end;

Answer 2

{点击了任务栏的图标}
procedure TMainForm.WMTrayMessage(var msg:TMessage);
var
  p:TPoint;
begin
  if msg.LParam=WM_LBUTTONDBLCLK then '双击了左键，显示主界面
  begin
    ShowWindow(Application.Handle,SW_Show);
    Application.Restore;
  end
  else if msg.LParam=WM_RButtonDown then '按了右键，显示弹出菜单
  begin
    GetCursorPos(p);
    pmTray.Popup(p.x,p.y);
  end;
end;

Answer 3

  private
    procedure NotifyIconClick(var msg : TMessage);
    Message WM_My_Notify;
implementation
  begin
    image1.Picture.LoadFromFile(ICON\Tary.ICO');
    New(TrayIcon);
    TrayIcon.cbSize := SizeOf(TrayIcon^);
    TrayIcon.uID:=200;
    TrayIcon.wnd:=Handle;
    TrayIcon.uCallbackMessage:=WM_MY_Notify;
    TrayIcon.uFlags:=NIF_ICON+NIF_Tip+NIF_MESSAGE;
    TrayIcon.szTip := '任务栏图标';
    Icon := TIcon.Create;
    Icon.Assign(Image1.Picture);
    TrayIcon.hIcon := Icon.handle;
    Shell_NotifyIcon(NiM_ADD,TrayIcon);
    SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;procedure TOptionFrm.NotifyIconClick(var msg : TMessage);
 var p:TPoint;
begin
 try
     case msg.LParam of
      WM_RBUTTONDOWN:
        begin
         GetCursorPos(p);
         PopupMenu1.Popup(p.x,p.y);
        end;
      WM_LBUTTONDBLCLK:
        begin
          OptionFrm.WindowState := wsNormal;
          show;
        end;
     end;
 except
 end;
end;

Answer 4

只要找一个叫systray的控件就可以了AHM中就有

Answer 5

小托盘。Very easy 的啦。

Answer 6

c++ builder最新版本有控件可以直接实现，估计delphi也应该有

Answer 7

unit SysTray;interfaceuses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  ShellApi, ExtCtrls, Menus, StdCtrls;const
  WM_SYSTRAY = WM_USER + 1;
  IDI_TRAYICON = 0;type
  TPopupMode = set of(pmLeftClick, pmRightClick, pmLeftDblClick,
    pmRightDblClick);
  TMouseEvent= procedure(Sender: TObject; Button: TMouseButton;
    X, Y: Integer) of object;  TSysTray = class(TComponent)
  private
    FIcon: TIcon;
    FIconData: TNotifyIconData;
    FParentWindow: HWnd;
    FWindowHandle: HWnd;
    FHint: string;
    FPopupMenu: TPopupMenu;
    FPopupAlign: TPopupAlignment;
    FPopupMode: TPopupMode;
    FActive: boolean;
    FShowDesigning: boolean;
    FOnIconMouseDown: TMouseEvent;
    FOnIconDoubleClick: TMouseEvent;    function AddIcon: boolean;
    function DeleteIcon: boolean;
    function ModifyIcon: boolean;    procedure SetIcon(Icon: TIcon);
    procedure SetHint(Hint: string);
    procedure SetActive(Value: boolean);
    procedure SetShowDesigning(Value: boolean);
    procedure FillDataStructure;    procedure WndProc(var Msg: TMessage); message WM_SYSTRAY;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active: boolean read FActive write SetActive;
    property ShowDesigning: boolean read FShowDesigning write SetShowDesigning;
    property Icon: TIcon Read FIcon write SetIcon;
    property Hint: string read FHint write SetHint;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property PopupMode: TPopupMode read FPopupMode write FPopupMode;
    property PopupAlign: TPopupAlignment read FPopupAlign write FPopupAlign;
    property OnIconDoubleClick:TMouseEvent
            read FOnIconDoubleClick write FOnIconDoubleClick;
    property OnIconMouseDown:TMouseEvent
            read FOnIconMouseDown write FOnIconMouseDown ;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('MyVcl', [TSysTray]);
end;constructor TSysTray.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon := TIcon.Create;
  FHint := '托盘组件';
  FPopupMode := [pmRightClick];
  FPopupAlign := paRight;
  FActive := false;
  FShowDesigning := false;  if (AOwner <> nil) and (AOwner is TForm) then
    FParentWindow := TForm(AOwner).Handle
  else
    FParentWindow := 0;  FWindowHandle := AllocateHWnd(WndProc);  FillDataStructure;
end;destructor TSysTray.Destroy;
begin
  try
    if (not (csDesigning in ComponentState) and FActive)
      or ((csDesigning in ComponentState) and FShowDesigning) then
      DeleteIcon;
  finally
    FIcon.Free;
    DeallocateHWnd(FWindowHandle);
  end;
  inherited Destroy;
end;function TSysTray.AddIcon: boolean;
begin
  FillDataStructure;
  Result := Shell_NotifyIcon(NIM_ADD, @FIconData);
end;function TSysTray.DeleteIcon: boolean;
begin
  Result := Shell_NotifyIcon(NIM_DELETE, @FIconData);
end;function TSysTray.ModifyIcon: boolean;
begin
  FillDataStructure;
  if FActive then
    Result := Shell_NotifyIcon(NIM_MODIFY, @FIconData)
  else
    Result := true;
end;procedure TSysTray.SetIcon(Icon: TIcon);
begin
  FIcon.Assign(Icon);
  ModifyIcon;
end;procedure TSysTray.SetHint(Hint: string);
begin
  if Length(Hint) >= 64 then Hint := Copy(Hint, 1, 63);
  FHint := Hint;
  ModifyIcon;
end;procedure TSysTray.SetActive(Value: boolean);
begin
  if Value <> FActive then
  begin
    FActive := Value;
    if not (csDesigning in ComponentState) then
    begin
      case Value of
        true:    AddIcon;
        false:  DeleteIcon;
      end;
    end;
  end;
end;procedure TSysTray.SetShowDesigning(Value: boolean);
begin
  if (csDesigning in ComponentState) then
  begin
    if Value <> FShowDesigning then
    begin
      FShowDesigning := Value;
      case Value of
        true:    AddIcon;
        false:  DeleteIcon;
      end;
    end;
  end;
end;procedure TSysTray.FillDataStructure;
begin
  With FIconData do
  begin
    uCallbackMessage:=WM_SYSTRAY;
    cbSize := SizeOf(FIconData);
    uID := IDI_TRAYICON;
    wnd := FWindowHandle;
    hIcon := FIcon.Handle;
    StrCopy(FIconData.szTip, PChar(FHint));
    uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
  end;
end;procedure TSysTray.WndProc(var Msg: TMessage);
var
  P: TPoint;
begin
  if (Msg.WParam <> IDI_TRAYICON) then exit;
  if Assigned(FPopupMenu) then
    FPopupMenu.Alignment := FPopupAlign;  GetCursorPos(p);
  case Msg.LParam of
    WM_LBUTTONDOWN:
    begin
      if (pmLeftClick in FPopupMode) and Assigned(FPopupMenu) then
      begin
        SetForegroundWindow(FParentWindow);
        FPopupMenu.Popup(p.x,p.y);
      end;
      if Assigned(FOnIconMouseDown) then
      begin
        SetForegroundWindow(FParentWindow);
        FOnIconMouseDown(Self, mbLeft, p.x, p.y);
      end;
    end;    WM_RBUTTONDOWN:
    begin
      if (pmRightClick in FPopupMode) and Assigned(FPopupMenu) then
      begin
        SetForegroundWindow(FParentWindow);
        FPopupMenu.Popup(p.x,p.y);
      end;
      if Assigned(FOnIconMouseDown) then
      begin
        SetForegroundWindow(FParentWindow);
        FOnIconMouseDown(Self, mbRight, p.x, p.y);
      end;
    end;    WM_LBUTTONDBLCLK:
    begin
      if (pmLeftDblClick in FPopupMode) and Assigned(FPopupMenu) then
      begin
        SetForegroundWindow(FParentWindow);
        FPopupMenu.Popup(p.x,p.y);
      end;
      if Assigned(FOnIconDoubleClick) then
      begin
        SetForegroundWindow(FParentWindow);
        FOnIconDoubleClick(Self, mbLeft, p.x, p.y);
      end;
    end;    WM_RBUTTONDBLCLk:
    begin
      if (pmRightDblClick in FPopupMode) and Assigned(FPopupMenu) then
      begin
        SetForegroundWindow(FParentWindow);
        FPopupMenu.Popup(p.x,p.y);
      end;
      if Assigned(FOnIconDoubleClick) then
      begin
        SetForegroundWindow(FParentWindow);
        FOnIconDoubleClick(Self, mbRight, p.x, p.y);
      end;
    end;    else
      Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  end;
end;end. 把它安装即可使用