220 lines
4.7 KiB
ObjectPascal
220 lines
4.7 KiB
ObjectPascal
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.
|