////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Application Form related routines.                                         //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230810 - Created by A.K. from _stdapp                                    //
// 20231220 - SdiFlags                                                        //
// 20240621 - DefaultHandler, dlc_FormDefaultHandler                          //
// 20240622 - AdjustDesktopByForm                                             //
// 20250129 - Use TAtomicCounter                                              //
// 20250216 - PendingTrigger                                                  //
// 20250227 - TFormHelper,TMasterForm.DoUpdateLeft/Top/Width/Height           //
// 20251210 - TMasterForm.WinCaption                                          //
// 20251225 - TMasterForm.LastBornTime,LastKillTime                           //
// 20260129 - TMasterForm.WinPrimeName,WinAlterName                           //
// 20260130 - TMasterForm.IsWinNameMatch,IsWinNameMatchList                   //
////////////////////////////////////////////////////////////////////////////////

unit _crw_appforms; //  Application Form routines.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
sysutils, classes, math,
forms, controls, lmessages, lcltype,
_crw_alloc, _crw_ef, _crw_fio, _crw_str, _crw_rtc,
 _crw_wmctrl, _crw_dbglog;

 {
 *****************************************************
 TForm helper. Uses in CRWLIB to simplify programming.
 *****************************************************
 }
type
 TFormHelper = class helper for TForm
 public
  procedure UpdateTop(T:Integer);
  procedure UpdateLeft(L:Integer);
  procedure UpdateWidth(W:Integer);
  procedure UpdateHeight(H:Integer);
 end;

 {
 *******************************************
 Basic class for Forms with Master property.
 *******************************************
 Master property is pointer to static variable, wich points to object.
 TMasterForm clears this variable to nil in destructor, so we may be sure
 that this variable always have correct value.
 Example:
  x:=TMasterObject.Create;
  x.Master:=@x;
  ...
  x.Free;          // automatically set variable x to nil
  ...
  if x.Ok then ... // check object valid
  Notes:
  1) SdiFlags is reserved for SDI Forms support.
  2) AddonSdiFlags uses in Form.AfterConstruction to add SDI flags.
 }
type
 PMasterForm = ^TMasterForm;
 TMasterForm = class(TForm)
 private
  myRef          : Integer;
  myMaster       : PMasterForm;
  mySdiFlags     : QWord;
  myWmWnd        : HWND;
  myWmClass      : LongString;
  myWinPrimeName : LongString;
  myWinAlterName : LongString;
  function    GetOk:Boolean;
  function    GetRef:Integer;
  function    GetSdiFlags:QWord;
  function    GetWmWnd:HWND;
  function    GetWmClass:LongString;
  function    GetWinCaption:LongString;
  function    GetWinPrimeName:LongString;
  procedure   SetWinPrimeName(const aName:LongString);
  function    GetWinAlterName:LongString;
  procedure   SetWinAlterName(const aName:LongString);
  function    GetWmDescription:LongString;
  function    GetWmDesktop:Integer;
  procedure   SetWmDesktop(aDesktop:Integer);
 protected
  function    CheckOk:Boolean; virtual;
  function    GetMaster:PMasterForm;
  procedure   SetMaster(aMaster:PMasterForm);
  procedure   ClearMaster;
  procedure   WndProc(var Message: TLMessage); override;
  procedure   DoUpdateTop(T:Integer); virtual;
  procedure   DoUpdateLeft(L:Integer); virtual;
  procedure   DoUpdateWidth(W:Integer); virtual;
  procedure   DoUpdateHeight(H:Integer); virtual;
 public
  procedure   DefaultHandler(var aMessage); override;
 public
  constructor Create(AOwner: TComponent); override;
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  property    Ok       : Boolean      read GetOk;
  property    Ref      : Integer      read GetRef;
  property    Master   : PMasterForm  read GetMaster write SetMaster;
 public
  property    SdiFlags : QWord read GetSdiFlags;
  procedure   AddonSdiFlags(aFlags:QWord);
 public
  property    WinCaption:LongString read GetWinCaption;
  property    WinPrimeName:LongString read GetWinPrimeName write SetWinPrimeName;
  property    WinAlterName:LongString read GetWinAlterName write SetWinAlterName;
  function    IsWinNameMatch(const aPattern:LongString; Mode:Integer=7):Boolean;
  function    IsWinNameMatchList(const aWinList:LongString; Delims:TCharSet; Mode:Integer=7):Boolean;
 public
  procedure   LocateToCenterOfScreen;
  procedure   LocateToCenterOfMouse;
 public // WindowManager's window handle, class, desktop etc
  procedure   WmReset;
  property    WmWnd:HWND read GetWmWnd;
  property    WmClass:LongString read GetWmClass;
  property    WmDescription:LongString read GetWmDescription;
  property    WmDesktop:Integer  read GetWmDesktop write SetWmDesktop;
 public
  function    AdjustDesktopByForm(aForm:TForm):Integer;
 public // @set Form.Left 0 relative Screen
  function ApplyParams(const Params:LongString):Integer;
  function DoApplyParams(const Params:LongString):Integer; virtual;
 private   // pending triggers: flags for delayed operations
  myPendingTriggers : TByteSet; // upto 255 triggers allowed
  class var myLastRegisteredPendingTrigger:Integer;
  function  GetPendingTrigger(aTrigger:Integer):Boolean;
  procedure SetPendingTrigger(aTrigger:Integer; aState:Boolean);
 public // pending triggers uses as flags for deferred (delayed) operations
  property PendingTrigger[aTrigger:Integer]:Boolean read GetPendingTrigger write SetPendingTrigger;
  class function RegisterPendingTrigger:Integer; // to be called once per trigger
 private
  class var myLastBornTime:Int64;
  class var myLastKillTime:Int64;
 public
  class function  LastBornTime:Int64;
  class function  LastKillTime:Int64;
  class var SleepAfterBornKill:Integer;
  class function  IsMonitoringOnPause:Boolean;
  class procedure AwakeMonitoring;
 end;

