15

我是德尔福学习者。我正在寻找解决方案，以便将 Delphi MainForm 最小化到系统托盘而不是任务栏。在系统托盘图标上右键单击应该有一些菜单，如“恢复”和“关于”和“帮助”等。系统托盘图标将从 Imagelis1 加载，它会动画。点击“Restore”主窗体将被恢复，点击“About”“Form2”将被恢复，点击“Help”“Foprm3”将被恢复。我在互联网上找到了很多解决方案，例如：

解决方案01

解决方案02

但每个解决方案都有一些缺点。有些可以一次完成。有些在 Windows7 中有模糊的图标。有人可能会说没有人为我写代码，我必须展示我的代码。请原谅我的这方面。请给我具体的解决方案，以便它可以在没有windows版本依赖的情况下普遍实现。它将帮助每一个人。请帮我。

4

4 回答 4

25

这应该让你继续前进。将 aTTrayIcon和 aTApplicationEvents放在您的表格上。以下代码TTrayIcon - Delphi Example来自docwiki。使用 IDE 主菜单，然后选择Project->View Source，以及读取Application.ShowMainFormOnTaskbar := True;为 `Application.ShowMainFormOnTaskbar := False;' 的行 以防止应用程序的按钮出现在 Windows 任务栏上。

此示例在表单上使用托盘图标和应用程序事件组件。当应用程序运行时，它会加载托盘图标，动画时显示的图标，它还会设置一个提示气球。当您最小化窗口时，表单被隐藏，提示气球出现，托盘图标显示和动画。双击系统托盘图标可恢复窗口。

// Add this to the `TApplicationEvents.OnMinimize` event handler
procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
  { Hide the window and set its state variable to wsMinimized. }
  Hide();
  WindowState := wsMinimized;

  { Show the animated tray icon and also a hint balloon. }
  TrayIcon1.Visible := True;
  TrayIcon1.Animate := True;
  TrayIcon1.ShowBalloonHint;
end;

// Add this to the `TForm.OnCreate` event handler
procedure TForm1.FormCreate(Sender: TObject);
var
  MyIcon : TIcon;
begin
  { Load the tray icons. }
  TrayIcon1.Icons := TImageList.Create(Self);
  MyIcon := TIcon.Create;
  MyIcon.LoadFromFile('icons/earth1.ico');
  TrayIcon1.Icon.Assign(MyIcon);
  TrayIcon1.Icons.AddIcon(MyIcon);

  MyIcon.LoadFromFile('icons/earth2.ico');
  TrayIcon1.Icons.AddIcon(MyIcon);
  MyIcon.LoadFromFile('icons/earth3.ico');
  TrayIcon1.Icons.AddIcon(MyIcon);
  MyIcon.LoadFromFile('icons/earth4.ico');
  TrayIcon1.Icons.AddIcon(MyIcon);

  { Set up a hint message and the animation interval. }
  TrayIcon1.Hint := 'Hello World!';
  TrayIcon1.AnimateInterval := 200;

  { Set up a hint balloon. }
  TrayIcon1.BalloonTitle := 'Restoring the window.';
  TrayIcon1.BalloonHint :=
    'Double click the system tray icon to restore the window.';
  TrayIcon1.BalloonFlags := bfInfo;
end;

// Add this to the `TTrayIcon.OnDoubleClick` event handler
procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
  { Hide the tray icon and show the window,
  setting its state property to wsNormal. }
  TrayIcon1.Visible := False;
  Show();
  WindowState := wsNormal;
  Application.BringToFront();
end;

对于右键单击时获得的菜单，将 a 添加TPopupMenu到表单中，在其上添加所需的项目，像往常一样为这些项目编写事件处理程序，然后将 分配PopupMenu给TrayIcon.PopupMenu属性。

“模糊的图标”是由于您没有使用正确的图标大小而导致 Windows 被迫缩放（拉伸）它们。使用图标编辑器为每个图标创建多个尺寸的图像（一个图标文件中可以有多个尺寸）。

于 2012-08-06T02:10:03.130 回答
9

I drop a TrayIcon onto myForm, then i add this simple code:

type
  TmyForm = class(TForm)
    ...
    TrayIcon: TTrayIcon;
    procedure FormCreate(Sender: TObject);
    ...
    procedure TrayIconClick(Sender: TObject);
    ...
  private
    { Private declarations }
    procedure OnMinimize(Sender:TObject);
  public
    { Public declarations }
  end;

procedure TmyForm.FormCreate(Sender: TObject);
begin // When form is created
     Application.OnMinimize:=OnMinimize; // Set the event handler for application minimize
end;

procedure TmyForm.OnMinimize(Sender:TObject);
begin // When application is minimized by user and/or by code
     Hide; // This is to hide it from taskbar
end;

procedure TmyForm.TrayIconClick(Sender: TObject);
begin // When clicking on TrayIcon
     if Visible
     then begin // Application is visible, so minimize it to TrayIcon
               Application.Minimize; // This is to minimize the whole application
          end
     else begin // Application is not visible, so show it
               Show; // This is to show it from taskbar
               Application.Restore; // This is to restore the whole application
          end;
end;

This creates a TrayIcon allways visible, and when you click on it:

  • If the application is Visible, it will be Hidden form taskbar and from screen
  • If the application is Hidden, it will be Shown form taskbar and from screen

In other words, clicking on TrayIcon the application will change its visibility; just as minimizing it to TrayIcon bar.

于 2014-06-02T08:24:07.863 回答
3

...在 Delphi 6 中，不TTrayIcon存在，您可以使用以下简单代码：

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShellAPI, StdCtrls, Menus;

const WM_ICONTRAY = WM_USER+1;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    ShowForm1: TMenuItem;
    HideForm1: TMenuItem;
    Exit1: TMenuItem;
    procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ShowForm1Click(Sender: TObject);
    procedure HideForm1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
   TrayIconData: TNotifyIconData;
  end;

var
  Form1: TForm1;
  MustExit:boolean;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  MustExit:=false;
  TrayIconData.cbSize:=SizeOf(TrayIconData);
  TrayIconData.Wnd:=Handle;
  TrayIconData.uID:=0;
  TrayIconData.uFlags:=NIF_MESSAGE + NIF_ICON + NIF_TIP;
  TrayIconData.uCallbackMessage:=WM_ICONTRAY;
  TrayIconData.hIcon:=Application.Icon.Handle;
  StrPCopy(TrayIconData.szTip,Application.Title);
  Shell_NotifyIcon(NIM_ADD, @TrayIconData);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE, @TrayIconData);
end;

procedure TForm1.TrayMessage(var Msg: TMessage);
var p:TPoint;
begin
  case Msg.lParam of
    WM_LBUTTONDOWN: begin
                     Form1.Show;
                     Application.Restore;
                    end;
    WM_RBUTTONDOWN: begin
                     GetCursorPos(p);
                     PopUpMenu1.Popup(p.x,p.y);
                    end;
  end;
end;

// Popup "Form Show" menu item OnClick 
procedure TForm1.ShowForm1Click(Sender: TObject);
begin
 Form1.Show;
end;

// Popup "Form Hide" menu item OnClick    
procedure TForm1.HideForm1Click(Sender: TObject);
begin
 Form1.Hide;
end;

// Popup "Exit" menu item OnClick
procedure TForm1.Exit1Click(Sender: TObject);
begin
 MustExit:=true;
 Close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if MustExit then exit;
 Form1.Hide;
 Action:=caNone;
end;

end.
于 2014-06-13T22:43:56.080 回答
1

我已经实现了以下代码。在这里一切都很好，除了一个。最小化表单后，它转到“SystemTray”，但也可以在“TaskBar”中使用。对于我的应用程序，“Form001”的“AlphaBlend”属性为真，“AlphaBlendValue”为“0”。

unit KoushikHalder001;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ExtCtrls, Vcl.Imaging.pngimage,
  Vcl.AppEvnts, Vcl.ImgList, Vcl.Menus;

type
  TForm001 = class(TForm)
    Edit001: TEdit;
    Background: TImage;
    BitBtn001: TBitBtn;
    BitBtn002: TBitBtn;
    FadeInTimer: TTimer;
    FadeOutTimer: TTimer;
    FormMinimizeTimer: TTimer;
    FormRestoreTimer: TTimer;
    TrayIcon: TTrayIcon;
    PopupMenu: TPopupMenu;
    ImageList: TImageList;
    ApplicationEvents: TApplicationEvents;
    Form001Close: TMenuItem;
    Form001Hide: TMenuItem;
    Form001Show: TMenuItem;
    Form002Close: TMenuItem;
    Form002Hide: TMenuItem;
    Form002Show: TMenuItem;
    N01: TMenuItem;
    N02: TMenuItem;
    N03: TMenuItem;
    N04: TMenuItem;
    N05: TMenuItem;
    N06: TMenuItem;
    N07: TMenuItem;
    N08: TMenuItem;
    N09: TMenuItem;
    N10: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn001Click(Sender: TObject);
    procedure BitBtn002Click(Sender: TObject);
    procedure FadeInTimerTimer(Sender: TObject);
    procedure FadeOutTimerTimer(Sender: TObject);
    procedure FormMinimizeTimerTimer(Sender: TObject);
    procedure FormRestoreTimerTimer(Sender: TObject);
    procedure ApplicationEventsMinimize(Sender: TObject);
    procedure TrayIconDblClick(Sender: TObject);
    procedure Form001CloseClick(Sender: TObject);
    procedure Form001HideClick(Sender: TObject);
    procedure Form001ShowClick(Sender: TObject);
    procedure Form002CloseClick(Sender: TObject);
    procedure Form002HideClick(Sender: TObject);
    procedure Form002ShowClick(Sender: TObject);
  private
    { Private declarations }
    CrossButtonClick: Boolean;
    procedure WMNCHitTest(var Msg: TWMNCHitTest) ; message WM_NCHitTest;
    procedure WMSysCommand(var Msg: TWMSysCommand) ; message WM_SysCommand;
  public
    { Public declarations }
  end;

var
  Form001: TForm001;

implementation

{$R *.dfm}

uses KoushikHalder002;


procedure TForm001.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  inherited;
  if ControlAtPos(ScreenToClient(Msg.Pos), True, True, True)= nil
    then
      begin
        if Msg.Result=htClient then Msg.Result := htCaption;
      end;
end;

procedure TForm001.WMSysCommand(var Msg: TWMSysCommand);
begin
  case Msg.CmdType of
    SC_MINIMIZE:
      begin
        if Form001.AlphaBlendValue > 0 then
          begin
            Form001.FormMinimizeTimer.Enabled := true;
            Exit;
          end;
      end;
    SC_RESTORE:
      begin
        if Form001.AlphaBlendValue < 220 then
          begin
            Form001.FormRestoreTimer.Enabled := True;
          end;
      end;
  end;
  inherited;
end;

procedure TForm001.ApplicationEventsMinimize(Sender: TObject);
begin
  Form001.FormMinimizeTimer.Enabled := true;
  TrayIcon.Visible := True;
  TrayIcon.Animate := True;
  TrayIcon.ShowBalloonHint;
end;

procedure TForm001.BitBtn001Click(Sender: TObject);
begin
  if Form002.WindowState = wsMinimized then
    begin
      Form002.Perform(WM_SYSCOMMAND, SC_RESTORE, 0);
    end
    else
    Form002.show;
end;

procedure TForm001.BitBtn002Click(Sender: TObject);
begin
  Form002.FadeOutTimer.Enabled := true;
  Form001.FadeOutTimer.Enabled := true;
end;

procedure TForm001.Form001CloseClick(Sender: TObject);
begin
  Form002.FadeOutTimer.Enabled := true;
  Form001.FadeOutTimer.Enabled := true;
end;

procedure TForm001.Form001HideClick(Sender: TObject);
begin
Form001.FormMinimizeTimer.Enabled := true;
end;

procedure TForm001.Form001ShowClick(Sender: TObject);
begin
  if Form001.WindowState = wsMinimized then
    begin
      Form001.Perform(WM_SYSCOMMAND, SC_RESTORE, 0);
    end
    else
    Form001.show;
end;

procedure TForm001.Form002CloseClick(Sender: TObject);
begin
Form002.FadeOutTimer.Enabled := true;
end;

procedure TForm001.Form002HideClick(Sender: TObject);
begin
Form002.FormMinimizeTimer.Enabled := true;
end;

procedure TForm001.Form002ShowClick(Sender: TObject);
begin
  if Form002.WindowState = wsMinimized then
    begin
      Form002.Perform(WM_SYSCOMMAND, SC_RESTORE, 0);
    end
    else
    Form002.show;
end;

procedure TForm001.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Form001.FadeOutTimer.Enabled := true;
end;

procedure TForm001.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if CrossButtonClick = true
    then
      begin
        CanClose := true;
        Exit;
      end;
  CanClose := false;
  Form001.FadeOutTimer.Enabled := true;
end;

procedure TForm001.FormCreate(Sender: TObject);
begin
  Form001.FadeInTimer.Enabled := true;
end;

procedure TForm001.FormHide(Sender: TObject);
begin
  Form001.FadeOutTimer.Enabled := true;
end;

procedure TForm001.FormShow(Sender: TObject);
begin
  Form001.FadeInTimer.Enabled := true;
end;
procedure TForm001.TrayIconDblClick(Sender: TObject);
begin
  Form001.FormRestoreTimer.Enabled := true;
  TrayIcon.Visible := False;
  WindowState := wsNormal;
  Application.BringToFront();
end;

procedure TForm001.FadeInTimerTimer(Sender: TObject);
begin
  if Form001.AlphaBlendValue >= 220
    then
      begin
        Form001.FadeInTimer.Enabled := false;
      end
    else
      begin
        Form001.AlphaBlendValue := Form001.AlphaBlendValue + 10;
        CrossButtonClick := false;
      end;
end;

procedure TForm001.FadeOutTimerTimer(Sender: TObject);
begin
  if Form001.AlphaBlendValue <= 0
    then
      begin
        Form001.FadeOutTimer.Enabled := false;
        CrossButtonClick := true;
        Self.Close;
      end
    else
      begin
        Form001.AlphaBlendValue := Form001.AlphaBlendValue - 10;
        CrossButtonClick := true;
      end;
end;

procedure TForm001.FormMinimizeTimerTimer(Sender: TObject);
begin
  if Form001.AlphaBlendValue > 0 then
    begin
      Form001.AlphaBlendValue := Form001.AlphaBlendValue - 10;
    end
  else
    begin
      Form001.FormMinimizeTimer.Enabled := false;
      Perform(WM_SYSCOMMAND, SC_MINIMIZE, 0);
    end;
end;

procedure TForm001.FormRestoreTimerTimer(Sender: TObject);
begin
  if Form001.AlphaBlendValue < 220 then
    begin
      Form001.AlphaBlendValue := Form001.AlphaBlendValue + 10;
    end
  else
    begin
      Form001.FormRestoreTimer.Enabled := false;
    end;
end;

end.

如果我执行以下操作

  Application.MainFormOnTaskbar := false;

表格是完全不可见的。我认为应该有一个错误。但我找不到它。

于 2012-08-08T06:53:55.777 回答