unit MI1201AGM_Emulator_XForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids,
  xRegistry, MI1201AGM_Emulator_Notificator;

const
  cEmulatorRootRegistryKey='\Software\MI1201AGM\Emulator';
  CM_EXECPROC = $8FFF;

type
  tExcludeMask=set of byte;

  TCMExecute=packed record
    Msg: Cardinal;
    Method:TThreadMethod;
  end;

  TCMExecute_EX=packed record
    Msg: Cardinal;
    ProcPtr:Pointer;
    DataPtr:Pointer;
  end;

  TThreadMethod_Ex = procedure(Ptr:pointer) of object; register;

  TMethodOfObject=packed record
    ProcPtr:pointer;
    Obj:TObject;
  end;

  TFormX = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    prRegistry:TRegistry;
    prMainFormTreadID:THandle;
    prZOrder:integer;
    prEmulatorTerminated:boolean;
    prExcludeMask:tExcludeMask;
    prLock:tHandle;
    prDefTimeOut:cardinal;
    prController:tObject;
  protected
    procedure CMExecute(var Message:TCMExecute); message CM_EXECPROC;
    procedure Synchronize(Method: TThreadMethod);
    function  MainThread:boolean;
    function Notify(Sender:TObject; var Event:tEvent):boolean; virtual;
    function SenderValid(Sender:TObject):boolean;
    function Unlock:boolean;
    procedure Lock;
    function TryLockDef:boolean;
    function TryLock(TimeOut:cardinal):boolean;
    function ControllerOK:boolean;
    property Controller:tObject read prController write prController;
  public
    { Public declarations }
    constructor Create(Owner:tComponent); override;
    destructor Destroy; override;
    function ZOrder:integer;
    procedure ResetZOrder(const Component:TComponent);
    function RegistryCreate:boolean;
    property Registry:TRegistry read prRegistry;
    function RootKey:string;
    function RegistryOpenForRead:boolean;
    function RegistryOpenForWrite:boolean;
    function RegistryOpenForReadSubKey(SubKey:string):boolean;
    function RegistryOpenForWriteSubKey(SubKey:string):boolean;
    procedure RegistryReadForm;
    procedure RegistryWriteForm;
    procedure RegistryWriteFormVisibility;
    procedure RegistryWriteGridColsWidth(aStringGrid:tStringGrid);
    procedure RegistryReadGridColsWidth(aStringGrid:tStringGrid);
    property ExcludeMask:tExcludeMask read prExcludeMask write prExcludeMask;
    function MessageBox(Msg:string; Title:string; options:cardinal):integer;
    function MessageBoxErr(Msg:string; Title:string):integer;
  end;

implementation

uses MI1201AGM_Emulator_FormMain;

{$R *.DFM}

function TFormX.SenderValid(Sender:TObject):boolean;
begin
  Result:=ControllerOK and (Sender=Controller);
end;

function TFormX.ControllerOK:boolean;
begin
  Result:=not prEmulatorTerminated and Assigned(Controller);
end;

procedure TFormX.RegistryWriteGridColsWidth(aStringGrid:tStringGrid);
  var i:integer; ws:array of integer;
begin
  if RegistryOpenForWriteSubKey(aStringGrid.Name) then begin
    try
      SetLength(ws,aStringGrid.ColCount);
      for i:=0 to Pred(aStringGrid.ColCount) do begin
        ws[i]:=aStringGrid.ColWidths[i];
      end;
      Registry.WriteInteger('ColCount',Length(ws));
      Registry.WriteBinaryData('ColWidths',ws[0],Length(ws)*SizeOf(ws[0]));
    except  end;
    SetLength(ws,0);
    Registry.CloseKey;
  end;
end;

procedure TFormX.RegistryReadGridColsWidth(aStringGrid:tStringGrid);
  var i,sz:integer; ws:array of integer;