procedure Kill(var TheObject:TMasterForm); overload;

const
 TMasterFormWndProcCallCount : Int64 = 0;

 // DebugLog channel to catch unhandled messages
function dlc_FormDefaultHandler:Integer; inline;

implementation

uses
 _crw_apptools;

 {
 **************************
 TFormHelper implementation
 **************************
 }
procedure TFormHelper.UpdateTop(T:Integer);
begin
 if Assigned(Self) then begin
  if (Self is TMasterForm)
  then (Self as TMasterForm).DoUpdateTop(T)
  else Top:=T;
 end;
end;

procedure TFormHelper.UpdateLeft(L:Integer);
begin
 if Assigned(Self) then begin
  if (Self is TMasterForm)
  then (Self as TMasterForm).DoUpdateLeft(L)
  else Left:=L;
 end;
end;

procedure TFormHelper.UpdateWidth(W:Integer);
begin
 if Assigned(Self) then begin
  if (Self is TMasterForm)
  then (Self as TMasterForm).DoUpdateWidth(W)
  else Width:=W;
 end;
end;

procedure TFormHelper.UpdateHeight(H:Integer);
begin
 if Assigned(Self) then begin
  if (Self is TMasterForm)
  then (Self as TMasterForm).DoUpdateHeight(H)
  else Height:=H;
 end;
end;

 {
 **************************
 TMasterForm implementation
 **************************
 }
const
 BornKillBalance : TAtomicCounter = nil;

procedure InitBornKillCounters;
begin
 LockedInit(BornKillBalance);
end;

procedure FreeBornKillCounters;
begin
 LockedFree(BornKillBalance);
end;

constructor TMasterForm.Create(AOwner:TComponent);
begin
 inherited Create(AOwner);
 mySdiFlags:=0;
 myMaster:=nil;
 myWmWnd:=0;
 myWmClass:='';
 myWinPrimeName:='';
 myWinAlterName:='';
 if IsUnix then myWmClass:=wmctrl.IcccmClass;
 if IsWindows then myWmClass:=wmctrl.WindowClass(Handle);
end;

destructor TMasterForm.Destroy;
begin
 myWmClass:='';
 myWinPrimeName:='';
 myWinAlterName:='';
 inherited Destroy;
end;

procedure TMasterForm.AfterConstruction;
begin
 inherited AfterConstruction;
 if UsesBornKillLog
 then BornKillLog(Format('BORN %-25s %8.8x %8.8x %d',
                  [ClassName, Integer(Self), GetCurrentThreadID, LockedGet(BornKillBalance)]));
 LockedInc(BornKillBalance);
 myRef:=ObjectRegistry.InitRef(Self);
 myLastBornTime:=GetTickCount64;
end;

procedure TMasterForm.BeforeDestruction;
begin
 myLastKillTime:=GetTickCount64;
 ObjectRegistry.FreeRef(myRef);
 LockedDec(BornKillBalance);
 if UsesBornKillLog
 then BornKillLog(Format('KILL %-25s %8.8x %8.8x %d',
                  [ClassName, Integer(Self), GetCurrentThreadID, LockedGet(BornKillBalance)]));
 if (FormStyle=fsMDIChild) and (WindowState=wsMaximized) then WindowState:=wsMinimized;
 ClearMaster;
 inherited BeforeDestruction;
end;

function TMasterForm.GetOk:Boolean;
begin
 if Assigned(Self) then Result:=CheckOk else Result:=false;
end;

function TMasterForm.GetRef:Integer;
begin
 if Assigned(Self) then Result:=myRef else Result:=0;
end;

