diff --git a/delphi-backend/PMServer.dpr b/delphi-backend/PMServer.dpr index d664fd3..31d61bf 100644 --- a/delphi-backend/PMServer.dpr +++ b/delphi-backend/PMServer.dpr @@ -1,4 +1,4 @@ -program PMServer; +program PMServer; uses System.SysUtils, // FindCmdLineSwitch diff --git a/delphi-backend/PMServer.dproj b/delphi-backend/PMServer.dproj index 6a73c1a..fc63078 100644 --- a/delphi-backend/PMServer.dproj +++ b/delphi-backend/PMServer.dproj @@ -204,6 +204,7 @@ $(PreBuildEvent)]]> PMServer_Icon1.ico app.png app.png + -tray diff --git a/delphi-backend/UMainForm.fmx b/delphi-backend/UMainForm.fmx index 80800bc..e92c557 100644 --- a/delphi-backend/UMainForm.fmx +++ b/delphi-backend/UMainForm.fmx @@ -127,10 +127,4 @@ object MainForm: TMainForm Left = 424 Top = 240 end - object Timer1: TTimer - Interval = 1 - OnTimer = Timer1Timer - Left = 568 - Top = 184 - end end diff --git a/delphi-backend/UMainForm.pas b/delphi-backend/UMainForm.pas index 072db7e..0319ba2 100644 --- a/delphi-backend/UMainForm.pas +++ b/delphi-backend/UMainForm.pas @@ -64,7 +64,6 @@ type Memo: TMemo; Splitter: TSplitter; PopupMenu1: TPopupMenu; - Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); @@ -72,7 +71,6 @@ type procedure btnStopClick(Sender: TObject); procedure btnToggleLogClick(Sender: TObject); procedure btnReloadClick(Sender: TObject); - procedure Timer1Timer(Sender: TObject); private // Windows minimising the window from the outside (Win+D / Show desktop / // taskbar) makes FMX forget it was maximised: the window comes back @@ -86,11 +84,6 @@ type // restore's resize is indistinguishable from a user gesture by placement // flags or foreground ownership — both were measured and rejected). FWinEventHook: THandle; - // --tray only: catches EVENT_OBJECT_SHOW so any top-level window of ours - // is hidden the instant Windows shows it. The FMX taskbar proxy is created - // partway through FormCreate — it does not exist at the first hide points - // and was therefore visible for the best part of a second. - FShowEventHook: THandle; // True from "minimise starts" until just after the restore settles, so the // resizes FMX fires while restoring are not recorded as user intent. FIgnoreResizes: Boolean; @@ -180,10 +173,6 @@ type // stuck raised (see the implementation). // One-shot: hides the window the first time FMX shows it on a --tray // launch, then unhooks itself. - // Hides the form AND the FMX taskbar proxy right now, logging whether the - // window was actually visible — that is what pins down when FMX shows it. - procedure TrayHideNow(const ATag: string); - procedure TrayStartupHideOnce(Sender: TObject); procedure RestoreWindowFromTray; procedure WinStateMinimizeStart; procedure WinStateMinimizeEnd; @@ -210,11 +199,6 @@ function MaskAccessToken(const AUrl: string): string; forward; // ---- WinEvent hook plumbing (see the maximised-state block further down) -- const - EVENT_OBJECT_SHOW = $8002; - // Synchronous delivery, in our own process. OUTOFCONTEXT would queue the - // callback until the thread pumps messages — which does not happen during - // FormCreate, exactly when we need to react. - WINEVENT_INCONTEXT = $0004; EVENT_SYSTEM_MINIMIZESTART = $0016; EVENT_SYSTEM_MINIMIZEEND = $0017; WINEVENT_OUTOFCONTEXT = $0000; @@ -226,66 +210,39 @@ function SetWinEventHook(eventMin, eventMax: DWORD; hmodWinEventProc: HMODULE; function UnhookWinEvent(hWinEventHook: THandle): BOOL; stdcall; external 'user32.dll' name 'UnhookWinEvent'; -// Defined lower down, next to the window-state logic it serves. -// Unit-level, NOT a form field: Application.CreateForm only assigns MainForm -// after the constructor returns, so during FormCreate the global is still nil -// and the callback could not reach the form at all. -var - GTrayStartupPending: Boolean = False; - procedure WinStateEventProc(hWinEventHook: THandle; AEvent: DWORD; AWnd: HWND; idObject, idChild: LongInt; idEventThread, dwmsEventTime: DWORD); stdcall; forward; -procedure TrayShowEventProc(hWinEventHook: THandle; AEvent: DWORD; AWnd: HWND; - idObject, idChild: LongInt; idEventThread, dwmsEventTime: DWORD); stdcall; forward; -function FindOurFMXAppWindow: HWND; forward; procedure StartTrayProxyHider; begin - GTrayStartupPending := True; - TThread.CreateAnonymousThread( - procedure - var - LWnd: HWND; - LTicks: Integer; - begin - LTicks := 0; - // 5 ms cadence, 20 s ceiling. Stops as soon as the tray startup marks - // itself done, so a user restoring from the tray is never fought. - while GTrayStartupPending and (LTicks < 4000) do - begin - LWnd := FindOurFMXAppWindow; - if LWnd <> 0 then - ShowWindow(LWnd, SW_HIDE); // unconditional: the button can be up - Sleep(5); // before WS_VISIBLE reads as set - Inc(LTicks); - end; - end).Start; + // ApplicationHWND (FMX.Platform.Win) IS the taskbar proxy — no hunting for a + // TFMAppClass window, and it is valid this early, before the form exists. + ShowWindow(ApplicationHWND, SW_HIDE); + // Hiding alone does not reliably drop the button: the taskbar had already + // drawn it. Clearing WS_EX_APPWINDOW and setting WS_EX_TOOLWINDOW does — + // a tool window is never listed. Undone by TrayProxyShowInTaskbar before any + // restore, otherwise the app would come back with no taskbar button at all. + SetWindowLong(ApplicationHWND, GWL_EXSTYLE, + (GetWindowLong(ApplicationHWND, GWL_EXSTYLE) and (not WS_EX_APPWINDOW)) + or WS_EX_TOOLWINDOW); +end; + +// Give the proxy its normal styles back. Takes effect on the next show, which +// is exactly what RestoreFromTray does right after. +procedure TrayProxyShowInTaskbar; +begin + SetWindowLong(ApplicationHWND, GWL_EXSTYLE, + (GetWindowLong(ApplicationHWND, GWL_EXSTYLE) and (not WS_EX_TOOLWINDOW)) + or WS_EX_APPWINDOW); end; procedure TMainForm.FormCreate(Sender: TObject); begin - // --tray ("Start with Windows"): get the window off screen as early as - // possible. Visible := False alone is not enough — FMX re-shows the main - // form after the constructor returns — so OnActivate hides it again the - // instant it appears. That fires on the very first show, long before the - // deferred MinimizeToTray below, which only runs once the message loop is - // free (i.e. after the DB open, the server start and the WebView2 init: - // the second the window used to sit on screen during the Windows logon). + // --tray ("Start with Windows"): the taskbar proxy was already dealt with in + // the .dpr (StartTrayProxyHider) — it is shown before FormCreate is even + // reached. This just keeps the form itself off screen. if FindCmdLineSwitch('tray', True) then - begin - Visible := False; - OnActivate := TrayStartupHideOnce; - GTrayStartupPending := True; - FShowEventHook := SetWinEventHook( - EVENT_OBJECT_SHOW, EVENT_OBJECT_SHOW, 0, - @TrayShowEventProc, GetCurrentProcessId, 0, WINEVENT_INCONTEXT); - LogLine('[tray] FormCreate begin at ' + FormatDateTime('hh:nn:ss.zzz', Now) + - ' show-hook=' + BoolToStr(FShowEventHook <> 0, True)); - // The proxy watcher is NOT started here: FMX shows the taskbar proxy - // before FormCreate is even reached, so it is launched from the .dpr - // (StartTrayProxyHider) right after Application.Initialize. - TrayHideNow('hide#1 top-of-FormCreate'); - end; + Visible := False; // The .fmx ships WindowState = wsMaximized, so that is the starting intent. // Wired here (not in the .fmx) to keep the designer file untouched. @@ -325,9 +282,6 @@ begin {$ENDIF} WebBrowser.Parent := Self; WebBrowser.Align := TAlignLayout.Client; - // Parenting forces the form's window handle to exist, and that is the point - // FMX may show it — hide again right away. - if FindCmdLineSwitch('tray', True) then TrayHideNow('hide#2 after-browser-parent'); FServer := TPMHTTPServer.Create; FServer.OnLog := LogLine; @@ -404,21 +358,13 @@ begin // it's noise when Windows itself put us in the tray (the user // didn't actively minimise). Manual launches still see it once. FBridge.BalloonShown := True; - TrayHideNow('hide#3 end-of-FormCreate'); TThread.ForceQueue(nil, procedure begin FBridge.MinimizeToTray; // Hidden now — safe to pay the startup cost. btnStartClick(Nil); - GTrayStartupPending := False; - if FShowEventHook <> 0 then - begin - UnhookWinEvent(FShowEventHook); - FShowEventHook := 0; - end; - LogLine('[tray] deferred MinimizeToTray ran at ' + - FormatDateTime('hh:nn:ss.zzz', Now)); + LogLine('Launched with --tray, started hidden (balloon suppressed)'); end); end; end; @@ -430,11 +376,6 @@ begin UnhookWinEvent(FWinEventHook); FWinEventHook := 0; end; - if FShowEventHook <> 0 then - begin - UnhookWinEvent(FShowEventHook); - FShowEventHook := 0; - end; if Assigned(FFileSaveChunks) then begin for var LSB in FFileSaveChunks.Values do LSB.Free; @@ -1692,69 +1633,6 @@ begin else if AEvent = EVENT_SYSTEM_MINIMIZEEND then MainForm.WinStateMinimizeEnd; end; -// While a --tray launch is still starting up, every top-level window our -// process shows gets hidden again immediately. Scoped to our process by the -// hook itself; WebView2 runs in separate processes so its windows never reach -// here. Torn down as soon as startup finishes. -// Our FMX taskbar proxy (TFMAppClass), found by class name and filtered on our -// own process id — the same lookup TPMBridge does, duplicated here because it -// must work from a worker thread before FBridge even exists. -function FindOurFMXAppWindow: HWND; -var - LPid: DWORD; -begin - Result := FindWindowEx(0, 0, 'TFMAppClass', nil); - while Result <> 0 do - begin - LPid := 0; - GetWindowThreadProcessId(Result, LPid); - if LPid = GetCurrentProcessId then Exit; - Result := FindWindowEx(0, Result, 'TFMAppClass', nil); - end; -end; - -procedure TrayShowEventProc(hWinEventHook: THandle; AEvent: DWORD; AWnd: HWND; - idObject, idChild: LongInt; idEventThread, dwmsEventTime: DWORD); stdcall; -begin - if not GTrayStartupPending then Exit; - if (idObject <> OBJID_WINDOW) or (AWnd = 0) then Exit; - if GetParent(AWnd) <> 0 then Exit; // top-level windows only - ShowWindow(AWnd, SW_HIDE); -end; - -pprocedure TMainForm.Timer1Timer(Sender: TObject); -begin - -end; - -rocedure TMainForm.TrayHideNow(const ATag: string); -var - LHwnd, LAppHwnd: HWND; - LWasVisible: Boolean; -begin - LHwnd := WindowHandleToPlatform(Self.Handle).Wnd; - LWasVisible := (LHwnd <> 0) and IsWindowVisible(LHwnd); - if LHwnd <> 0 then ShowWindow(LHwnd, SW_HIDE); - LAppHwnd := 0; - if Assigned(FBridge) then LAppHwnd := FBridge.FindFMXAppWindow; - if LAppHwnd <> 0 then ShowWindow(LAppHwnd, SW_HIDE); - LogLine(Format('[tray] %s at %s — form_visible_was=%s hwnd=%d app=%d', - [ATag, FormatDateTime('hh:nn:ss.zzz', Now), - BoolToStr(LWasVisible, True), LHwnd, LAppHwnd])); -end; - -procedure TMainForm.TrayStartupHideOnce(Sender: TObject); -begin - OnActivate := nil; // one shot — never fight the user afterwards - Visible := False; - TrayHideNow('hide#4 on-activate'); - - var AppHandle := ApplicationHWND; - ShowWindow(AppHandle, SW_HIDE); - SetWindowLong(AppHandle, GWL_EXSTYLE, - GetWindowLong(AppHandle, GWL_EXSTYLE) and (not WS_EX_APPWINDOW) or WS_EX_TOOLWINDOW); -end; - // Single entry point for every tray restore. ExecuteAutofill really minimises // the window (SW_MINIMIZE) before typing, which raises the guard; if the window // is then HIDDEN to the tray instead of being un-minimised, MINIMIZEEND may @@ -1764,6 +1642,9 @@ end; procedure TMainForm.RestoreWindowFromTray; begin FIgnoreResizes := False; + // A --tray launch turned the proxy into a tool window to keep it off the + // taskbar during startup; put it back before showing anything. + TrayProxyShowInTaskbar; FBridge.RestoreFromTray; end;