begin
  if RegistryOpenForReadSubKey(aStringGrid.Name) then begin
    try
      i:=Registry.ReadInteger('ColCount');
      SetLength(ws,i);
      sz:=i*SizeOf(ws[0]);
      if i>aStringGrid.ColCount then i:=aStringGrid.ColCount;
      if sz=Registry.ReadBinaryData('ColWidths',ws[0],sz) then begin
        sz:=aStringGrid.Width div 2;
        for i:=0 to Pred(i) do if not (i in ExcludeMask) then begin
          if (ws[i]>10) and (ws[i]<sz) then
            aStringGrid.ColWidths[i]:=ws[i];
        end;
      end;
    except  end;
    SetLength(ws,0);
    Registry.CloseKey;
  end;
end;

function TFormX.Notify(Sender:TObject; var Event:tEvent):boolean;
begin
  if prEmulatorTerminated then begin
    Result:=TRUE;
  end else begin
    case Event.Base.ID of
      evDestroing:begin
        prEmulatorTerminated:=TRUE;
        prController:=NIL;
        Result:=TRUE;
      end;
      else Result:=FALSE;
    end;
  end;
end;

function TFormX.ZOrder:integer;
  var h:tHandle;
begin
  Result:=0;
  h:=GetTopWindow(0);
  while (h<>0) and (h<>Handle) do begin
    h:=GetNextWindow(h,GW_HWNDNEXT);
    Inc(Result);
  end;
  if h<>Handle then begin
    Result:=-1;
  end else begin
    prZOrder:=Result;
  end;
end;

function ZOrderCompare(Item1, Item2: Pointer):Integer;
begin
  Result:=TFormX(Item1).prZOrder-TFormX(Item2).prZOrder;
end;

procedure TFormX.ResetZOrder(const Component:TComponent);
  var tl:TList; i:integer; h,hw:tHandle;
begin
  tl:=TList.Create;
  try
    for i:=0 to Pred(Component.ComponentCount) do
      if Component.Components[i].InheritsFrom(TFormX) then
        tl.Add(Component.Components[i]);
    if tl.Count>1 then begin
      tl.Sort(ZOrderCompare);
      h:=BeginDeferWindowPos(Pred(tl.Count));
      hw:=TFormX(tl[0]).Handle;
      for i:=1 to Pred(tl.Count) do begin
        h:=DeferWindowPos(h,	// handle to internal structure
          TFormX(tl[i]).Handle,	// handle to window to position
          hw,	// placement-order handle
          0,0,0,0,
          SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOREDRAW or SWP_NOSIZE // window-positioning flags
        );
        hw:=TFormX(tl[i]).Handle;
      end;
      EndDeferWindowPos(h);
    end;
  except end;
  tl.Free;
end;

constructor TFormX.Create(Owner:tComponent);
begin
  prMainFormTreadID:=GetCurrentThreadID;
  prDefTimeOut:=1000;
  prLock:=CreateMutex(nil,TRUE,nil);
  Inherited;
end;

destructor TFormX.Destroy;
  var h:tHandle;
begin
  Inherited;
  h:=prLock; prLock:=0;
  CloseHandle(h);
  FreeAndNil(prRegistry);
end;

function TFormX.RootKey:string;
begin
  result:=cEmulatorRootRegistryKey+'\'+Name;
end;

function TFormX.RegistryCreate:boolean;
begin
  if not Assigned(prRegistry) then try
    prRegistry:=TRegistry.Create;
  except end;
  result:=Assigned(prRegistry);
end;

function TFormX.RegistryOpenForRead:boolean;
begin
  result:=RegistryCreate;
  if result then begin
    prRegistry.RootKey:=HKEY_CURRENT_USER;
    result:=Registry.OpenKeyReadOnly(RootKey);
    if not Result then begin
      prRegistry.RootKey:=HKEY_LOCAL_MACHINE;
       Result:=Registry.OpenKeyReadOnly(RootKey);
    end;
  end;
end;

function TFormX.RegistryOpenForWrite:boolean;
begin
  result:=RegistryCreate;
  if result then begin
    prRegistry.RootKey:=HKEY_CURRENT_USER;
    Registry.Access:=KEY_WRITE;
    Result:=Registry.OpenKey(RootKey,TRUE);
  end;
end;

function  TFormX.RegistryOpenForReadSubKey(SubKey:string):boolean;
begin
  result:=RegistryOpenForRead;
  if Result then begin
    Result:=Registry.OpenKeyReadOnly(SubKey);
  end;