function TMasterForm.GetSdiFlags:QWord;
begin
 if Assigned(Self) then Result:=mySdiFlags else Result:=0;
end;

procedure TMasterForm.AddonSdiFlags(aFlags:QWord);
begin
 if Assigned(Self) then LiftFlags(mySdiFlags,aFlags,true);
end;

function TMasterForm.GetWmWnd:HWND;
begin
 Result:=0;
 if Assigned(Self) then begin
  if (myWmWnd=0) then begin
   if IsWindows then myWmWnd:=Handle;
   if IsUnix then myWmWnd:=wmctrl.FindWindow(GetCurrentProcessId,WmClass,Caption);
  end;
  Result:=myWmWnd;
 end;
end;

function TMasterForm.GetWmClass:LongString;
begin
 if Assigned(Self) then Result:=myWmClass else Result:='';
end;

function TMasterForm.GetWmDesktop:Integer;
begin
 if Assigned(Self)
 then Result:=wmctrl.WindowDesktop(WmWnd)
 else Result:=-1;
end;

procedure TMasterForm.SetWmDesktop(aDesktop:Integer);
begin
 if Assigned(Self) then wmctrl.SetWindowDesktop(WmWnd,aDesktop);
end;

function TMasterForm.AdjustDesktopByForm(aForm:TForm):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 if (aForm is TMasterForm) then
 if (wmctrl.DesktopCount>1) then begin
  if (WmDesktop<>TMasterForm(aForm).WmDesktop)
  then WmDesktop:=TMasterForm(aForm).WmDesktop;
  Result:=WmDesktop;
 end;
end;

function TMasterForm.GetWmDescription:LongString;
begin
 if Assigned(Self)
 then Result:=Format('0x%8.8x %2d %-5u %s %s %s',[WmWnd,WmDesktop,GetCurrentProcessId,WmClass,HostName,Caption])
 else Result:='';
end;

procedure TMasterForm.WmReset;
begin
 if Assigned(Self) then myWmWnd:=0;
end;

function TMasterForm.GetWinCaption:LongString;
begin
 if Assigned(Self)
 then Result:=Caption
 else Result:='';
end;

function TMasterForm.GetWinPrimeName:LongString;
begin
 if Assigned(Self)
 then Result:=myWinPrimeName
 else Result:='';
end;

procedure TMasterForm.SetWinPrimeName(const aName:LongString);
begin
 if Assigned(Self) then myWinPrimeName:=aName;
end;

function TMasterForm.GetWinAlterName:LongString;
begin
 if Assigned(Self)
 then Result:=myWinAlterName
 else Result:='';
end;

procedure TMasterForm.SetWinAlterName(const aName:LongString);
begin
 if Assigned(Self) then myWinAlterName:=aName;
end;

function TMasterForm.IsWinNameMatch(const aPattern:LongString; Mode:Integer=7):Boolean;
begin
 Result:=False;
 if Assigned(Self) and (aPattern<>'') then begin
  if HasFlags(Mode,1) and IsSameText(aPattern,WinCaption) then Exit(True);
  if HasFlags(Mode,2) and IsSameText(aPattern,WinPrimeName) then Exit(True);
  if HasFlags(Mode,4) and IsSameText(aPattern,WinAlterName) then Exit(True);
 end;
end;

function TMasterForm.IsWinNameMatchList(const aWinList:LongString; Delims:TCharSet; Mode:Integer=7):Boolean;
var i:Integer; item:LongString;
begin
 Result:=False;
 if Assigned(Self) and (aWinList<>'') then begin
  for i:=1 to WordCount(aWinList,Delims) do begin
   item:=ExtractWord(i,aWinList,Delims);
   Result:=IsWinNameMatch(item,Mode);
   if Result then Break;
  end;
 end;
end;

procedure TMasterForm.LocateToCenterOfScreen;
begin
 if Assigned(Self) then begin
  Left := Screen.DesktopLeft + ((Screen.DesktopWidth  - Width)  div 2);
  Top  := Screen.DesktopTop  + ((Screen.DesktopHeight - Height) div 2);
 end;
end;

procedure TMasterForm.LocateToCenterOfMouse;
begin
 if Assigned(Self) then begin
  Top  := Max(Screen.DesktopTop,  Min(Mouse.CursorPos.Y-(Height div 2),Screen.DesktopHeight-Height));
  Left := Max(Screen.DesktopLeft, Min(Mouse.CursorPos.X-(Width div 2),Screen.DesktopWidth-Width));
 end;
end;

function TMasterForm.CheckOk:Boolean;
begin
 Result:=true;
end;

function TMasterForm.GetMaster:PMasterForm;
begin
 if Assigned(Self) then Result:=myMaster else Result:=nil;
end;

