rtl: do not use TDataModule and TFormatSettings in initialization

This commit is contained in:
mattias 2022-04-09 13:24:21 +02:00
parent 99e52af8b5
commit 4eb3cac52b
2 changed files with 154 additions and 137 deletions

View File

@ -1426,6 +1426,9 @@ type
{ ---------------------------------------------------------------------
TDatamodule support
---------------------------------------------------------------------}
{ TDataModule }
TDataModule = class(TComponent)
private
FDPos: TPoint;
@ -1455,6 +1458,7 @@ type
constructor Create(AOwner: TComponent); override;
Constructor CreateNew(AOwner: TComponent);
Constructor CreateNew(AOwner: TComponent; CreateMode: Integer); virtual;
class constructor ClassCreate;
destructor Destroy; override;
Procedure AfterConstruction; override;
Procedure BeforeDestruction; override;
@ -1607,17 +1611,53 @@ begin
Result:=String(TJSFunction(@TJSString.fromCharCode).apply(nil,TJSValueDynArray(JSValue(a))));
end;
function CreateComponentfromRes(const res : string; Inst : THandle; var Component : TComponent) : Boolean;
type
TIntConst = class
Private
IntegerType: PTypeInfo; // The integer type RTTI pointer
IdentToIntFn: TIdentToInt; // Identifier to Integer conversion
IntToIdentFn: TIntToIdent; // Integer to Identifier conversion
Public
constructor Create(AIntegerType: PTypeInfo; AIdentToInt: TIdentToInt;
AIntToIdent: TIntToIdent);
end;
var
ResStream : TResourceStream;
Src : TStream;
aInfo : TResourceInfo;
begin
if Inst=0 then ;
result:=GetResourceInfo(Res,aInfo);
if Result then
begin
ResStream:=TResourceStream.Create(aInfo);
try
if Not FormResourceIsText then
Src:=ResStream
else
begin
Src:=TMemoryStream.Create;
ObjectTextToBinary(ResStream,Src);
Src.Position:=0;
end;
Component:=Src.ReadComponent(Component);
finally
if Src<>ResStream then
Src.Free;
ResStream.Free;
end;
end;
end;
function DefaultInitHandler(Instance: TComponent; RootAncestor: TClass): Boolean;
function doinit(_class : TClass) : boolean;
begin
result:=false;
if (_class.ClassType=TComponent) or (_class.ClassType=RootAncestor) then
exit;
result:=doinit(_class.ClassParent);
// Resources are written with their unit name
result:=CreateComponentfromRes(_class.UnitName,0,Instance) or result;
end;
begin
result:=doinit(Instance.ClassType);
end;
{ TResourceStream }
@ -1745,6 +1785,17 @@ begin
WriteBuffer(B,Length(B));
end;
type
TIntConst = class
Private
IntegerType: PTypeInfo; // The integer type RTTI pointer
IdentToIntFn: TIdentToInt; // Identifier to Integer conversion
IntToIdentFn: TIntToIdent; // Integer to Identifier conversion
Public
constructor Create(AIntegerType: PTypeInfo; AIdentToInt: TIdentToInt;
AIntToIdent: TIntToIdent);
end;
constructor TIntConst.Create(AIntegerType: PTypeInfo; AIdentToInt: TIdentToInt;
AIntToIdent: TIntToIdent);
begin
@ -11097,7 +11148,7 @@ end;
TDatamodule
----------------------------------------------------------------------}
Constructor TDataModule.Create(AOwner: TComponent);
constructor TDataModule.Create(AOwner: TComponent);
begin
CreateNew(AOwner);
if (ClassType <> TDataModule) and
@ -11110,7 +11161,7 @@ begin
end;
end;
Constructor TDataModule.CreateNew(AOwner: TComponent);
constructor TDataModule.CreateNew(AOwner: TComponent);
begin
CreateNew(AOwner,0);
@ -11124,13 +11175,18 @@ begin
AddDataModule(Self);
end;
Procedure TDataModule.AfterConstruction;
class constructor TDataModule.ClassCreate;
begin
RegisterInitComponentHandler(TDataModule,@DefaultInitHandler);
end;
procedure TDataModule.AfterConstruction;
begin
If not OldCreateOrder then
DoCreate;
end;
Procedure TDataModule.BeforeDestruction;
procedure TDataModule.BeforeDestruction;
begin
Destroying;
RemoveFixupReferences(Self, '');
@ -11147,7 +11203,7 @@ begin
inherited Destroy;
end;
Procedure TDataModule.DoCreate;
procedure TDataModule.DoCreate;
begin
if Assigned(FOnCreate) then
try
@ -11158,7 +11214,7 @@ begin
end;
end;
Procedure TDataModule.DoDestroy;
procedure TDataModule.DoDestroy;
begin
if Assigned(FOnDestroy) then
try
@ -11214,112 +11270,63 @@ begin
ApplicationHandleException(Self);
end;
Procedure TDataModule.ReadP(Reader: TReader);
procedure TDataModule.ReadP(Reader: TReader);
begin
FDPPI := Reader.ReadInteger;
end;
Procedure TDataModule.ReadState(Reader: TReader);
procedure TDataModule.ReadState(Reader: TReader);
begin
FOldOrder := false;
inherited ReadState(Reader);
end;
Procedure TDataModule.ReadT(Reader: TReader);
procedure TDataModule.ReadT(Reader: TReader);
begin
FDPos.Y := Reader.ReadInteger;
end;
Procedure TDataModule.WriteT(Writer: TWriter);
procedure TDataModule.WriteT(Writer: TWriter);
begin
Writer.WriteInteger(FDPos.Y);
end;
Procedure TDataModule.ReadL(Reader: TReader);
procedure TDataModule.ReadL(Reader: TReader);
begin
FDPos.X := Reader.ReadInteger;
end;
Procedure TDataModule.WriteL(Writer: TWriter);
procedure TDataModule.WriteL(Writer: TWriter);
begin
Writer.WriteInteger(FDPos.X);
end;
Procedure TDataModule.ReadW(Reader: TReader);
procedure TDataModule.ReadW(Reader: TReader);
begin
FDSIze.X := Reader.ReadInteger;
end;
Procedure TDataModule.WriteP(Writer: TWriter);
procedure TDataModule.WriteP(Writer: TWriter);
begin
Writer.WriteInteger(FDPPI);
end;
Procedure TDataModule.WriteW(Writer: TWriter);
procedure TDataModule.WriteW(Writer: TWriter);
begin
Writer.WriteInteger(FDSIze.X);
end;
Procedure TDataModule.ReadH(Reader: TReader);
procedure TDataModule.ReadH(Reader: TReader);
begin
FDSIze.Y := Reader.ReadInteger;
end;
Procedure TDataModule.WriteH(Writer: TWriter);
procedure TDataModule.WriteH(Writer: TWriter);
begin
Writer.WriteInteger(FDSIze.Y);
end;
function CreateComponentfromRes(const res : string; Inst : THandle; var Component : TComponent) : Boolean;
var
ResStream : TResourceStream;
Src : TStream;
aInfo : TResourceInfo;
begin
if Inst=0 then ;
result:=GetResourceInfo(Res,aInfo);
if Result then
begin
ResStream:=TResourceStream.Create(aInfo);
try
if Not FormResourceIsText then
Src:=ResStream
else
begin
Src:=TMemoryStream.Create;
ObjectTextToBinary(ResStream,Src);
Src.Position:=0;
end;
Component:=Src.ReadComponent(Component);
finally
if Src<>ResStream then
Src.Free;
ResStream.Free;
end;
end;
end;
function DefaultInitHandler(Instance: TComponent; RootAncestor: TClass): Boolean;
function doinit(_class : TClass) : boolean;
begin
result:=false;
if (_class.ClassType=TComponent) or (_class.ClassType=RootAncestor) then
exit;
result:=doinit(_class.ClassParent);
// Resources are written with their unit name
result:=CreateComponentfromRes(_class.UnitName,0,Instance) or result;
end;
begin
result:=doinit(Instance.ClassType);
end;
initialization
RegisterInitComponentHandler(TDataModule,@DefaultInitHandler);
ClassList:=TJSObject.New;
end.