end;

function  TFormX.RegistryOpenForWriteSubKey(SubKey:string):boolean;
begin
  result:=RegistryOpenForWrite;
  if Result then begin
    Result:=Registry.OpenKey(SubKey,TRUE);
  end;
end;

procedure TFormX.RegistryWriteFormVisibility;
begin
  if Assigned(Self) and RegistryOpenForWrite then begin
    try
      Registry.WriteBool('Visible',Visible);
    except  end;
    Registry.CloseKey;
  end;
end;

procedure TFormX.RegistryWriteForm;
begin
  if Assigned(Self) and RegistryOpenForWrite then begin
    try
      prRegistry.WriteInteger('Left',Left);
      Registry.WriteInteger('Top',Top);
      Registry.WriteInteger('ZOrder',ZOrder);
      Registry.WriteBool('Active',Active);
      Registry.WriteBool('ShowHint',ShowHint);
      if Assigned(ActiveControl) then
        Registry.WriteInteger('ActiveControlIndex',ActiveControl.ComponentIndex);
    except end;
    Registry.CloseKey;
  end;
end;

procedure TFormX.RegistryReadForm;
  var i:integer;
begin
  if RegistryOpenForRead then
  try
    try
      Left:=prRegistry.ReadIntegerDef('Left',Left);
      if (Left<0) then Left:=0;
      if ((Left+Width)>Screen.Width) then Left:=Screen.Width-Width;
    except end;
    try
      Top:=prRegistry.ReadIntegerDef('Top',Top);
      if (Top<0) then Top:=0;
      if ((Top+Height)>Screen.Height) then Top:=Screen.Height-Height;
    except end;
    try
      Visible:=Registry.ReadBoolDef('Visible',Visible);
    except end;
    try
      if Registry.ReadBoolDef('Active',Active) then
        Activate;
    except end;
    try
      ShowHint:=Registry.ReadBoolDef('ShowHint',ShowHint);
      Application.ShowHint:=ShowHint;
    except end;
    try
      i:=prRegistry.ReadIntegerDef('ActiveControlIndex',0);
      if (Components[i]<>ActiveControl)
        and Components[i].InheritsFrom(TWinControl)
        and TWinControl(Components[i]).CanFocus then begin
        ActiveControl:=TWinControl(Components[i]);
      end;
    except end;
  finally
    prRegistry.CloseKey;
  end;
end;

function TFormX.MessageBox(Msg:string; Title:string; options:cardinal):integer;
begin
  if Title='' then Title:=Caption;
  if options=0 then options:=MB_OK;
  Result:=Windows.MessageBox(Handle,PChar(Msg),PChar(Title),options);
end;

function TFormX.MessageBoxErr(Msg:string; Title:string):integer;
begin
  Result:=MessageBox(Msg, Title, MB_OK or MB_ICONERROR);
end;

function TFormX.Unlock:boolean;
begin
  Result:=ReleaseMutex(prLock);
end;

procedure TFormX.Lock;
begin
  TryLock(INFINITE);
end;

function TFormX.TryLockDef:boolean;
begin
  Result:=TryLock(prDefTimeOut);
end;

function TFormX.TryLock(TimeOut:cardinal):boolean;
begin
  Result:=WaitForSingleObject(prLock,prDefTimeOut)=WAIT_OBJECT_0;
end;

function TFormX.MainThread:boolean;
begin
  Result:=(prMainFormTreadID=GetCurrentThreadID);
end;

procedure TFormX.Synchronize(Method: TThreadMethod);
begin
  if MainThread then begin
    Method;
  end else begin
    PostMessage(Handle, CM_EXECPROC,
                Longint(TMethodOfObject(Method).ProcPtr),
                Longint(TMethodOfObject(Method).Obj));
  end;
end;


procedure TFormX.CMExecute(var Message:TCMExecute);
begin
  try
    Message.Method;
  except end;
end;


procedure TFormX.FormCreate(Sender: TObject);
begin
  FMain.AssignProperties(Self);
  RegistryReadForm;
end;

end.