私はDelphiの学習者です。 Delphi MainFormをタスクバーではなくシステムトレイに最小化するための解決策を探しています。システムトレイアイコンを右クリックすると、「復元」、「バージョン情報」、「ヘルプ」などのメニューが表示されます。システムトレイアイコンがImagelis1から読み込まれ、アニメーション化されます。 「復元」をクリックすると、MainFormが復元され、「About」をクリックすると「Form2」が復元され、「Help」をクリックすると「Foprm3」が復元されます。私はインターネットで非常に多くの解決策を見つけました:
しかし、すべてのソリューションにはいくつかの欠点があります。一度だけ実行できるものもあります。 Windows7では一部のアイコンがぼやけています。誰かが私のためにコードを書く人はいないので、自分のコードを見せなければならないと言うかもしれません。プレーズはこの点について私を許してくれた。ウィンドウのバージョンに依存せずにユニバースで実装できる具体的なソリューションを教えてください。それは一人一人を助けます。私を助けてください。
これでうまくいくはずです。フォームにTTrayIcon
とTApplicationEvents
をドロップします。以下のコードは docwiki のTTrayIcon - Delphi Example
からのものです。 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;
右クリックして表示されるメニューで、TPopupMenu
をフォームに追加し、そこに必要なアイテムを追加し、通常どおりそれらのアイテムのイベントハンドラーを記述してから、PopupMenu
を割り当てますTrayIcon.PopupMenu
プロパティに追加します。
「ぼやけたアイコン」は、適切なアイコンサイズを使用しておらず、Windowsがアイコンのサイズ変更(ストレッチ)を強制されていることが原因です。アイコンエディタを使用して、各アイコンに複数のサイズの画像を作成します(1つのアイコンファイルに複数のサイズが存在する場合があります)。
TrayIconをmyFormにドロップし、次の簡単なコードを追加します。
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;
これにより、TrayIconが常に表示され、クリックすると次のようになります。
つまり、TrayIconをクリックすると、アプリケーションの表示が変わります。 TrayIconバーに最小化するのと同じように。
...そして、TTrayIcon
が存在しないDelphi 6では、次の単純なコードを使用できます。
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.
以下のコードを実装しました。ここでは、1つを除いてすべて問題ありません。フォームを最小化すると、「SystemTray」に移動しますが、「TaskBar」でも使用できます。このアプリケーションでは、「Form001」の「AlphaBlend」プロパティはtrueで、「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;
フォームは完全に非表示です。バグは1つあるはずです。しかし、私はそれを見つけることができません。