View File

@ -58,43 +58,45 @@ type
type
{ TFormatSettings }
TFormatSettings = record
strict private
class function GetJSLocale: string; assembler; static;
class function GetLocaleShortDayName(const ADayOfWeek: Integer; const ALocale: string): string; static;
class function GetLocaleDecimalSeparator(const ALocale: string): string; static;
class function GetLocaleLongMonthName(const AMonth: Integer; const ALocale: string): string; static;
class function GetLocaleLongDayName(const ADayOfWeek: Integer; const ALocale: string): string; static;
class function GetLocaleShortMonthName(const AMonth: Integer; const ALocale: string): string; static;
public
CurrencyDecimals: Byte;
CurrencyFormat: Byte;
CurrencyString: string;
DateSeparator: Char;
DateTimeToStrFormat: array[Boolean] of string;
DecimalSeparator: string;
LongDateFormat: string;
LongDayNames: TDayNames;
LongMonthNames: TMonthNames;
LongTimeFormat: string;
NegCurrFormat: Byte;
ShortDateFormat: string;
ShortDayNames: TDayNames;
ShortMonthNames: TMonthNames;
ShortTimeFormat: string;
ThousandSeparator: string;
TimeAMString: string;
TimePMString: string;
TimeSeparator: Char;
TwoDigitYearCenturyWindow: Word;
public
Type
TLocaleInitCallback = Procedure(const aLocale : String; aInstance : TFormatSettings);
class var InitLocaleHandler : TLocaleInitCallback;
class function Create: TFormatSettings; overload; static;
class function Create(const ALocale: string): TFormatSettings; overload; static;
class function Invariant: TFormatSettings; static;
end;
strict private
class function GetJSLocale: string; assembler; static;
class function GetLocaleShortDayName(const ADayOfWeek: Integer; const ALocale: string): string; static;
class function GetLocaleDecimalSeparator(const ALocale: string): string; assembler; static;
class function GetLocaleLongMonthName(const AMonth: Integer; const ALocale: string): string; assembler; static;
class function GetLocaleLongDayName(const ADayOfWeek: Integer; const ALocale: string): string; assembler; static;
class function GetLocaleShortMonthName(const AMonth: Integer; const ALocale: string): string; static;
public
CurrencyDecimals: Byte;
CurrencyFormat: Byte;
CurrencyString: string;
DateSeparator: Char;
DateTimeToStrFormat: array[Boolean] of string;
DecimalSeparator: string;
LongDateFormat: string;
LongDayNames: TDayNames;
LongMonthNames: TMonthNames;
LongTimeFormat: string;
NegCurrFormat: Byte;
ShortDateFormat: string;
ShortDayNames: TDayNames;
ShortMonthNames: TMonthNames;
ShortTimeFormat: string;
ThousandSeparator: string;
TimeAMString: string;
TimePMString: string;
TimeSeparator: Char;
TwoDigitYearCenturyWindow: Word;
public
Type
TLocaleInitCallback = Procedure(const aLocale : String; aInstance : TFormatSettings);
class var InitLocaleHandler : TLocaleInitCallback;
class function Create: TFormatSettings; overload; static;
class function Create(const ALocale: string): TFormatSettings; overload; static;
class function Invariant: TFormatSettings; static;
class constructor Init;
end;
{*****************************************************************************
@ -4961,6 +4963,27 @@ begin
Result:='0'+Result;
end;
procedure InitGlobalFormatSettings;
begin
// So the defaults are taken from FormatSettings.
{$WARN 5043 off}
FormatSettings:=TFormatSettings.Create;
TimeSeparator:=FormatSettings.TimeSeparator;
DateSeparator:=FormatSettings.DateSeparator;
ShortDateFormat:=FormatSettings.ShortDateFormat;
LongDateFormat:=FormatSettings.LongDateFormat;
ShortTimeFormat:=FormatSettings.ShortTimeFormat;
LongTimeFormat:=FormatSettings.LongTimeFormat;
DecimalSeparator:=FormatSettings.DecimalSeparator;
ThousandSeparator:=FormatSettings.ThousandSeparator;
TimeAMString:=FormatSettings.TimeAMString;
TimePMString:=FormatSettings.TimePMString;
CurrencyFormat:=FormatSettings.CurrencyFormat;
NegCurrFormat:=FormatSettings.NegCurrFormat;
CurrencyDecimals:=FormatSettings.CurrencyDecimals;
CurrencyString:=FormatSettings.CurrencyString;
end;
{ TFormatSettings }
class function TFormatSettings.Create: TFormatSettings;
@ -4968,7 +4991,7 @@ begin
Result := Create(GetJSLocale);
end;
class function TFormatSettings.Create(const ALocale: String): TFormatSettings;
class function TFormatSettings.Create(const ALocale: string): TFormatSettings;
begin
Result.LongDayNames:=DefaultLongDayNames;
Result.ShortDayNames:=DefaultShortDayNames;
@ -5020,26 +5043,34 @@ begin
Result.NegCurrFormat := 0;
end;
class constructor TFormatSettings.Init;
begin
InitGlobalFormatSettings;
end;
class function TFormatSettings.GetJSLocale: string; assembler;
asm
return Intl.DateTimeFormat().resolvedOptions().locale
end;
class function TFormatSettings.GetLocaleDecimalSeparator(const ALocale: string): string; assembler;
class function TFormatSettings.GetLocaleDecimalSeparator(const ALocale: string
): string; assembler;
asm
var lNumber = 1.1;
lNumber = lNumber.toLocaleString(ALocale).substring(1, 2);
return lNumber;
end;
class function TFormatSettings.GetLocaleLongDayName(const ADayOfWeek: Integer; const ALocale: string): string; assembler;
class function TFormatSettings.GetLocaleLongDayName(const ADayOfWeek: Integer;
const ALocale: string): string; assembler;
asm
var lBaseDate = new Date(2017, 0, 1); // Sunday
lBaseDate.setDate(lBaseDate.getDate() + ADayOfWeek - 1);
return lBaseDate.toLocaleDateString(ALocale, { weekday: 'long' });
end;
class function TFormatSettings.GetLocaleLongMonthName(const AMonth: Integer; const ALocale: string): string; assembler;
class function TFormatSettings.GetLocaleLongMonthName(const AMonth: Integer;
const ALocale: string): string; assembler;
asm
var lBaseDate = new Date(2017, AMonth - 1, 1);
return lBaseDate.toLocaleDateString(ALocale, { month: 'long' });
@ -8692,7 +8723,6 @@ begin
Result:=Self;
end;
Function TStringBuilder.Replace(const OldValue, NewValue: String): TStringBuilder;
begin
Result:=Replace(OldValue,NewValue,0,Length);
@ -8707,7 +8737,6 @@ begin
// No-op
end;
function TStringBuilder.ToString: String;
begin
Result:=ToString(0,Length);
@ -8734,30 +8763,11 @@ begin
System.Insert(New,FData,Index+1);
end;
initialization
{$WARN 5043 off}
ShortMonthNames:=DefaultShortMonthNames;
LongMonthNames:=DefaultLongMonthNames;
ShortDayNames:=DefaultShortDayNames;
LongDayNames:=DefaultLongDayNames;
FormatSettings:=TFormatSettings.Create;
// So the defaults are taken from FormatSettings.
TimeSeparator:=FormatSettings.TimeSeparator;
DateSeparator:=FormatSettings.DateSeparator;
ShortDateFormat:=FormatSettings.ShortDateFormat;
LongDateFormat:=FormatSettings.LongDateFormat;
ShortTimeFormat:=FormatSettings.ShortTimeFormat;
LongTimeFormat:=FormatSettings.LongTimeFormat;
DecimalSeparator:=FormatSettings.DecimalSeparator;
ThousandSeparator:=FormatSettings.ThousandSeparator;
TimeAMString:=FormatSettings.TimeAMString;
TimePMString:=FormatSettings.TimePMString;
CurrencyFormat:=FormatSettings.CurrencyFormat;
NegCurrFormat:=FormatSettings.NegCurrFormat;
CurrencyDecimals:=FormatSettings.CurrencyDecimals;
CurrencyString:=FormatSettings.CurrencyString;
end.