以下のコードを実装しました。ここでは、1 つを除いてすべて問題ありません。フォームを最小化すると、「SystemTray」に移動しますが、「タスクバー」でも使用できます。私のアプリケーションでは、「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つあるはずだと思います。しかし、私はそれを見つけることができません。