procedure TMasterForm.SetMaster(aMaster:PMasterForm);
begin
 if Assigned(Self) then
 try
  if (aMaster<>nil) and (aMaster^=Self) then myMaster:=aMaster else myMaster:=nil;
 except
  on E:Exception do BugReport(E,Self,'SetMaster');
 end;
end;

procedure TMasterForm.ClearMaster;
begin
 if Assigned(Self) then
 try
  if Assigned(myMaster) then if myMaster^=Self then myMaster^:=nil;
  myMaster:=nil;
 except
  on E:Exception do BugReport(E,Self,'ClearMaster');
 end;
end;

procedure TMasterForm.WndProc(var Message: TLMessage);
begin
 inherited WndProc(Message);
 inc(TMasterFormWndProcCallCount);
end;

procedure TMasterForm.DoUpdateTop(T:Integer);
begin
 Top:=T;
end;

procedure TMasterForm.DoUpdateLeft(L:Integer);
begin
 Left:=L;
end;

procedure TMasterForm.DoUpdateWidth(W:Integer);
begin
 Width:=W;
end;

procedure TMasterForm.DoUpdateHeight(H:Integer);
begin
 Height:=H;
end;

const _dlc_FormDefaultHandler:Integer=0;

function dlc_FormDefaultHandler:Integer;
begin
 Result:=_dlc_FormDefaultHandler;
end;

procedure TMasterForm.DefaultHandler(var aMessage);
var Msg:TLMessage absolute aMessage; s:LongString;
begin
 inherited DefaultHandler(aMessage);
 if DebugLogEnabled(_dlc_FormDefaultHandler) then begin
  s:=Format('%s %u %s Message(%u,%d,%d,%d)',
           [ClassName,WmWnd,AnsiQuotedStr(Caption,QuoteMark),
            Msg.Msg,Msg.WParam,Msg.LParam,Msg.Result]);
  DebugLog(_dlc_FormDefaultHandler,s);
 end;
end;

// @set Form.Left    400  relative "WindowTitle" ComponentName
// @set Form.Top     400  relative "WindowTitle" ComponentName
// @set Form.Width   400
// @set Form.Height  300
// @set Form.Width   80  relative Screen
// @set Form.Height  50  relative Desktop
function TMasterForm.DoApplyParams(const Params:LongString):Integer;
begin
 Result:=Form_ApplyParams_PosSize(Self,Params);
end;

function TMasterForm.ApplyParams(const Params:LongString):Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if UseEditSettings then
 if (Trim(Params)<>'') then
 try
  Result:=DoApplyParams(Params);
 except
  on E:Exception do BugReport(E,Self,'ApplyParams');
 end;
end;

function TMasterForm.GetPendingTrigger(aTrigger:Integer):Boolean;
begin
 if Assigned(Self)
 then Result:=aTrigger in myPendingTriggers
 else Result:=false;
end;

procedure TMasterForm.SetPendingTrigger(aTrigger:Integer; aState:Boolean);
begin
 if Assigned(Self) then begin
  if aState
  then Include(myPendingTriggers,aTrigger)
  else Exclude(myPendingTriggers,aTrigger);
 end;
end;

class function TMasterForm.RegisterPendingTrigger:Integer;
var n:Integer;
begin
 n:=LockedInc(myLastRegisteredPendingTrigger);
 Result:=IfThen(InRange(n,1,255),n,0);
end;

class function TMasterForm.LastBornTime;
begin
 Result:=myLastBornTime;
end;

class function TMasterForm.LastKillTime;
begin
 Result:=myLastKillTime;
end;

class function TMasterForm.IsMonitoringOnPause:Boolean;
var ms:Int64;
begin
 Result:=False;
 if (myLastBornTime>0) or (myLastKillTime>0) then begin
  ms:=GetTickCount64;
  if (myLastBornTime>0) and (ms<myLastBornTime+SleepAfterBornKill) then Exit(True);
  if (myLastKillTime>0) and (ms<myLastKillTime+SleepAfterBornKill) then Exit(True);
  AwakeMonitoring;
 end;
end;

class procedure TMasterForm.AwakeMonitoring;
begin
 myLastBornTime:=0;
 myLastKillTime:=0;
end;

procedure Kill(var TheObject:TMasterForm); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_appforms;
begin
 InitBornKillCounters;
 TMasterForm.SleepAfterBornKill:=20;
 _dlc_FormDefaultHandler:=RegisterDebugLogChannel('_FormDefaultHandler');
end;

procedure Free_crw_appforms;
begin
 ResourceLeakageLog(Format('%-60s = %d',['Balance of TMasterForm.Born/Kill', LockedGet(BornKillBalance)]));
 FreeBornKillCounters;
end;

initialization

 Init_crw_appforms;

finalization

 Free_crw_appforms;

end.

//////////////
// END OF FILE
//////////////

