unit Package1Unit;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils, System.Classes,
System.Win.ComObj,
Winapi.ShlObj,
Winapi.Dwmapi,
Vcl.ExtCtrls,
Vcl.Forms;
//procedure Register;
implementation
type
TStartDummy =
class
private
class procedure AssignToStart;
class procedure WaitTimer(Sender: TObject);
end;
TDestroyDummy =
class(TPanel)
// TPanel wegen WMShowWindow (eigentlich TComponent)
public
procedure BeforeDestruction;
override;
private
procedure WMShowWindow(
var Msg: TWMShowWindow);
message WM_SHOWWINDOW;
end;
class procedure TStartDummy.AssignToStart;
var
Taskbar: ITaskbarList3;
begin
for var i := Screen.CustomFormCount - 1
downto 0
do
if (Screen.CustomForms[i].ClassType = TForm)
and (Screen.CustomForms[i].Caption = '
SplashScreen')
then
begin
// in Taskleiste anteigen
ShowWindow(Screen.CustomForms[i].Handle, SW_HIDE);
SetWindowLong(Screen.CustomForms[i].Handle, GWL_EXSTYLE, GetWindowLong(Screen.CustomForms[i].Handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW
or WS_EX_APPWINDOW);
ShowWindow(Screen.CustomForms[i].Handle, SW_SHOW);
// Texte und Arbeitsanzeige
Screen.CustomForms[i].Caption := '
Delphi wird gestartet';
Taskbar := CreateComObject(CLSID_TaskbarList)
as ITaskbarList3;
{CheckOSError}(Taskbar.SetProgressState(Screen.CustomForms[i].Handle, TBPF_INDETERMINATE));
//{CheckOSError}(Taskbar.SetThumbnailTooltip(Screen.CustomForms[i].Handle, 'Delphi wird gestartet'));
end;
//TDestroyDummy.Create(Application.MainForm); // an Hauptfenster hängen
with TDestroyDummy.Create(Application.MainForm)
do begin // an Hauptfenster hängen
Parent := Application.MainForm;
BevelOuter := TPanelBevel.bvNone;
Width := 1;
Height := 1;
TabStop := False;
Visible := True;
end;
end;
class procedure TStartDummy.WaitTimer(Sender: TObject);
var
B: Boolean;
begin
try
B := Assigned(Application)
and Assigned(Application.MainForm);
for var i := Screen.CustomFormCount - 1
downto 0
do
if (Screen.CustomForms[i].ClassType = TForm)
and (Screen.CustomForms[i].Caption = '
SplashScreen')
then
B := True;
if B
then begin
TStartDummy.AssignToStart;
Sender.Free;
end;
except
end;
end;
procedure TDestroyDummy.BeforeDestruction;
var
WndClass: TWndClass;
TaskWnd: HWND;
Taskbar: ITaskbarList3;
Param: BOOL;
begin
try
FillChar(WndClass, SizeOf(WndClass), 0);
WndClass.lpfnWndProc := @DefWindowProc;
WndClass.hInstance := HInstance;
WndClass.hIcon := 0;
WndClass.lpszClassName := '
TaskbarDestroyDummy';
{Win32Check}(RegisterClassW(WndClass)
{<> 0});
TaskWnd := CreateWindowEx(WS_EX_TOOLWINDOW
or WS_EX_APPWINDOW, WndClass.lpszClassName, PChar('
Delphi wird beended'),
WS_VISIBLE
{or WS_POPUP or WS_CAPTION or WS_CLIPSIBLINGS}, 100, 100, 0, 0, 0, 0, HInstance,
nil);
{Win32Check(TaskWnd <> 0);}
Taskbar := CreateComObject(CLSID_TaskbarList)
as ITaskbarList3;
{CheckOSError}(Taskbar.SetProgressState(TaskWnd, TBPF_INDETERMINATE));
{CheckOSError}(Taskbar.SetThumbnailTooltip(TaskWnd, '
Delphi wird beendet'));
Param := True;
{CheckOSError}(DwmSetWindowAttribute(TaskWnd, DWMWA_FORCE_ICONIC_REPRESENTATION, @Param, SizeOf(BOOL)));
{CheckOSError}(DwmSetWindowAttribute(TaskWnd, DWMWA_HAS_ICONIC_BITMAP, @Param, SizeOf(BOOL)));
inherited;
except
end;
end;
procedure TDestroyDummy.WMShowWindow(
var Msg: TWMShowWindow);
begin
MessageBox(0, PChar(IntToStr(Msg.Status)),
nil, 0);
end;
//procedure Register; // wenn in HKEY_CURRENT_USER\Software\Embarcadero\BDS\22.0\Known IDE Packages
//begin
// TStartDummy.AssignToStart;
//end;
initialization
with TTimer.Create(
nil)
do begin // wenn in HKEY_CURRENT_USER\Software\Embarcadero\BDS\22.0\Known Packages
OnTimer := TStartDummy.WaitTimer;
Interval := 1;
Enabled := True;
end;
finalization
try
if Assigned(Application)
and Assigned(Application.MainForm)
then
for var C
in Application.MainForm
do
if C
is TDestroyDummy
then begin
C.Free;
Break;
end;
except
end;
end.