FastReport_FMX_2.8.12/Source/FMX.frxBaseModalForm.pas

unit FMX.frxBaseModalForm;

interface
{$I fmx.inc}
{$I frx.inc}

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs
{$IFDEF LINUX}
  ,FMUX.Api
{$ENDIF}
{$IFDEF DELPHI18}
{$IFDEF MACoS}
  , Macapi.Foundation, FMX.Platform.Mac, Macapi.AppKit, Macapi.CocoaTypes
{$ENDIF}
{$ENDIF};
{$IFDEF LINUX}
  const  RedHatScaleWidth: Double = 1.17;
  const  RedHatScaleHeight: Double = 1.22;

  function ScaleWidthOrHeightForm(ALength: Integer; Scale : Double): Integer;
  procedure BorderStyleSizeable(AForm: TForm);
  function GnomeAndRedHat(): Boolean;
  function InfoLinux() : TStringList;
{$ENDIF}
type
  TfrxForm = class(TForm)
  private
    FSession: Pointer;
    FFormClosed: Boolean;
{$IFNDEF DELPHI26}
{$IFDEF DELPHI18}
{$IFDEF MACoS}
    FNSWin: NSWindow;
    FNSApp: NSApplication;
{$ENDIF}
{$ENDIF}
{$ENDIF}
  protected
    procedure DestroyHandle; override;
{$IFNDEF DELPHI26}
{$IFDEF DELPHI18}
    procedure DoClose(var CloseAction: TCloseAction); override;
{$ENDIF}
{$ENDIF}
  public
    function CloseQuery: Boolean; override;
    function ShowModal: TModalResult; overload;
    procedure PeekLastModalResult;
    procedure BeginSesssion;
    procedure EndSession;
  end;

implementation

{$IFDEF LINUX}
function InfoLinux() : TStringList;
var
  FileInfoOSRelese : TFileStream;
  Bytes : TBytes;
begin
  Result := TStringList.Create;
  FileInfoOSRelese := TFileStream.Create('/usr/lib/os-release', fmOpenRead, fmShareDenyNone);
  try
    FileInfoOSRelese.Seek(Int64(0), soFromBeginning);
    SetLength(Bytes, FileInfoOSRelese.Size);
    FileInfoOSRelese.Read(Bytes[0], FileInfoOSRelese.Size);
    Result.CommaText := TEncoding.ASCII.GetString(Bytes);
  finally
    FileInfoOSRelese.Free;
  end;
end;

function ScaleWidthOrHeightForm(ALength: Integer; Scale : Double): Integer;
begin
  Result := Round(ALength * Scale)
end;

function GnomeAndRedHat: Boolean;
var InfoLinuxList : TStringList;
begin
  InfoLinuxList := InfoLinux;
  try
    Result := (SameText(GetEnvironmentVariable('XDG_SESSION_DESKTOP'), 'gnome'))
              and ((InfoLinuxList.Values['REDHAT_SUPPORT_PRODUCT'] <> '')
              or (SameText(InfoLinuxList.Values['ID'],'debian')));
  finally
    InfoLinuxList.Free;
  end;
end;

procedure BorderStyleSizeable(AForm: TForm);
begin
  if GnomeAndRedHat then
    AForm.BorderStyle := TFmxFormBorderStyle.Sizeable;
end;
{$ENDIF}

{ TfrxForm }

procedure TfrxForm.BeginSesssion;
// BUG with modal forms was fixed in 10.3.2 so holding of modal session is not needed
{$IFNDEF DELPHI26}
{$IFDEF DELPHI18}
{$IFDEF MACoS}
var
  AutoReleasePool: NSAutoreleasePool;
{$ENDIF}
{$ENDIF}
{$ENDIF}
begin
{$IFNDEF DELPHI26}
{$IFDEF DELPHI18}
{$IFDEF MACoS}
{$IFDEF DELPHI19}
  HandleNeed;
{$ENDIF}
  AutoReleasePool := TNSAutoreleasePool.Alloc;
  try
    AutoReleasePool.init;
    FNSApp := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication);
    FNSWin := WindowHandleToPlatform(Self.Handle).Wnd;
    if FNSWin <> nil then
    begin
      FNSWin.retain;
      FSession := FNSApp.beginModalSessionForWindow(FNSWin);
    end;
  finally
    AutoReleasePool.release;
  end;
{$ENDIF}
{$ENDIF}
{$ENDIF}
end;

function TfrxForm.CloseQuery: Boolean;
begin
{$IFNDEF DELPHI26}
{$IFDEF DELPHI18}
{$IFDEF MACoS}
  Result := True;
  if FFormClosed then Exit;
{$ENDIF}
{$ENDIF}
{$ENDIF}
  Result := inherited;
end;

procedure TfrxForm.DestroyHandle;
begin
  inherited;
  EndSession;
end;

procedure TfrxForm.EndSession;
begin
{$IFNDEF DELPHI26}
{$IFDEF DELPHI18}
{$IFDEF MACoS}
  if (FSession <> nil) and (FNSApp <> nil) then
  begin
    FNSApp.runModalSession(FSession);
    FNSApp.endModalSession(FSession);
    FNSWin.release;
    FNSApp := nil;
  end;
{$ENDIF}
{$ENDIF}
{$ENDIF}
  FSession := nil;
end;

{$IFNDEF DELPHI26}
{$IFDEF DELPHI18}
procedure TfrxForm.DoClose(var CloseAction: TCloseAction);
begin
{$IFDEF MACoS}
  if FFormClosed then Exit; // skip restart modal session from TPlatformCocoa.ShowWindowModal
{$ENDIF}
  inherited;
{$IFDEF MACoS}
  if ModalResult <> mrNone then
    FFormClosed := True;
  EndSession;
  Application.HandleMessage;
{$ENDIF}
end;
{$ENDIF}
{$ENDIF}

procedure TfrxForm.PeekLastModalResult;
begin
{$IFNDEF DELPHI26}
{$IFDEF DELPHI18}
{$IFDEF MACoS}
  if (FSession <> nil) and (FNSApp <> nil) then
    FNSApp.runModalSession(FSession);
{$ENDIF}
{$ENDIF}
{$ENDIF}
end;

function TfrxForm.ShowModal: TModalResult;

begin
  BeginSesssion;
{$IFDEF LINUX}
  if (BorderStyle = TFmxFormBorderStyle.Single) and GnomeAndRedHat then
  begin
    Width := ScaleWidthOrHeightForm(ClientWidth, RedHatScaleWidth);
    Height := ScaleWidthOrHeightForm(ClientHeight, RedHatScaleHeight);
  end;
{$ENDIF}
  FFormClosed := False;
  Result := inherited;
end;

end.