diff --git a/Samples/Scripts/DataTypes.dpr b/Samples/Scripts/DataTypes.dpr new file mode 100644 index 00000000..77b538c6 --- /dev/null +++ b/Samples/Scripts/DataTypes.dpr @@ -0,0 +1,362 @@ +program DataTypes; + +(* +const + Eleven = 11; + Twelfe = 12; + Thirteen = 13; + Fourteen = 14; + Fiveteen = 15; + Sixteen = 16; + Seventeen = 17; + Eightteen = 18; + Nineteen = 19; + Twenty = 20; +*) + +type + TEnum = (One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten); +// TEnum2 = (Eleven, Twelfe, Thirteen, Fourteen, Fiveteen, Sixteen, Seventeen, Eightteen, Nineteen, Twenty); + + TRecord = record + B : Boolean; + U8 : Byte; + S8 : ShortInt; + U16 : Word; + S16 : SmallInt; + U32 : Cardinal; + S32 : Integer; +// U64 : UInt64; + S64 : Int64; + S : Single; + D : Double; + E : Extended; + ASt : AnsiString; + WS : WideString; + AC : AnsiChar; + WC : WideChar; + Enum : TEnum; +// Enum2 : TEnum2; + end; + +const + ArraySize = 10; + +type + TRecordStaticArray = record + saB : Array [ 0..ArraySize-1 ] of Boolean; + saU8 : Array [ 0..ArraySize-1 ] of Byte; + saS8 : Array [ 0..ArraySize-1 ] of ShortInt; + saU16 : Array [ 0..ArraySize-1 ] of Word; + saS16 : Array [ 0..ArraySize-1 ] of SmallInt; + saU32 : Array [ 0..ArraySize-1 ] of Cardinal; + saS32 : Array [ 0..ArraySize-1 ] of Integer; +// saU64 : Array [ 0..ArraySize-1 ] of UInt64; + saS64 : Array [ 0..ArraySize-1 ] of Int64; + saS : Array [ 0..ArraySize-1 ] of Single; + saD : Array [ 0..ArraySize-1 ] of Double; + saE : Array [ 0..ArraySize-1 ] of Extended; + saAS : Array [ 0..ArraySize-1 ] of AnsiString; + saWS : Array [ 0..ArraySize-1 ] of WideString; + saAC : Array [ 0..ArraySize-1 ] of AnsiChar; + saWC : Array [ 0..ArraySize-1 ] of WideChar; + saEnum : Array [ 0..ArraySize-1 ] of TEnum; +// saEnum2 : Array [ 0..ArraySize-1 ] of TEnum2; + end; + + TRecordArray = record + aB : Array of Boolean; + aU8 : Array of Byte; + aS8 : Array of ShortInt; + aU16 : Array of Word; + aS16 : Array of SmallInt; + aU32 : Array of Cardinal; + aS32 : Array of Integer; +// aU64 : Array of UInt64; + aS64 : Array of Int64; + aSi : Array of Single; + aD : Array of Double; + aE : Array of Extended; + aAS : Array of AnsiString; + aWS : Array of WideString; + aAC : Array of AnsiChar; + aWC : Array of WideChar; + aEnum : Array of TEnum; +// aEnum2 : Array of TEnum2; + end; + +var + B : Boolean; + U8 : Byte; + S8 : ShortInt; + U16 : Word; + S16 : SmallInt; + U32 : Cardinal; + S32 : Integer; +// U64 : UInt64; + S64 : Int64; + S : Single; + D : Double; + E : Extended; + ASt : AnsiString; + WS : WideString; + AC : AnsiChar; + WC : WideChar; + Enum : TEnum; +// Enum2 : TEnum2; + StrL : TStringList; + + saB : Array [ 0..ArraySize-1 ] of Boolean; + saU8 : Array [ 0..ArraySize-1 ] of Byte; + saS8 : Array [ 0..ArraySize-1 ] of ShortInt; + saU16 : Array [ 0..ArraySize-1 ] of Word; + saS16 : Array [ 0..ArraySize-1 ] of SmallInt; + saU32 : Array [ 0..ArraySize-1 ] of Cardinal; + saS32 : Array [ 0..ArraySize-1 ] of Integer; +// saU64 : Array [ 0..ArraySize-1 ] of UInt64; + saS64 : Array [ 0..ArraySize-1 ] of Int64; + saS : Array [ 0..ArraySize-1 ] of Single; + saD : Array [ 0..ArraySize-1 ] of Double; + saE : Array [ 0..ArraySize-1 ] of Extended; + saAS : Array [ 0..ArraySize-1 ] of AnsiString; + saWS : Array [ 0..ArraySize-1 ] of WideString; + saAC : Array [ 0..ArraySize-1 ] of AnsiChar; + saWC : Array [ 0..ArraySize-1 ] of WideChar; + saEnum : Array [ 0..ArraySize-1 ] of TEnum; +// saEnum2 : Array [ 0..ArraySize-1 ] of TEnum2; + + aB : Array of Boolean; + aU8 : Array of Byte; + aS8 : Array of ShortInt; + aU16 : Array of Word; + aS16 : Array of SmallInt; + aU32 : Array of Cardinal; + aS32 : Array of Integer; +// aU64 : Array of UInt64; + aS64 : Array of Int64; + aSi : Array of Single; + aD : Array of Double; + aE : Array of Extended; + aAS : Array of AnsiString; + aWS : Array of WideString; + aAC : Array of AnsiChar; + aWC : Array of WideChar; + aEnum : Array of TEnum; +// aEnum2 : Array of TEnum2; + + TestRecord : TRecord; + TestRecordStaticArray : TRecordStaticArray; + TestRecordArray : TRecordArray; + + i : Integer; +begin + B := True; + U8 := 127; + S8 := -127; + U16 := 12345; + S16 := -12345; + U32 := 123456789; + S32 := -123456789; +// U64 := 123456789; + S64 := -1234567890123; + S := 1234567.123; + D := 123456789.123456789; + E := 123456789.123456789; + ASt := 'This is a Test String (ANSI)'; + WS := 'This is a Test String (WIDE)'; + AC := 'A'; + WC := 'W'; + Enum := Seven; +// Enum2 := Seventeen; + + StrL := TStringList.Create; + StrL.Add( 'Line One' ); + StrL.Add( 'Line Two' ); + + TestRecord.B := True; + TestRecord.U8 := 127; + TestRecord.S8 := -127; + TestRecord.U16 := 12345; + TestRecord.S16 := -12345; + TestRecord.U32 := 123456789; + TestRecord.S32 := -123456789; +// TestRecord.U64 := 123456789; + TestRecord.S64 := -1234567890123; + TestRecord.S := 1234567.123; + TestRecord.D := 123456789.123456789; + TestRecord.E := 123456789.123456789; + TestRecord.ASt := 'This is a Test String (ANSI)'; + TestRecord.WS := 'This is a Test String (WIDE)'; + TestRecord.AC := 'A'; + TestRecord.WC := 'W'; + TestRecord.Enum := Seven; +// TestRecord.Enum2 := Seven; + + // Static Array + for i := Low( saB ) to High( saB ) do + begin + saB[i] := ( i mod 2 = 0 ); + saU8[i] := i; + saS8[i] := -i; + saU16[i] := i; + saS16[i] := -i; + saU32[i] := i; + saS32[i] := -i; +// saU64[i] := i; + saS64[i] := -i; + saS[i] := i + i*0.3; + saD[i] := i + i*0.3; + saE[i] := i + i*0.3; + saAS[i] := 'This is a Test String (ANSI)'; + saWS[i] := 'This is a Test String (WIDE)'; + saAC[i] := 'A'; + saWC[i] := 'W'; + saEnum[i] := Seven; +// saEnum2[i] := Seventeen; + end; + + // Static Array (Record) + for i := Low( TestRecordStaticArray.saB ) to High( TestRecordStaticArray.saB ) do + begin + TestRecordStaticArray.saB[i] := ( i mod 2 = 0 ); + TestRecordStaticArray.saU8[i] := i; + TestRecordStaticArray.saS8[i] := -i; + TestRecordStaticArray.saU16[i] := i; + TestRecordStaticArray.saS16[i] := -i; + TestRecordStaticArray.saU32[i] := i; + TestRecordStaticArray.saS32[i] := -i; +// TestRecordStaticArray.saU64[i] := i; + TestRecordStaticArray.saS64[i] := -i; + TestRecordStaticArray.saS[i] := i + i*0.3; + TestRecordStaticArray.saD[i] := i + i*0.3; + TestRecordStaticArray.saE[i] := i + i*0.3; + TestRecordStaticArray.saAS[i] := 'This is a Test String (ANSI)'; + TestRecordStaticArray.saWS[i] := 'This is a Test String (WIDE)'; + TestRecordStaticArray.saAC[i] := 'A'; + TestRecordStaticArray.saWC[i] := 'W'; + TestRecordStaticArray.saEnum[i] := Seven; +// TestRecordStaticArray.saEnum2[i] := Seventeen; + end; + + // Dynamic Array + SetLength( aB, ArraySize ); + SetLength( aU8, ArraySize ); + SetLength( aS8, ArraySize ); + SetLength( aU16, ArraySize ); + SetLength( aS16, ArraySize ); + SetLength( aU32, ArraySize ); + SetLength( aS32, ArraySize ); +// SetLength( aU64, ArraySize ); + SetLength( aS64, ArraySize ); + SetLength( aSi, ArraySize ); + SetLength( aD, ArraySize ); + SetLength( aE, ArraySize ); + SetLength( aAS, ArraySize ); + SetLength( aWS, ArraySize ); + SetLength( aAC, ArraySize ); + SetLength( aWC, ArraySize ); + SetLength( aEnum, ArraySize ); +// SetLength( aEnum2, ArraySize ); + + for i := Low( aB ) to High( aB ) do + begin + aB[i] := ( i mod 2 = 0 ); + aU8[i] := i; + aS8[i] := -i; + aU16[i] := i; + aS16[i] := -i; + aU32[i] := i; + aS32[i] := -i; +// aU64[i] := i; + aS64[i] := -i; + aSi[i] := i + i*0.3; + aD[i] := i + i*0.3; + aE[i] := i + i*0.3; + aAS[i] := 'This is a Test String (ANSI)'; + aWS[i] := 'This is a Test String (WIDE)'; + aAC[i] := 'A'; + aWC[i] := 'W'; + aEnum[i] := Seven; +// aEnum2[i] := Seventeen; + end; + + // Dynamic Array (Record) + SetLength( TestRecordArray.aB, ArraySize ); + SetLength( TestRecordArray.aU8, ArraySize ); + SetLength( TestRecordArray.aS8, ArraySize ); + SetLength( TestRecordArray.aU16, ArraySize ); + SetLength( TestRecordArray.aS16, ArraySize ); + SetLength( TestRecordArray.aU32, ArraySize ); + SetLength( TestRecordArray.aS32, ArraySize ); +// SetLength( TestRecordArray.aU64, ArraySize ); + SetLength( TestRecordArray.aS64, ArraySize ); + SetLength( TestRecordArray.aSi, ArraySize ); + SetLength( TestRecordArray.aD, ArraySize ); + SetLength( TestRecordArray.aE, ArraySize ); + SetLength( TestRecordArray.aAS, ArraySize ); + SetLength( TestRecordArray.aWS, ArraySize ); + SetLength( TestRecordArray.aAC, ArraySize ); + SetLength( TestRecordArray.aWC, ArraySize ); + SetLength( TestRecordArray.aEnum, ArraySize ); +// SetLength( TestRecordArray.aEnum2, ArraySize ); + + for i := Low( TestRecordArray.aB ) to High( TestRecordArray.aB ) do + begin + TestRecordArray.aB[i] := ( i mod 2 = 0 ); + TestRecordArray.aU8[i] := i; + TestRecordArray.aS8[i] := -i; + TestRecordArray.aU16[i] := i; + TestRecordArray.aS16[i] := -i; + TestRecordArray.aU32[i] := i; + TestRecordArray.aS32[i] := -i; +// TestRecordArray.aU64[i] := i; + TestRecordArray.aS64[i] := -i; + TestRecordArray.aSi[i] := i + i*0.3; + TestRecordArray.aD[i] := i + i*0.3; + TestRecordArray.aE[i] := i + i*0.3; + TestRecordArray.aAS[i] := 'This is a Test String (ANSI)'; + TestRecordArray.aWS[i] := 'This is a Test String (WIDE)'; + TestRecordArray.aAC[i] := 'A'; + TestRecordArray.aWC[i] := 'W'; + TestRecordArray.aEnum[i] := Seven; +// TestRecordArray.aEnum2[i] := Seventeen; + end; + + SetLength( aB, 0 ); + SetLength( aU8, 0 ); + SetLength( aS8, 0 ); + SetLength( aU16, 0 ); + SetLength( aS16, 0 ); + SetLength( aU32, 0 ); + SetLength( aS32, 0 ); +// SetLength( aU64, 0 ); + SetLength( aS64, 0 ); + SetLength( aSi, 0 ); + SetLength( aD, 0 ); + SetLength( aE, 0 ); + SetLength( aAS, 0 ); + SetLength( aWS, 0 ); + SetLength( aAC, 0 ); + SetLength( aWC, 0 ); + SetLength( aEnum, 0 ); +// SetLength( aEnum2, 0 ); + + SetLength( TestRecordArray.aB, 0 ); + SetLength( TestRecordArray.aU8, 0 ); + SetLength( TestRecordArray.aS8, 0 ); + SetLength( TestRecordArray.aU16, 0 ); + SetLength( TestRecordArray.aS16, 0 ); + SetLength( TestRecordArray.aU32, 0 ); + SetLength( TestRecordArray.aS32, 0 ); +// SetLength( TestRecordArray.aU64, 0 ); + SetLength( TestRecordArray.aS64, 0 ); + SetLength( TestRecordArray.aSi, 0 ); + SetLength( TestRecordArray.aD, 0 ); + SetLength( TestRecordArray.aE, 0 ); + SetLength( TestRecordArray.aAS, 0 ); + SetLength( TestRecordArray.aWS, 0 ); + SetLength( TestRecordArray.aAC, 0 ); + SetLength( TestRecordArray.aWC, 0 ); + SetLength( TestRecordArray.aEnum, 0 ); +// SetLength( TestRecordArray.aEnum2, 0 ); +end. \ No newline at end of file diff --git a/Source/InvokeCall.inc b/Source/InvokeCall.inc index 5251d075..9b1c12ae 100644 --- a/Source/InvokeCall.inc +++ b/Source/InvokeCall.inc @@ -22,6 +22,8 @@ type DataVariant: TArray>; {$IFNDEF PS_NOINT64} DataS64: TArray>; + {$ENDIF} + {$IFNDEF PS_NOUINT64} DataU64: TArray>; {$ENDIF} DataChar: TArray>; @@ -186,6 +188,8 @@ begin aValues := aValues + [TValue.From(@aOpenArrayData^.DataS64[High(aOpenArrayData^.DataS64)][0])]; aValues := aValues + [TValue.From(l_high)]; end; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: begin aOpenArrayData^.DataU64 := aOpenArrayData^.DataU64 + [[]]; SetLength(aOpenArrayData^.DataU64[High(aOpenArrayData^.DataU64)], l_high + 1); @@ -304,6 +308,8 @@ begin {$IFNDEF PS_NOINT64} //17 btS64: aValues := aValues + [TValue.From(PInt64(aValue^.dta)^)]; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: aValues := aValues + [TValue.From(PUInt64(aValue^.dta)^)]; {$ENDIF} //18 @@ -421,7 +427,8 @@ begin btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btWideString, btWideChar, {$ENDIF} btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency, btUnicodeString - {$IFNDEF PS_NOINT64}, bts64, btU64{$ENDIF}: + {$IFNDEF PS_NOINT64}, bts64{$ENDIF} + {$IFNDEF PS_NOUINT64}, btU64{$ENDIF}: Arg := TValue.From( Pointer(fvar.dta) ); else begin @@ -505,6 +512,8 @@ begin {$IFNDEF PS_NOINT64} //17 bts64: PInt64(res.dta)^ := Int64(Invoke(Address,Args,SysCalConv,TypeInfo(Int64),IsStatic).AsInt64); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: PUInt64(res.dta)^ := UInt64(Invoke(Address,Args,SysCalConv,TypeInfo(UInt64),IsStatic).AsUInt64); {$ENDIF} //18 diff --git a/Source/PascalScript.bpg b/Source/PascalScript.bpg new file mode 100644 index 00000000..3ae04ed9 --- /dev/null +++ b/Source/PascalScript.bpg @@ -0,0 +1,23 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = PascalScript_Core.bpl PascalScript_Design.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + +PascalScript_Core.bpl: PascalScript_Core.dpk + $(DCC) + +PascalScript_Design.bpl: PascalScript_Design.dpk + $(DCC) + + diff --git a/Source/PascalScript.inc b/Source/PascalScript.inc index 6ed5c1b8..8ac721a5 100644 --- a/Source/PascalScript.inc +++ b/Source/PascalScript.inc @@ -29,19 +29,21 @@ {$ENDIF} {$IFNDEF FPC} -{$IFNDEF DELPHI4UP} -{$IFNDEF LINUX} - {$DEFINE PS_NOINT64} -{$ENDIF} -{$ENDIF} - -{$IFDEF DELPHI2} - {$DEFINE PS_NOINT64} - {$DEFINE PS_NOWIDESTRING} - {$B-}{$X+}{$T-}{$H+} -{$ENDIF} - -{$IFDEF LINUX}{KYLIX}{$DEFINE CLX}{$DEFINE DELPHI3UP}{$DEFINE DELPHI6UP}{$ENDIF} + {$IFNDEF DELPHI4UP} + {$IFNDEF LINUX} + {$DEFINE PS_NOINT64} + {$DEFINE PS_NOUINT64} + {$ENDIF} + {$ENDIF} + + {$IFDEF DELPHI2} + {$DEFINE PS_NOINT64} + {$DEFINE PS_NOUINT64} + {$DEFINE PS_NOWIDESTRING} + {$B-}{$X+}{$T-}{$H+} + {$ENDIF} + + {$IFDEF LINUX}{KYLIX}{$DEFINE CLX}{$DEFINE DELPHI3UP}{$DEFINE DELPHI6UP}{$ENDIF} {$ENDIF} {$R-}{$Q-} @@ -52,7 +54,9 @@ Defines: PS_NOIDISPATCH PS_NOWIDESTRING PS_NOINT64 + PS_NOUINT64 PS_DELPHIDIV + PS_USECLASSICINVOKE } {$UNDEF DEBUG} diff --git a/Source/PascalScript_Core.dpk b/Source/PascalScript_Core.dpk new file mode 100644 index 00000000..56505992 --- /dev/null +++ b/Source/PascalScript_Core.dpk @@ -0,0 +1,105 @@ +package PascalScript_Core; + +{.$DEFINE NO_DB} // Delphi 6 Personal +{$DEFINE SynEdit} + +{$R *.res} + +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION OFF} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$ENDIF IMPLICITBUILDING} +{$DESCRIPTION 'RemObjects Pascal Script - Core Package'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl + {$IFNDEF NO_DB} + ,dbrtl + {$ENDIF} + {$IFDEF SynEdit} + ,SynEdit_R + {$ENDIF} + ; + +contains + uPSC_extctrls in 'uPSC_extctrls.pas', + uPSC_forms in 'uPSC_forms.pas', + uPSC_graphics in 'uPSC_graphics.pas', + uPSC_menus in 'uPSC_menus.pas', + uPSC_std in 'uPSC_std.pas', + uPSC_stdctrls in 'uPSC_stdctrls.pas', + uPSCompiler in 'uPSCompiler.pas', + uPSComponent in 'uPSComponent.pas', + uPSComponent_COM in 'uPSComponent_COM.pas', + uPSComponent_Controls in 'uPSComponent_Controls.pas', + uPSComponent_Default in 'uPSComponent_Default.pas', + uPSComponent_Forms in 'uPSComponent_Forms.pas', + uPSComponent_StdCtrls in 'uPSComponent_StdCtrls.pas', + uPSDebugger in 'uPSDebugger.pas', + uPSDisassembly in 'uPSDisassembly.pas', + uPSPreProcessor in 'uPSPreProcessor.pas', + uPSR_buttons in 'uPSR_buttons.pas', + uPSR_classes in 'uPSR_classes.pas', + uPSR_comobj in 'uPSR_comobj.pas', + uPSR_controls in 'uPSR_controls.pas', + uPSR_dateutils in 'uPSR_dateutils.pas', + uPSR_dll in 'uPSR_dll.pas', + uPSR_extctrls in 'uPSR_extctrls.pas', + uPSR_forms in 'uPSR_forms.pas', + uPSR_graphics in 'uPSR_graphics.pas', + uPSR_menus in 'uPSR_menus.pas', + uPSR_std in 'uPSR_std.pas', + uPSR_stdctrls in 'uPSR_stdctrls.pas', + uPSRuntime in 'uPSRuntime.pas', + uPSUtils in 'uPSUtils.pas', + uPSC_buttons in 'uPSC_buttons.pas', + uPSC_classes in 'uPSC_classes.pas', + uPSC_comobj in 'uPSC_comobj.pas', + uPSC_controls in 'uPSC_controls.pas', + uPSC_dateutils in 'uPSC_dateutils.pas', + uPSC_dll in 'uPSC_dll.pas', + uPSC_Math in 'uPSC_Math.pas', + uPSC_StrUtils in 'uPSC_StrUtils.pas', + uPSC_SysUtils in 'uPSC_SysUtils.pas', + uPSI_Dialogs in 'uPSI_Dialogs.pas', + uPSI_IniFiles in 'uPSI_IniFiles.pas', + uPSI_Registry in 'uPSI_Registry.pas', + uPSR_Math in 'uPSR_Math.pas', + uPSR_StrUtils in 'uPSR_StrUtils.pas', + uPSR_SysUtils in 'uPSR_SysUtils.pas', + {$IFDEF SynEdit} + {$IFNDEF UNICODE}WideStrUtils,{$ENDIF UNICODE} + uPSI_SynEdit in 'uPSI_SynEdit.pas', + {$ENDIF} + uPSComponentExt in 'uPSComponentExt.pas' + {$IFNDEF NO_DB} + ,uPSComponent_DB in 'uPSComponent_DB.pas', + uPSR_DB in 'uPSR_DB.pas', + uPSC_DB in 'uPSC_DB.pas' + {$ENDIF} + ; + +end. + diff --git a/Source/PascalScript_Core.drc b/Source/PascalScript_Core.drc new file mode 100644 index 00000000..615af5f9 --- /dev/null +++ b/Source/PascalScript_Core.drc @@ -0,0 +1,275 @@ +/* VER150 + Generiert vom Borland Delphi Pascal Compiler + da -GD or --drc beim Compilieren angegeben war. + + Sie enthält Compiler-generierte Ressourcen, die mit der ausführbaren Datei verbunden sind. + Wenn sie leer ist, wurden keine vom Compiler generierten Ressourcen mit der + produzierten ausführbaren Datei verbunden. +*/ + +#define uPSComponent_RPS_UnknownIdentifier 65392 +#define uPSComponent_RPS_NoScript 65393 +#define uPSComponentExt_sMissingEndStatment 65394 +#define uPSPreProcessor_RPS_TooManyNestedInclude 65408 +#define uPSPreProcessor_RPS_IncludeNotFound 65409 +#define uPSPreProcessor_RPS_DefineTooManyParameters 65410 +#define uPSPreProcessor_RPS_DefineTooLessParameters 65411 +#define uPSPreProcessor_RPS_DefineInvalidParameters 65412 +#define uPSPreProcessor_RPS_NoIfdefForEndif 65413 +#define uPSPreProcessor_RPS_NoIfdefForElse 65414 +#define uPSPreProcessor_RPS_ElseTwice 65415 +#define uPSPreProcessor_RPS_UnknownCompilerDirective 65416 +#define uPSPreProcessor_RPs_DefineNotClosed 65417 +#define uPSComponent_RPS_UnableToReadVariant 65418 +#define uPSComponent_RPS_UnableToWriteVariant 65419 +#define uPSComponent_RPS_ScripEngineAlreadyRunning 65420 +#define uPSComponent_RPS_ScriptNotCompiled 65421 +#define uPSComponent_RPS_NotRunning 65422 +#define uPSComponent_RPS_UnableToFindVariable 65423 +#define uPSRuntime_RPS_InvalidVariable 65424 +#define uPSRuntime_RPS_InvalidArray 65425 +#define uPSRuntime_RPS_UnknownProcedure 65426 +#define uPSRuntime_RPS_NotEnoughParameters 65427 +#define uPSRuntime_RPS_InvalidParameter 65428 +#define uPSRuntime_RPS_TooManyParameters 65429 +#define uPSRuntime_RPS_OutOfStringRange 65430 +#define uPSRuntime_RPS_CannotCastInterface 65431 +#define uPSRuntime_RPS_CannotCastObject 65432 +#define uPSRuntime_RPS_CapacityLength 65433 +#define uPSRuntime_RPS_CanOnlySendLastItem 65434 +#define uPSRuntime_RPS_NILInterfaceException 65435 +#define uPSRuntime_RPS_UnknownMethod 65436 +#define uPSDebugger_RPS_ExpectedReturnAddressStackBase 65437 +#define uPSC_dll_RPS_Invalid_External 65438 +#define uPSC_dll_RPS_InvalidCallingConvention 65439 +#define uPSRuntime_RPS_OutOfGlobalVarsRange 65440 +#define uPSRuntime_RPS_OutOfProcRange 65441 +#define uPSRuntime_RPS_OutOfRange 65442 +#define uPSRuntime_RPS_OutOfStackRange 65443 +#define uPSRuntime_RPS_TypeMismatch 65444 +#define uPSRuntime_RPS_UnexpectedEof 65445 +#define uPSRuntime_RPS_VersionError 65446 +#define uPSRuntime_RPS_DivideByZero 65447 +#define uPSRuntime_RPS_MathError 65448 +#define uPSRuntime_RPS_CouldNotCallProc 65449 +#define uPSRuntime_RPS_OutofRecordRange 65450 +#define uPSRuntime_RPS_NullPointerException 65451 +#define uPSRuntime_RPS_NullVariantError 65452 +#define uPSRuntime_RPS_OutOfMemory 65453 +#define uPSRuntime_RPS_InterfaceNotSupported 65454 +#define uPSRuntime_RPS_UnknownError 65455 +#define uPSCompiler_RPS_AbstractClass 65456 +#define uPSCompiler_RPS_UnknownWarning 65457 +#define uPSCompiler_RPS_NotArrayProperty 65458 +#define uPSCompiler_RPS_NotProperty 65459 +#define uPSCompiler_RPS_UnknownProperty 65460 +#define uPSRuntime_RPS_UnknownIdentifier 65461 +#define uPSRuntime_RPS_Exception 65462 +#define uPSRuntime_RPS_Invalid 65463 +#define uPSRuntime_RPS_NoError 65464 +#define uPSRuntime_RPS_CannotImport 65465 +#define uPSRuntime_RPS_InvalidType 65466 +#define uPSRuntime_RPS_InternalError 65467 +#define uPSRuntime_RPS_InvalidHeader 65468 +#define uPSRuntime_RPS_InvalidOpcode 65469 +#define uPSRuntime_RPS_InvalidOpcodeParameter 65470 +#define uPSRuntime_RPS_NoMainProc 65471 +#define uPSCompiler_RPS_MathError 65472 +#define uPSCompiler_RPS_UnsatisfiedForward 65473 +#define uPSCompiler_RPS_ForwardParameterMismatch 65474 +#define uPSCompiler_RPS_InvalidNumberOfParameter 65475 +#define uPSCompiler_RPS_UnknownError 65476 +#define uPSCompiler_RPS_NotAllowed 65477 +#define uPSCompiler_RPS_UnitNotFound 65478 +#define uPSCompiler_RPS_CrossReference 65479 +#define uPSCompiler_RPS_UnClosedAttributes 65480 +#define uPSCompiler_RPS_Hint 65481 +#define uPSCompiler_RPS_VariableNotUsed 65482 +#define uPSCompiler_RPS_FunctionNotUsed 65483 +#define uPSCompiler_RPS_UnknownHint 65484 +#define uPSCompiler_RPS_Warning 65485 +#define uPSCompiler_RPS_CalculationAlwaysEvaluatesTo 65486 +#define uPSCompiler_RPS_IsNotNeeded 65487 +#define uPSCompiler_RPS_CommaExpected 65488 +#define uPSCompiler_RPS_ToExpected 65489 +#define uPSCompiler_RPS_IsExpected 65490 +#define uPSCompiler_RPS_OfExpected 65491 +#define uPSCompiler_RPS_CloseBlockExpected 65492 +#define uPSCompiler_RPS_VariableExpected 65493 +#define uPSCompiler_RPS_StringExpected 65494 +#define uPSCompiler_RPS_EndExpected 65495 +#define uPSCompiler_RPS_UnSetLabel 65496 +#define uPSCompiler_RPS_NotInLoop 65497 +#define uPSCompiler_RPS_InvalidJump 65498 +#define uPSCompiler_RPS_OpenBlockExpected 65499 +#define uPSCompiler_RPS_WriteOnlyProperty 65500 +#define uPSCompiler_RPS_ReadOnlyProperty 65501 +#define uPSCompiler_RPS_ClassTypeExpected 65502 +#define uPSCompiler_RPS_DivideByZero 65503 +#define uPSCompiler_RPS_SyntaxError 65504 +#define uPSCompiler_RPS_EOF 65505 +#define uPSCompiler_RPS_SemiColonExpected 65506 +#define uPSCompiler_RPS_BeginExpected 65507 +#define uPSCompiler_RPS_PeriodExpected 65508 +#define uPSCompiler_RPS_DuplicateIdent 65509 +#define uPSCompiler_RPS_ColonExpected 65510 +#define uPSCompiler_RPS_UnknownType 65511 +#define uPSCompiler_RPS_CloseRoundExpected 65512 +#define uPSCompiler_RPS_TypeMismatch 65513 +#define uPSCompiler_RPS_InternalError 65514 +#define uPSCompiler_RPS_AssignmentExpected 65515 +#define uPSCompiler_RPS_ThenExpected 65516 +#define uPSCompiler_RPS_DoExpected 65517 +#define uPSCompiler_RPS_NoResult 65518 +#define uPSCompiler_RPS_OpenRoundExpected 65519 +#define uPSUtils_RPS_InvalidFloat 65520 +#define uPSCompiler_RPS_OnUseEventOnly 65521 +#define uPSCompiler_RPS_UnableToRegisterFunction 65522 +#define uPSCompiler_RPS_UnableToRegisterConst 65523 +#define uPSCompiler_RPS_InvalidTypeForVar 65524 +#define uPSCompiler_RPS_InvalidType 65525 +#define uPSCompiler_RPS_UnableToRegisterType 65526 +#define uPSCompiler_RPS_UnknownInterface 65527 +#define uPSCompiler_RPS_ConstantValueMismatch 65528 +#define uPSCompiler_RPS_ConstantValueNotAssigned 65529 +#define uPSCompiler_RPS_Error 65530 +#define uPSCompiler_RPS_UnknownIdentifier 65531 +#define uPSCompiler_RPS_IdentifierExpected 65532 +#define uPSCompiler_RPS_CommentError 65533 +#define uPSCompiler_RPS_StringError 65534 +#define uPSCompiler_RPS_CharError 65535 +STRINGTABLE +BEGIN + uPSComponent_RPS_UnknownIdentifier, "Unknown Identifier" + uPSComponent_RPS_NoScript, "No script" + uPSComponentExt_sMissingEndStatment, "Missing some 'End' statments" + uPSPreProcessor_RPS_TooManyNestedInclude, "Too many nested include files while processing '%s' from '%s'" + uPSPreProcessor_RPS_IncludeNotFound, "Unable to find file '%s' used from '%s'" + uPSPreProcessor_RPS_DefineTooManyParameters, "Too many parameters in '%s' at %d:%d" + uPSPreProcessor_RPS_DefineTooLessParameters, "Too less parameters in '%s' at %d:%d" + uPSPreProcessor_RPS_DefineInvalidParameters, "Invalid parameters in '%s' at %d:%d" + uPSPreProcessor_RPS_NoIfdefForEndif, "No IFDEF for ENDIF in '%s' at %d:%d" + uPSPreProcessor_RPS_NoIfdefForElse, "No IFDEF for ELSE in '%s' at %d:%d" + uPSPreProcessor_RPS_ElseTwice, "Can't use ELSE twice in '%s' at %d:%d" + uPSPreProcessor_RPS_UnknownCompilerDirective, "Unknown compiler directives in '%s' at %d:%d" + uPSPreProcessor_RPs_DefineNotClosed, "Define not closed" + uPSComponent_RPS_UnableToReadVariant, "Unable to read variant" + uPSComponent_RPS_UnableToWriteVariant, "Unable to write variant" + uPSComponent_RPS_ScripEngineAlreadyRunning, "Script engine already running" + uPSComponent_RPS_ScriptNotCompiled, "Script is not compiled" + uPSComponent_RPS_NotRunning, "Not running" + uPSComponent_RPS_UnableToFindVariable, "Unable to find variable" + uPSRuntime_RPS_InvalidVariable, "Invalid variable" + uPSRuntime_RPS_InvalidArray, "Invalid array" + uPSRuntime_RPS_UnknownProcedure, "Unknown procedure" + uPSRuntime_RPS_NotEnoughParameters, "Not enough parameters" + uPSRuntime_RPS_InvalidParameter, "Invalid parameter" + uPSRuntime_RPS_TooManyParameters, "Too many parameters" + uPSRuntime_RPS_OutOfStringRange, "Out of string range" + uPSRuntime_RPS_CannotCastInterface, "Cannot cast an interface" + uPSRuntime_RPS_CannotCastObject, "Cannot cast an object" + uPSRuntime_RPS_CapacityLength, "Capacity < Length" + uPSRuntime_RPS_CanOnlySendLastItem, "Can only remove last item from stack" + uPSRuntime_RPS_NILInterfaceException, "Nil interface" + uPSRuntime_RPS_UnknownMethod, "Unknown method" + uPSDebugger_RPS_ExpectedReturnAddressStackBase, "Expected return address at stack base" + uPSC_dll_RPS_Invalid_External, "Invalid External" + uPSC_dll_RPS_InvalidCallingConvention, "Invalid Calling Convention" + uPSRuntime_RPS_OutOfGlobalVarsRange, "Out of Global Vars range" + uPSRuntime_RPS_OutOfProcRange, "Out of Proc Range" + uPSRuntime_RPS_OutOfRange, "Out Of Range" + uPSRuntime_RPS_OutOfStackRange, "Out Of Stack Range" + uPSRuntime_RPS_TypeMismatch, "Type Mismatch" + uPSRuntime_RPS_UnexpectedEof, "Unexpected End Of File" + uPSRuntime_RPS_VersionError, "Version error" + uPSRuntime_RPS_DivideByZero, "divide by Zero" + uPSRuntime_RPS_MathError, "Math error" + uPSRuntime_RPS_CouldNotCallProc, "Could not call proc" + uPSRuntime_RPS_OutofRecordRange, "Out of Record Fields Range" + uPSRuntime_RPS_NullPointerException, "Null Pointer Exception" + uPSRuntime_RPS_NullVariantError, "Null variant error" + uPSRuntime_RPS_OutOfMemory, "Out Of Memory" + uPSRuntime_RPS_InterfaceNotSupported, "Interface not supported" + uPSRuntime_RPS_UnknownError, "Unknown error" + uPSCompiler_RPS_AbstractClass, "Abstract Class Construction" + uPSCompiler_RPS_UnknownWarning, "Unknown warning" + uPSCompiler_RPS_NotArrayProperty, "Not an array property : '%s'" + uPSCompiler_RPS_NotProperty, "Not a property : '%s'" + uPSCompiler_RPS_UnknownProperty, "Unknown Property : '%s'" + uPSRuntime_RPS_UnknownIdentifier, "Unknown Identifier" + uPSRuntime_RPS_Exception, "Exception: %s" + uPSRuntime_RPS_Invalid, "[Invalid]" + uPSRuntime_RPS_NoError, "No Error" + uPSRuntime_RPS_CannotImport, "Cannot Import %s" + uPSRuntime_RPS_InvalidType, "Invalid Type" + uPSRuntime_RPS_InternalError, "Internal error" + uPSRuntime_RPS_InvalidHeader, "Invalid Header" + uPSRuntime_RPS_InvalidOpcode, "Invalid Opcode" + uPSRuntime_RPS_InvalidOpcodeParameter, "Invalid Opcode Parameter" + uPSRuntime_RPS_NoMainProc, "no Main Proc" + uPSCompiler_RPS_MathError, "Math Error" + uPSCompiler_RPS_UnsatisfiedForward, "Unsatisfied Forward %s" + uPSCompiler_RPS_ForwardParameterMismatch, "Forward Parameter Mismatch" + uPSCompiler_RPS_InvalidNumberOfParameter, "Invalid number of parameters" + uPSCompiler_RPS_UnknownError, "Unknown error" + uPSCompiler_RPS_NotAllowed, "%s is not allowed at this position" + uPSCompiler_RPS_UnitNotFound, "Unit '%s' not found or contains errors" + uPSCompiler_RPS_CrossReference, "Cross-Reference error of '%s'" + uPSCompiler_RPS_UnClosedAttributes, "Attributes not closed" + uPSCompiler_RPS_Hint, "Hint" + uPSCompiler_RPS_VariableNotUsed, "Variable '%s' never used" + uPSCompiler_RPS_FunctionNotUsed, "Function '%s' never used" + uPSCompiler_RPS_UnknownHint, "Unknown hint" + uPSCompiler_RPS_Warning, "Warning" + uPSCompiler_RPS_CalculationAlwaysEvaluatesTo, "Calculation always evaluates to %s" + uPSCompiler_RPS_IsNotNeeded, "%s is not needed" + uPSCompiler_RPS_CommaExpected, "comma (',') expected" + uPSCompiler_RPS_ToExpected, "'TO' expected" + uPSCompiler_RPS_IsExpected, "is ('=') expected" + uPSCompiler_RPS_OfExpected, "'OF' expected" + uPSCompiler_RPS_CloseBlockExpected, "Closing square bracket (']') expected" + uPSCompiler_RPS_VariableExpected, "Variable Expected" + uPSCompiler_RPS_StringExpected, "String Expected" + uPSCompiler_RPS_EndExpected, "'END' expected" + uPSCompiler_RPS_UnSetLabel, "Label '%s' not set" + uPSCompiler_RPS_NotInLoop, "Not in a loop" + uPSCompiler_RPS_InvalidJump, "Invalid jump" + uPSCompiler_RPS_OpenBlockExpected, "Opening square brackets ('[') expected" + uPSCompiler_RPS_WriteOnlyProperty, "Write-only property" + uPSCompiler_RPS_ReadOnlyProperty, "Read-only property" + uPSCompiler_RPS_ClassTypeExpected, "Class type expected" + uPSCompiler_RPS_DivideByZero, "Divide by Zero" + uPSCompiler_RPS_SyntaxError, "Syntax error" + uPSCompiler_RPS_EOF, "Unexpected end of file" + uPSCompiler_RPS_SemiColonExpected, "Semicolon (';') expected" + uPSCompiler_RPS_BeginExpected, "'BEGIN' expected" + uPSCompiler_RPS_PeriodExpected, "period ('.') expected" + uPSCompiler_RPS_DuplicateIdent, "Duplicate identifier '%s'" + uPSCompiler_RPS_ColonExpected, "colon (':') expected" + uPSCompiler_RPS_UnknownType, "Unknown type '%s'" + uPSCompiler_RPS_CloseRoundExpected, "Closing parenthesis expected" + uPSCompiler_RPS_TypeMismatch, "Type mismatch" + uPSCompiler_RPS_InternalError, "Internal error (%s)" + uPSCompiler_RPS_AssignmentExpected, "Assignment expected" + uPSCompiler_RPS_ThenExpected, "'THEN' expected" + uPSCompiler_RPS_DoExpected, "'DO' expected" + uPSCompiler_RPS_NoResult, "No result" + uPSCompiler_RPS_OpenRoundExpected, "opening parenthesis ('(')expected" + uPSUtils_RPS_InvalidFloat, "Invalid float" + uPSCompiler_RPS_OnUseEventOnly, "This function can only be called from within the OnUses event" + uPSCompiler_RPS_UnableToRegisterFunction, "Unable to register function %s" + uPSCompiler_RPS_UnableToRegisterConst, "Unable to register constant %s" + uPSCompiler_RPS_InvalidTypeForVar, "Invalid type for variable %s" + uPSCompiler_RPS_InvalidType, "Invalid Type" + uPSCompiler_RPS_UnableToRegisterType, "Unable to register type %s" + uPSCompiler_RPS_UnknownInterface, "Unknown interface: %s" + uPSCompiler_RPS_ConstantValueMismatch, "Constant Value Type Mismatch" + uPSCompiler_RPS_ConstantValueNotAssigned, "Constant Value is not assigned" + uPSCompiler_RPS_Error, "Error" + uPSCompiler_RPS_UnknownIdentifier, "Unknown identifier '%s'" + uPSCompiler_RPS_IdentifierExpected, "Identifier expected" + uPSCompiler_RPS_CommentError, "Comment error" + uPSCompiler_RPS_StringError, "String error" + uPSCompiler_RPS_CharError, "Char error" +END + diff --git a/Source/PascalScript_Core.res b/Source/PascalScript_Core.res new file mode 100644 index 00000000..cbd3d2c8 Binary files /dev/null and b/Source/PascalScript_Core.res differ diff --git a/Source/PascalScript_Design.dpk b/Source/PascalScript_Design.dpk new file mode 100644 index 00000000..0bb4740b --- /dev/null +++ b/Source/PascalScript_Design.dpk @@ -0,0 +1,41 @@ +package PascalScript_Design; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'RemObjects Pascal Script - Design Package'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + designide, + PascalScript_Core; + +contains + {$IFDEF NO_DB} + PascalScript_Core_Reg_noDB in 'PascalScript_Core_Reg_noDB.pas', + {$ELSE} + PascalScript_Core_Reg in 'PascalScript_Core_Reg.pas', + {$ENDIF} + PascalScript_Core_Ext_Reg in 'PascalScript_Core_Ext_Reg.pas'; + +end. diff --git a/Source/PascalScript_Design.drc b/Source/PascalScript_Design.drc new file mode 100644 index 00000000..db2a7e3c --- /dev/null +++ b/Source/PascalScript_Design.drc @@ -0,0 +1,13 @@ +/* VER150 + Generiert vom Borland Delphi Pascal Compiler + da -GD or --drc beim Compilieren angegeben war. + + Sie enthält Compiler-generierte Ressourcen, die mit der ausführbaren Datei verbunden sind. + Wenn sie leer ist, wurden keine vom Compiler generierten Ressourcen mit der + produzierten ausführbaren Datei verbunden. +*/ + +STRINGTABLE +BEGIN +END + diff --git a/Source/PascalScript_Design.res b/Source/PascalScript_Design.res new file mode 100644 index 00000000..622f41ea Binary files /dev/null and b/Source/PascalScript_Design.res differ diff --git a/Source/ThirdParty/uPSI_SynEdit.pas b/Source/ThirdParty/uPSI_SynEdit.pas new file mode 100644 index 00000000..6b512ea9 --- /dev/null +++ b/Source/ThirdParty/uPSI_SynEdit.pas @@ -0,0 +1,1666 @@ +unit uPSI_SynEdit; +{ +This file has been generated by UnitParser v0.7, written by M. Knight +and updated by NP. v/d Spek and George Birbilis. +Source Code from Carlo Kok has been used to implement various sections of +UnitParser. Components of ROPS are used in the construction of UnitParser, +code implementing the class wrapper is taken from Carlo Kok's conv utility + +} +interface + +{$WARN UNSAFE_CODE OFF} + +uses + SysUtils + ,Classes + ,uPSComponent + ,uPSRuntime + ,uPSCompiler + ; + +type +(*----------------------------------------------------------------------------*) + TPSImport_SynEdit = class(TPSPlugin) + public + procedure CompileImport1(CompExec: TPSScript); override; + procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override; + end; + +{ compile-time registration functions } +procedure SIRegister_TSynEdit(CL: TPSPascalCompiler); +procedure SIRegister_TCustomSynEdit(CL: TPSPascalCompiler); +procedure SIRegister_TSynEditPlugin(CL: TPSPascalCompiler); +procedure SIRegister_TSynEditMarkList(CL: TPSPascalCompiler); +procedure SIRegister_TSynEditMark(CL: TPSPascalCompiler); +procedure SIRegister_SynEdit(CL: TPSPascalCompiler); // MS + +{ run-time registration functions } +procedure RIRegister_TSynEdit(CL: TPSRuntimeClassImporter); +procedure RIRegister_TCustomSynEdit(CL: TPSRuntimeClassImporter); +procedure RIRegister_TSynEditPlugin(CL: TPSRuntimeClassImporter); +procedure RIRegister_TSynEditMarkList(CL: TPSRuntimeClassImporter); +procedure RIRegister_TSynEditMark(CL: TPSRuntimeClassImporter); +procedure RIRegister_SynEdit(CL: TPSRuntimeClassImporter); + +procedure Register; + +implementation + + +uses + Controls + ,Contnrs + ,Graphics + ,Forms + ,StdCtrls + ,ExtCtrls + ,Windows + ,Messages + ,StdActns + ,Dialogs + ,Themes + ,Types + {$IF CompilerVersion >= 23} + ,UITypes + {$IFEND} + ,Imm + ,SynUnicode + ,SynTextDrawer + ,SynEditTypes + ,SynEditKeyConst + ,SynEditMiscProcs + ,SynEditMiscClasses + ,SynEditTextBuffer + ,SynEditKeyCmds + ,SynEditHighlighter + ,SynEditKbdHandler + {$IF CompilerVersion >= 23} + ,SynEditCodeFolding + {$IFEND} + ,WideStrUtils + ,Math + ,SynEdit + ; + + +procedure Register; +begin + RegisterComponents('Pascal Script', [TPSImport_SynEdit]); +end; + +procedure SIRegister_TUnicodeStrings(Cl: TPSPascalCompiler; Streams: Boolean); +begin + with Cl.AddClassN(cl.FindClass('TPersistent'), 'TUnicodeStrings') do + begin + IsAbstract := True; +{$IFDEF DELPHI2005UP} + RegisterMethod('constructor Create;'); +{$ENDIF} + RegisterMethod('function Add(S: string): Integer;'); + RegisterMethod('procedure Append(S: string);'); + RegisterMethod('procedure AddStrings(Strings: TStrings);'); + RegisterMethod('procedure Clear;'); + RegisterMethod('procedure Delete(Index: Integer);'); + RegisterMethod('function IndexOf(const S: string): Integer; '); + RegisterMethod('procedure Insert(Index: Integer; S: string); '); + RegisterProperty('Capacity', 'Integer', iptRW); + RegisterProperty('Delimiter', 'Char', iptRW); +{$IFDEF DELPHI2006UP} + RegisterProperty('StrictDelimiter', 'Boolean', iptRW); +{$ENDIF} + RegisterProperty('DelimitedText', 'string', iptrw); + RegisterProperty('NameValueSeparator', 'Char', iptRW); + RegisterProperty('QuoteChar', 'Char', iptRW); + RegisterProperty('Count', 'Integer', iptR); + RegisterProperty('Text', 'string', iptrw); + RegisterProperty('CommaText', 'string', iptrw); + if Streams then + begin + RegisterMethod('procedure LoadFromFile(FileName: string); '); + RegisterMethod('procedure SaveToFile(FileName: string); '); + end; + RegisterProperty('Strings', 'string Integer', iptRW); + SetDefaultPropery('Strings'); + RegisterProperty('Objects', 'TObject Integer', iptRW); + + {$IFNDEF PS_MINIVCL} + RegisterMethod('procedure BeginUpdate;'); + RegisterMethod('procedure EndUpdate;'); + RegisterMethod('function Equals(Strings: TStrings): Boolean;'); + RegisterMethod('procedure Exchange(Index1, Index2: Integer);'); + RegisterMethod('function IndexOfName(Name: string): Integer;'); + if Streams then + RegisterMethod('procedure LoadFromStream(Stream: TStream); '); + RegisterMethod('procedure Move(CurIndex, NewIndex: Integer); '); + if Streams then + RegisterMethod('procedure SaveToStream(Stream: TStream); '); + RegisterMethod('procedure SetText(Text: PChar); '); + RegisterProperty('Names', 'string Integer', iptr); + RegisterProperty('Values', 'string string', iptRW); + RegisterProperty('ValueFromIndex', 'string Integer', iptRW); + RegisterMethod('function AddObject(S: string; AObject: TObject): Integer'); + RegisterMethod('function GetText: PChar'); + RegisterMethod('function IndexOfObject(AObject: TObject): Integer'); + RegisterMethod('procedure InsertObject(Index: Integer; S: string; AObject: TObject)'); + {$ENDIF} + end; + + + + + + + + + + + + + +(* + with Cl.AddClassN(cl.FindClass('TPersistent'), 'TUnicodeStrings') do + begin + IsAbstract := True; +{$IFDEF DELPHI2005UP} + RegisterMethod('constructor Create;'); +{$ENDIF} + RegisterMethod('function Add(S: WideString): Integer;'); + RegisterMethod('procedure Append(S: WideString);'); + RegisterMethod('procedure AddStrings(Strings: TUnicodeStrings);'); + RegisterMethod('procedure Clear;'); + RegisterMethod('procedure Delete(Index: Integer);'); + RegisterMethod('function IndexOf(const S: WideString): Integer; '); + RegisterMethod('procedure Insert(Index: Integer; S: string); '); + RegisterProperty('Capacity', 'Integer', iptRW); + RegisterProperty('Delimiter', 'Char', iptRW); +{$IFDEF DELPHI2006UP} + RegisterProperty('StrictDelimiter', 'Boolean', iptRW); +{$ENDIF} + RegisterProperty('DelimitedText', 'WideString', iptrw); + RegisterProperty('NameValueSeparator', 'WideChar', iptRW); + RegisterProperty('QuoteChar', 'WideChar', iptRW); + RegisterProperty('Count', 'Integer', iptR); + RegisterProperty('Text', 'WideString', iptrw); + RegisterProperty('CommaText', 'WideString', iptrw); + if Streams then + begin + RegisterMethod('procedure LoadFromFile(FileName: string); '); + RegisterMethod('procedure SaveToFile(FileName: string); '); + end; + RegisterProperty('Strings', 'WideString Integer', iptRW); + SetDefaultPropery('Strings'); + RegisterProperty('Objects', 'TObject Integer', iptRW); + + {$IFNDEF PS_MINIVCL} + RegisterMethod('procedure BeginUpdate;'); + RegisterMethod('procedure EndUpdate;'); + RegisterMethod('function Equals(Strings: TUnicodeStrings): Boolean;'); + RegisterMethod('procedure Exchange(Index1, Index2: Integer);'); + RegisterMethod('function IndexOfName(Name: WideString): Integer;'); + if Streams then + RegisterMethod('procedure LoadFromStream(Stream: TStream); '); + RegisterMethod('procedure Move(CurIndex, NewIndex: Integer); '); + if Streams then + RegisterMethod('procedure SaveToStream(Stream: TStream); '); + RegisterMethod('procedure SetText(Text: PWideChar); '); + RegisterProperty('Names', 'WideString Integer', iptr); + RegisterProperty('Values', 'WideString string', iptRW); + RegisterProperty('ValueFromIndex', 'WideString Integer', iptRW); + RegisterMethod('function AddObject(S: WideString; AObject: TObject): Integer'); + RegisterMethod('function GetText: PWideChar'); + RegisterMethod('function IndexOfObject(AObject: TObject): Integer'); + RegisterMethod('procedure InsertObject(Index: Integer; S: WideString; AObject: TObject)'); + {$ENDIF} + end; +*) +end; + +procedure SIRegister_TUnicodeStringList(Cl: TPSPascalCompiler); +begin + with Cl.AddClassN(cl.FindClass('TStrings'), 'TUnicodeStringList') do + begin +{$IFDEF DELPHI2005UP} + RegisterMethod('constructor Create;'); +{$ENDIF} + RegisterMethod('function Find(S: WideString; var Index: Integer): Boolean'); + RegisterMethod('procedure Sort'); + RegisterProperty('CaseSensitive', 'Boolean', iptrw); + RegisterProperty('Duplicates', 'TDuplicates', iptrw); + RegisterProperty('Sorted', 'Boolean', iptrw); + RegisterProperty('OnChange', 'TNotifyEvent', iptrw); + RegisterProperty('OnChanging', 'TNotifyEvent', iptrw); + end; +end; + +(* === compile-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure SIRegister_TSynEdit(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomSynEdit', 'TSynEdit') do + with CL.AddClassN(CL.FindClass('TCustomSynEdit'),'TSynEdit') do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TCustomSynEdit(CL: TPSPascalCompiler); +begin + CL.AddTypeS('TBufferCoord', 'record Char: Integer; Line: Integer; end;'); + + //with RegClassS(CL,'TCustomControl', 'TCustomSynEdit') do + with CL.AddClassN(CL.FindClass('TCustomControl'),'TCustomSynEdit') do + begin + RegisterProperty('SelStart', 'Integer', iptrw); + RegisterProperty('SelEnd', 'Integer', iptrw); + RegisterProperty('AlwaysShowCaret', 'Boolean', iptrw); + RegisterMethod('Procedure UpdateCaret'); + RegisterMethod('Procedure AddKey( Command : TSynEditorCommand; Key1 : Word; SS1 : TShiftState; Key2 : Word; SS2 : TShiftState)'); + RegisterMethod('Procedure AddKey( Command : TSynEditorCommand; Key1 : Word; SS1 : TShiftState; Key2 : Word; SS2 : TShiftState)'); + RegisterMethod('Procedure BeginUndoBlock'); + RegisterMethod('Procedure BeginUpdate'); + RegisterMethod('Function CaretInView : Boolean'); + RegisterMethod('Function CharIndexToRowCol( Index : Integer) : TBufferCoord'); + RegisterMethod('Procedure Clear'); + RegisterMethod('Procedure ClearAll'); + RegisterMethod('Procedure ClearBookMark( BookMark : Integer)'); + RegisterMethod('Procedure ClearSelection'); + RegisterMethod('Procedure CommandProcessor( Command : TSynEditorCommand; AChar : WideChar; Data : Pointer)'); + RegisterMethod('Procedure ClearUndo'); + RegisterMethod('Procedure CopyToClipboard'); + RegisterMethod('Procedure CutToClipboard'); + RegisterMethod('Procedure DoCopyToClipboard( const SText : UnicodeString)'); + RegisterMethod('Procedure EndUndoBlock'); + RegisterMethod('Procedure EndUpdate'); + RegisterMethod('Procedure EnsureCursorPosVisible'); + RegisterMethod('Procedure EnsureCursorPosVisibleEx( ForceToMiddle : Boolean; EvenIfVisible : Boolean)'); + RegisterMethod('Procedure FindMatchingBracket'); + RegisterMethod('Function GetMatchingBracket : TBufferCoord'); + RegisterMethod('Function GetMatchingBracketEx( const APoint : TBufferCoord) : TBufferCoord'); + RegisterMethod('Procedure ExecuteCommand( Command : TSynEditorCommand; AChar : WideChar; Data : Pointer)'); + RegisterMethod('Function ExpandAtWideGlyphs( const S : UnicodeString) : UnicodeString'); + RegisterMethod('Function GetBookMark( BookMark : Integer; var X, Y : Integer) : Boolean'); + RegisterMethod('Function GetHighlighterAttriAtRowCol( const XY : TBufferCoord; var Token : UnicodeString; var Attri : TSynHighlighterAttributes) : Boolean'); + RegisterMethod('Function GetHighlighterAttriAtRowColEx( const XY : TBufferCoord; var Token : UnicodeString; var TokenType, Start : Integer; var Attri : TSynHighlighterAttributes) : Boolean'); + RegisterMethod('Function GetPositionOfMouse( out aPos : TBufferCoord) : Boolean'); + RegisterMethod('Function GetWordAtRowCol( XY : TBufferCoord) : UnicodeString'); + RegisterMethod('Procedure GotoBookMark( BookMark : Integer)'); + RegisterMethod('Procedure GotoLineAndCenter( ALine : Integer)'); + RegisterMethod('Function IsIdentChar( AChar : WideChar) : Boolean'); + RegisterMethod('Function IsWhiteChar( AChar : WideChar) : Boolean'); + RegisterMethod('Function IsWordBreakChar( AChar : WideChar) : Boolean'); + RegisterMethod('Procedure InsertBlock( const BB, BE : TBufferCoord; ChangeStr : PWideChar; AddToUndoList : Boolean)'); + RegisterMethod('Procedure InsertLine( const BB, BE : TBufferCoord; ChangeStr : PWideChar; AddToUndoList : Boolean)'); + RegisterMethod('Function UnifiedSelection : TBufferBlock'); + RegisterMethod('Procedure DoBlockIndent'); + RegisterMethod('Procedure DoBlockUnindent'); + RegisterMethod('Procedure InvalidateGutter'); + RegisterMethod('Procedure InvalidateGutterLine( aLine : Integer)'); + RegisterMethod('Procedure InvalidateGutterLines( FirstLine, LastLine : Integer)'); + RegisterMethod('Procedure InvalidateLine( Line : Integer)'); + RegisterMethod('Procedure InvalidateLines( FirstLine, LastLine : Integer)'); + RegisterMethod('Procedure InvalidateSelection'); + RegisterMethod('Procedure MarkModifiedLinesAsSaved'); + RegisterMethod('Procedure ResetModificationIndicator'); + RegisterMethod('Function IsBookmark( BookMark : Integer) : Boolean'); + RegisterMethod('Function IsPointInSelection( const Value : TBufferCoord) : Boolean'); + RegisterMethod('Procedure LockUndo'); + RegisterMethod('Function BufferToDisplayPos( const p : TBufferCoord) : TDisplayCoord'); + RegisterMethod('Function DisplayToBufferPos( const p : TDisplayCoord) : TBufferCoord'); + RegisterMethod('Function LineToRow( aLine : Integer) : Integer'); + RegisterMethod('Function RowToLine( aRow : Integer) : Integer'); + RegisterMethod('Procedure PasteFromClipboard'); + RegisterMethod('Function NextWordPos : TBufferCoord'); + RegisterMethod('Function NextWordPosEx( const XY : TBufferCoord) : TBufferCoord'); + RegisterMethod('Function WordStart : TBufferCoord'); + RegisterMethod('Function WordStartEx( const XY : TBufferCoord) : TBufferCoord'); + RegisterMethod('Function WordEnd : TBufferCoord'); + RegisterMethod('Function WordEndEx( const XY : TBufferCoord) : TBufferCoord'); + RegisterMethod('Function PrevWordPos : TBufferCoord'); + RegisterMethod('Function PrevWordPosEx( const XY : TBufferCoord) : TBufferCoord'); + RegisterMethod('Function PixelsToRowColumn( aX, aY : Integer) : TDisplayCoord'); + RegisterMethod('Function PixelsToNearestRowColumn( aX, aY : Integer) : TDisplayCoord'); + RegisterMethod('Procedure Redo'); + RegisterMethod('Procedure RegisterCommandHandler( const AHandlerProc : THookedCommandEvent; AHandlerData : Pointer)'); + RegisterMethod('Function RowColumnToPixels( const RowCol : TDisplayCoord) : TPoint'); + RegisterMethod('Function RowColToCharIndex( RowCol : TBufferCoord) : Integer'); + RegisterMethod('Function SearchReplace( const ASearch, AReplace : UnicodeString; AOptions : TSynSearchOptions) : Integer'); + RegisterMethod('Procedure SelectAll'); + RegisterMethod('Procedure SetBookMark( BookMark : Integer; X : Integer; Y : Integer)'); + RegisterMethod('Procedure SetCaretAndSelection( const ptCaret, ptBefore, ptAfter : TBufferCoord)'); + RegisterMethod('Procedure SetDefaultKeystrokes'); + RegisterMethod('Procedure SetSelWord'); + RegisterMethod('Procedure SetWordBlock( Value : TBufferCoord)'); + RegisterMethod('Procedure Undo'); + RegisterMethod('Procedure UnlockUndo'); + RegisterMethod('Procedure UnregisterCommandHandler( AHandlerProc : THookedCommandEvent)'); + RegisterMethod('Procedure AddKeyUpHandler( aHandler : TKeyEvent)'); + RegisterMethod('Procedure RemoveKeyUpHandler( aHandler : TKeyEvent)'); + RegisterMethod('Procedure AddKeyDownHandler( aHandler : TKeyEvent)'); + RegisterMethod('Procedure RemoveKeyDownHandler( aHandler : TKeyEvent)'); + RegisterMethod('Procedure AddKeyPressHandler( aHandler : TKeyPressWEvent)'); + RegisterMethod('Procedure RemoveKeyPressHandler( aHandler : TKeyPressWEvent)'); + RegisterMethod('Procedure AddFocusControl( aControl : TWinControl)'); + RegisterMethod('Procedure RemoveFocusControl( aControl : TWinControl)'); + RegisterMethod('Procedure AddMouseDownHandler( aHandler : TMouseEvent)'); + RegisterMethod('Procedure RemoveMouseDownHandler( aHandler : TMouseEvent)'); + RegisterMethod('Procedure AddMouseUpHandler( aHandler : TMouseEvent)'); + RegisterMethod('Procedure RemoveMouseUpHandler( aHandler : TMouseEvent)'); + RegisterMethod('Procedure AddMouseCursorHandler( aHandler : TMouseCursorEvent)'); + RegisterMethod('Procedure RemoveMouseCursorHandler( aHandler : TMouseCursorEvent)'); + RegisterMethod('Procedure SetLinesPointer( ASynEdit : TCustomSynEdit)'); + RegisterMethod('Procedure RemoveLinesPointer'); + RegisterMethod('Procedure HookTextBuffer( aBuffer : TSynEditStringList; aUndo, aRedo : TSynEditUndoList)'); + RegisterMethod('Procedure UnHookTextBuffer'); + {$IF CompilerVersion >= 23} + RegisterMethod('Procedure CollapseAll'); + RegisterMethod('Procedure UncollapseAll'); + RegisterMethod('Procedure Collapse( FoldRangeIndex : Integer; Invalidate : Boolean)'); + RegisterMethod('Procedure Uncollapse( FoldRangeIndex : Integer; Invalidate : Boolean)'); + RegisterMethod('Procedure UncollapseAroundLine( Line : Integer)'); + RegisterMethod('Procedure CollapseNearest'); + RegisterMethod('Procedure UncollapseNearest'); + RegisterMethod('Procedure CollapseLevel( Level : integer)'); + RegisterMethod('Procedure UnCollapseLevel( Level : integer)'); + RegisterMethod('Procedure CollapseFoldType( FoldType : Integer)'); + RegisterMethod('Procedure UnCollapseFoldType( FoldType : Integer)'); + {$IFEND} + RegisterProperty('AdditionalIdentChars', 'TSysCharSet', iptrw); + RegisterProperty('AdditionalWordBreakChars', 'TSysCharSet', iptrw); + RegisterProperty('BlockBegin', 'TBufferCoord', iptrw); + RegisterProperty('BlockEnd', 'TBufferCoord', iptrw); + RegisterProperty('CanPaste', 'Boolean', iptr); + RegisterProperty('CanRedo', 'Boolean', iptr); + RegisterProperty('CanUndo', 'Boolean', iptr); + RegisterProperty('CaretX', 'Integer', iptrw); + RegisterProperty('CaretY', 'Integer', iptrw); + RegisterProperty('CaretXY', 'TBufferCoord', iptrw); + RegisterProperty('ActiveLineColor', 'TColor', iptrw); + RegisterProperty('DisplayX', 'Integer', iptr); + RegisterProperty('DisplayY', 'Integer', iptr); + RegisterProperty('DisplayXY', 'TDisplayCoord', iptr); + RegisterProperty('DisplayLineCount', 'Integer', iptr); + RegisterProperty('CharsInWindow', 'Integer', iptr); + RegisterProperty('CharWidth', 'Integer', iptr); + RegisterProperty('Font', 'TFont', iptrw); + RegisterProperty('Highlighter', 'TSynCustomHighlighter', iptrw); + RegisterProperty('HintMode', 'TSynHintMode', iptrw); + RegisterProperty('LeftChar', 'Integer', iptrw); + RegisterProperty('LineHeight', 'Integer', iptr); + RegisterProperty('LinesInWindow', 'Integer', iptr); + RegisterProperty('LineText', 'UnicodeString', iptrw); + RegisterProperty('Lines', 'TStrings', iptrw); +// RegisterProperty('Lines', 'TUnicodeStrings', iptrw); + RegisterProperty('Marks', 'TSynEditMarkList', iptr); + RegisterProperty('MaxScrollWidth', 'Integer', iptrw); + RegisterProperty('Modified', 'Boolean', iptrw); + RegisterProperty('PaintLock', 'Integer', iptr); + RegisterProperty('ReadOnly', 'Boolean', iptrw); + RegisterProperty('SearchEngine', 'TSynEditSearchCustom', iptrw); + RegisterProperty('SelAvail', 'Boolean', iptr); + RegisterProperty('SelLength', 'Integer', iptrw); + RegisterProperty('SelTabBlock', 'Boolean', iptr); + RegisterProperty('SelTabLine', 'Boolean', iptr); + RegisterProperty('SelText', 'UnicodeString', iptrw); + RegisterProperty('StateFlags', 'TSynStateFlags', iptr); + RegisterProperty('Text', 'UnicodeString', iptrw); + RegisterProperty('TopLine', 'Integer', iptrw); + RegisterProperty('WordAtCursor', 'UnicodeString', iptr); + RegisterProperty('WordAtMouse', 'UnicodeString', iptr); + RegisterProperty('UndoList', 'TSynEditUndoList', iptr); + RegisterProperty('RedoList', 'TSynEditUndoList', iptr); + RegisterProperty('OnProcessCommand', 'TProcessCommandEvent', iptrw); + RegisterProperty('CodeFolding', 'TSynCodeFolding', iptrw); + RegisterProperty('UseCodeFolding', 'Boolean', iptrw); + RegisterProperty('AllFoldRanges', 'TSynFoldRanges', iptr); + RegisterProperty('BookMarkOptions', 'TSynBookMarkOpt', iptrw); + RegisterProperty('BorderStyle', 'TSynBorderStyle', iptrw); + RegisterProperty('ExtraLineSpacing', 'Integer', iptrw); + RegisterProperty('Gutter', 'TSynGutter', iptrw); + RegisterProperty('HideSelection', 'Boolean', iptrw); + RegisterProperty('InsertCaret', 'TSynEditCaretType', iptrw); + RegisterProperty('InsertMode', 'Boolean', iptrw); + RegisterProperty('IsScrolling', 'Boolean', iptr); + RegisterProperty('Keystrokes', 'TSynEditKeyStrokes', iptrw); + RegisterProperty('MaxUndo', 'Integer', iptrw); + RegisterProperty('Options', 'TSynEditorOptions', iptrw); + RegisterProperty('OverwriteCaret', 'TSynEditCaretType', iptrw); + RegisterProperty('RightEdge', 'Integer', iptrw); + RegisterProperty('RightEdgeColor', 'TColor', iptrw); + RegisterProperty('ScrollHintColor', 'TColor', iptrw); + RegisterProperty('ScrollHintFormat', 'TScrollHintFormat', iptrw); + RegisterProperty('ScrollBars', 'TScrollStyle', iptrw); + RegisterProperty('SelectedColor', 'TSynSelectedColor', iptrw); + RegisterProperty('SelectionMode', 'TSynSelectionMode', iptrw); + RegisterProperty('ActiveSelectionMode', 'TSynSelectionMode', iptrw); + RegisterProperty('TabWidth', 'Integer', iptrw); + RegisterProperty('WantReturns', 'Boolean', iptrw); + RegisterProperty('WantTabs', 'Boolean', iptrw); + RegisterProperty('WordWrap', 'Boolean', iptrw); + RegisterProperty('WordWrapGlyph', 'TSynGlyph', iptrw); + RegisterProperty('OnChange', 'TNotifyEvent', iptrw); + RegisterProperty('OnClearBookmark', 'TPlaceMarkEvent', iptrw); + RegisterProperty('OnCommandProcessed', 'TProcessCommandEvent', iptrw); + RegisterProperty('OnContextHelp', 'TContextHelpEvent', iptrw); +// RegisterProperty('OnDropFiles', 'TDropFilesEvent', iptrw); // MS + RegisterProperty('OnGutterClick', 'TGutterClickEvent', iptrw); + RegisterProperty('OnGutterGetText', 'TGutterGetTextEvent', iptrw); + RegisterProperty('OnGutterPaint', 'TGutterPaintEvent', iptrw); + RegisterProperty('OnMouseCursor', 'TMouseCursorEvent', iptrw); + RegisterProperty('OnKeyPress', 'TKeyPressWEvent', iptrw); + RegisterProperty('OnPaint', 'TPaintEvent', iptrw); + RegisterProperty('OnPlaceBookmark', 'TPlaceMarkEvent', iptrw); + RegisterProperty('OnProcessUserCommand', 'TProcessCommandEvent', iptrw); + RegisterProperty('OnReplaceText', 'TReplaceTextEvent', iptrw); + RegisterProperty('OnSpecialLineColors', 'TSpecialLineColorsEvent', iptrw); + RegisterProperty('OnSpecialTokenAttributes', 'TSpecialTokenAttributesEvent', iptrw); + RegisterProperty('OnStatusChange', 'TStatusChangeEvent', iptrw); + RegisterProperty('OnPaintTransient', 'TPaintTransient', iptrw); + RegisterProperty('OnScroll', 'TScrollEvent', iptrw); + RegisterProperty('OnTokenHint', 'TGetTokenHintEvent', iptrw); + {$IF CompilerVersion >= 23} + RegisterProperty('OnScanForFoldRanges', 'TScanForFoldRangesEvent', iptrw); + {$IFEND} + RegisterProperty('OnSearchNotFound', 'TCustomSynEditSearchNotFoundEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TSynEditPlugin(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TObject', 'TSynEditPlugin') do + with CL.AddClassN(CL.FindClass('TObject'),'TSynEditPlugin') do + begin + RegisterMethod('Constructor Create( AOwner : TCustomSynEdit)'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TSynEditMarkList(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TObjectList', 'TSynEditMarkList') do + with CL.AddClassN(CL.FindClass('TObjectList'),'TSynEditMarkList') do + begin + RegisterMethod('Constructor Create( AOwner : TCustomSynEdit)'); + RegisterMethod('Function First : TSynEditMark'); + RegisterMethod('Function Last : TSynEditMark'); + RegisterMethod('Function Extract( Item : TSynEditMark) : TSynEditMark'); + RegisterMethod('Procedure ClearLine( line : Integer)'); + RegisterMethod('Procedure GetMarksForLine( line : Integer; var Marks : TSynEditMarks)'); + RegisterMethod('Procedure Place( mark : TSynEditMark)'); + RegisterProperty('Items', 'TSynEditMark Integer', iptrw); + SetDefaultPropery('Items'); + RegisterProperty('Edit', 'TCustomSynEdit', iptr); + RegisterProperty('OnChange', 'TNotifyEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TSynEditMark(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TOBJECT', 'TSynEditMark') do + with CL.AddClassN(CL.FindClass('TOBJECT'),'TSynEditMark') do + begin + RegisterMethod('Constructor Create( AOwner : TCustomSynEdit)'); + RegisterProperty('Line', 'Integer', iptrw); + RegisterProperty('Char', 'Integer', iptrw); + RegisterProperty('Edit', 'TCustomSynEdit', iptr); + RegisterProperty('ImageIndex', 'Integer', iptrw); + RegisterProperty('BookmarkNumber', 'Integer', iptrw); + RegisterProperty('Visible', 'Boolean', iptrw); + RegisterProperty('InternalImage', 'Boolean', iptrw); + RegisterProperty('IsBookmark', 'Boolean', iptr); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_SynEdit(CL: TPSPascalCompiler); // MS +begin + CL.AddConstantN('WM_MOUSEWHEEL','LongWord').SetUInt( $020A); + CL.AddConstantN('MAX_SCROLL','LongInt').SetInt( 32767); + CL.AddConstantN('MAX_MARKS','LongInt').SetInt( 16); + CL.AddConstantN('SYNEDIT_CLIPBOARD_FORMAT','String').SetString( 'SynEdit Control Block Type'); + CL.AddTypeS('TSynBorderStyle', 'TBorderStyle'); + CL.AddTypeS('TSynReplaceAction', '( raCancel, raSkip, raReplace, raReplaceAll' + +' )'); + CL.AddClassN(CL.FindClass('TOBJECT'),'ESynEditError'); +// CL.AddTypeS('TDropFilesEvent', 'Procedure ( Sender : TObject; X, Y : Integer;' +// +' AFiles : TUnicodeStrings)'); +// CL.AddTypeS('THookedCommandEvent', 'Procedure ( Sender : TObject; AfterProces' +// +'sing : Boolean; var Handled : Boolean; var Command : TSynEditorCommand; va' +// +'r AChar : WideChar; Data, HandlerData : Pointer)'); + CL.AddTypeS('TPaintEvent', 'Procedure ( Sender : TObject; ACanvas : TCanvas)'); +// CL.AddTypeS('TProcessCommandEvent', 'Procedure ( Sender : TObject; var Comman' +// +'d : TSynEditorCommand; var AChar : WideChar; Data : Pointer)'); + CL.AddTypeS('TReplaceTextEvent', 'Procedure ( Sender : TObject; const ASearch' + +', AReplace : UnicodeString; Line, Column : Integer; var Action : TSynRepla' + +'ceAction)'); + CL.AddTypeS('TSpecialLineColorsEvent', 'Procedure ( Sender : TObject; Line : ' + +'Integer; var Special : Boolean; var FG, BG : TColor)'); + CL.AddTypeS('TSpecialTokenAttributesEvent', 'Procedure ( Sender : TObject; AL' + +'ine, APos : Integer; const AToken : string; var ASpecial : Boolean; var FG' + +', BG : TColor; var AStyle : TFontStyles)'); + CL.AddTypeS('TTransientType', '( ttBefore, ttAfter )'); + CL.AddTypeS('TPaintTransient', 'Procedure ( Sender : TObject; Canvas : TCanva' + +'s; TransientType : TTransientType)'); + CL.AddTypeS('TScrollEvent', 'Procedure ( Sender : TObject; ScrollBar : TScrol' + +'lBarKind)'); + CL.AddTypeS('TGutterGetTextEvent', 'Procedure ( Sender : TObject; aLine : Int' + +'eger; var aText : UnicodeString)'); + CL.AddTypeS('TGutterPaintEvent', 'Procedure ( Sender : TObject; aLine : Integ' + +'er; X, Y : Integer)'); + CL.AddTypeS('TSynEditCaretType', '( ctVerticalLine, ctHorizontalLine, ctHalfB' + +'lock, ctBlock, ctVerticalLine2 )'); + CL.AddTypeS('TSynStateFlag', '( sfCaretChanged, sfScrollbarChanged, sfLinesCh' + +'anging, sfIgnoreNextChar, sfCaretVisible, sfDblClicked, sfPossibleGutterCl' + +'ick, sfWaitForDragging, sfInsideRedo, sfGutterDragging, sfMouseCaptured )'); + CL.AddTypeS('TSynStateFlags', 'set of TSynStateFlag'); + CL.AddTypeS('TScrollHintFormat', '( shfTopLineOnly, shfTopToBottom )'); + CL.AddTypeS('TSynHintMode', '( shmDefault, shmToken )'); +// CL.AddTypeS('TGetTokenHintEvent', 'Procedure ( Sender : TObject; Coords : TBu' +// +'fferCoord; const Token : string; TokenType : Integer; Attri : TSynHighligh' +// +'terAttributes; var HintText : string)'); + CL.AddTypeS('TSynEditorOption', '( eoAltSetsColumnMode, eoAutoIndent, eoAutoS' + +'izeMaxScrollWidth, eoDisableScrollArrows, eoDragDropEditing, eoDropFiles, ' + +'eoEnhanceHomeKey, eoEnhanceEndKey, eoGroupUndo, eoHalfPageScroll, eoHideSh' + +'owScrollbars, eoKeepCaretX, eoNoCaret, eoNoSelection, eoRightMouseMovesCur' + +'sor, eoScrollByOneLess, eoScrollHintFollows, eoScrollPastEof, eoScrollPast' + +'Eol, eoShowScrollHint, eoShowSpecialChars, eoSmartTabDelete, eoSmartTabs, ' + +'eoSpecialLineDefaultFg, eoTabIndent, eoTabsToSpaces, eoTrimTrailingSpaces ' + +')'); + CL.AddTypeS('TSynEditorOptions', 'set of TSynEditorOption'); + CL.AddTypeS('TSynFontSmoothMethod', '( fsmNone, fsmAntiAlias, fsmClearType )'); + CL.AddConstantN('SYNEDIT_DEFAULT_OPTIONS','LongInt').Value.ts32 := ord(eoAutoIndent) or ord(eoDragDropEditing) or ord(eoEnhanceEndKey) or ord(eoScrollPastEol) or ord(eoShowScrollHint) or ord(eoSmartTabs) or ord(eoTabsToSpaces) or ord(eoSmartTabDelete) or ord(eoGroupUndo); + CL.AddTypeS('TSynStatusChange', '( scAll, scCaretX, scCaretY, scLeftChar, scT' + +'opLine, scInsertMode, scModified, scSelection, scReadOnly )'); + CL.AddTypeS('TSynStatusChanges', 'set of TSynStatusChange'); + CL.AddTypeS('TContextHelpEvent', 'Procedure ( Sender : TObject; Word : Unicod' + +'eString)'); + CL.AddTypeS('TStatusChangeEvent', 'Procedure ( Sender : TObject; Changes : TS' + +'ynStatusChanges)'); +// CL.AddTypeS('TMouseCursorEvent', 'Procedure ( Sender : TObject; const aLineCh' +// +'arPos : TBufferCoord; var aCursor : TCursor)'); +// CL.AddTypeS('TScanForFoldRangesEvent', 'Procedure ( Sender : TObject; FoldRan' +// +'ges : TSynFoldRanges; LinesToScan : TStrings; FromLine : Integer; ToLine :' +// +' Integer)'); + CL.AddClassN(CL.FindClass('TOBJECT'),'TCustomSynEdit'); + SIRegister_TSynEditMark(CL); + CL.AddTypeS('TPlaceMarkEvent', 'Procedure ( Sender : TObject; var Mark : TSyn' + +'EditMark)'); + SIRegister_TSynEditMarkList(CL); + CL.AddTypeS('TGutterClickEvent', 'Procedure ( Sender : TObject; Button : TMou' + +'seButton; X, Y, Line : Integer; Mark : TSynEditMark)'); + SIRegister_TSynEditPlugin(CL); + CL.AddTypeS('TCustomSynEditSearchNotFoundEvent', 'Procedure ( Sender : TObjec' + +'t; FindText : UnicodeString)'); + SIRegister_TCustomSynEdit(CL); + SIRegister_TSynEdit(CL); +end; + +(* === run-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSearchNotFound_W(Self: TCustomSynEdit; const T: TCustomSynEditSearchNotFoundEvent); +begin Self.OnSearchNotFound := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSearchNotFound_R(Self: TCustomSynEdit; var T: TCustomSynEditSearchNotFoundEvent); +begin T := Self.OnSearchNotFound; end; + +(*----------------------------------------------------------------------------*) +{$IF CompilerVersion >= 23} +procedure TCustomSynEditOnScanForFoldRanges_W(Self: TCustomSynEdit; const T: TScanForFoldRangesEvent); +begin Self.OnScanForFoldRanges := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnScanForFoldRanges_R(Self: TCustomSynEdit; var T: TScanForFoldRangesEvent); +begin T := Self.OnScanForFoldRanges; end; +{$IFEND} + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnTokenHint_W(Self: TCustomSynEdit; const T: TGetTokenHintEvent); +begin Self.OnTokenHint := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnTokenHint_R(Self: TCustomSynEdit; var T: TGetTokenHintEvent); +begin T := Self.OnTokenHint; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnScroll_W(Self: TCustomSynEdit; const T: TScrollEvent); +begin Self.OnScroll := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnScroll_R(Self: TCustomSynEdit; var T: TScrollEvent); +begin T := Self.OnScroll; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPaintTransient_W(Self: TCustomSynEdit; const T: TPaintTransient); +begin Self.OnPaintTransient := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPaintTransient_R(Self: TCustomSynEdit; var T: TPaintTransient); +begin T := Self.OnPaintTransient; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnStatusChange_W(Self: TCustomSynEdit; const T: TStatusChangeEvent); +begin Self.OnStatusChange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnStatusChange_R(Self: TCustomSynEdit; var T: TStatusChangeEvent); +begin T := Self.OnStatusChange; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSpecialTokenAttributes_W(Self: TCustomSynEdit; const T: TSpecialTokenAttributesEvent); +begin Self.OnSpecialTokenAttributes := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSpecialTokenAttributes_R(Self: TCustomSynEdit; var T: TSpecialTokenAttributesEvent); +begin T := Self.OnSpecialTokenAttributes; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSpecialLineColors_W(Self: TCustomSynEdit; const T: TSpecialLineColorsEvent); +begin Self.OnSpecialLineColors := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSpecialLineColors_R(Self: TCustomSynEdit; var T: TSpecialLineColorsEvent); +begin T := Self.OnSpecialLineColors; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnReplaceText_W(Self: TCustomSynEdit; const T: TReplaceTextEvent); +begin Self.OnReplaceText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnReplaceText_R(Self: TCustomSynEdit; var T: TReplaceTextEvent); +begin T := Self.OnReplaceText; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnProcessUserCommand_W(Self: TCustomSynEdit; const T: TProcessCommandEvent); +begin Self.OnProcessUserCommand := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnProcessUserCommand_R(Self: TCustomSynEdit; var T: TProcessCommandEvent); +begin T := Self.OnProcessUserCommand; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPlaceBookmark_W(Self: TCustomSynEdit; const T: TPlaceMarkEvent); +begin Self.OnPlaceBookmark := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPlaceBookmark_R(Self: TCustomSynEdit; var T: TPlaceMarkEvent); +begin T := Self.OnPlaceBookmark; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPaint_W(Self: TCustomSynEdit; const T: TPaintEvent); +begin Self.OnPaint := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPaint_R(Self: TCustomSynEdit; var T: TPaintEvent); +begin T := Self.OnPaint; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnKeyPress_W(Self: TCustomSynEdit; const T: TKeyPressWEvent); +begin Self.OnKeyPress := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnKeyPress_R(Self: TCustomSynEdit; var T: TKeyPressWEvent); +begin T := Self.OnKeyPress; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnMouseCursor_W(Self: TCustomSynEdit; const T: TMouseCursorEvent); +begin Self.OnMouseCursor := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnMouseCursor_R(Self: TCustomSynEdit; var T: TMouseCursorEvent); +begin T := Self.OnMouseCursor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterPaint_W(Self: TCustomSynEdit; const T: TGutterPaintEvent); +begin Self.OnGutterPaint := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterPaint_R(Self: TCustomSynEdit; var T: TGutterPaintEvent); +begin T := Self.OnGutterPaint; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterGetText_W(Self: TCustomSynEdit; const T: TGutterGetTextEvent); +begin Self.OnGutterGetText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterGetText_R(Self: TCustomSynEdit; var T: TGutterGetTextEvent); +begin T := Self.OnGutterGetText; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterClick_W(Self: TCustomSynEdit; const T: TGutterClickEvent); +begin Self.OnGutterClick := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterClick_R(Self: TCustomSynEdit; var T: TGutterClickEvent); +begin T := Self.OnGutterClick; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnDropFiles_W(Self: TCustomSynEdit; const T: TDropFilesEvent); +begin Self.OnDropFiles := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnDropFiles_R(Self: TCustomSynEdit; var T: TDropFilesEvent); +begin T := Self.OnDropFiles; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnContextHelp_W(Self: TCustomSynEdit; const T: TContextHelpEvent); +begin Self.OnContextHelp := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnContextHelp_R(Self: TCustomSynEdit; var T: TContextHelpEvent); +begin T := Self.OnContextHelp; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnCommandProcessed_W(Self: TCustomSynEdit; const T: TProcessCommandEvent); +begin Self.OnCommandProcessed := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnCommandProcessed_R(Self: TCustomSynEdit; var T: TProcessCommandEvent); +begin T := Self.OnCommandProcessed; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnClearBookmark_W(Self: TCustomSynEdit; const T: TPlaceMarkEvent); +begin Self.OnClearBookmark := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnClearBookmark_R(Self: TCustomSynEdit; var T: TPlaceMarkEvent); +begin T := Self.OnClearBookmark; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnChange_W(Self: TCustomSynEdit; const T: TNotifyEvent); +begin Self.OnChange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnChange_R(Self: TCustomSynEdit; var T: TNotifyEvent); +begin T := Self.OnChange; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordWrapGlyph_W(Self: TCustomSynEdit; const T: TSynGlyph); +begin Self.WordWrapGlyph := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordWrapGlyph_R(Self: TCustomSynEdit; var T: TSynGlyph); +begin T := Self.WordWrapGlyph; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordWrap_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.WordWrap := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordWrap_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.WordWrap; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWantTabs_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.WantTabs := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWantTabs_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.WantTabs; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWantReturns_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.WantReturns := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWantReturns_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.WantReturns; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditTabWidth_W(Self: TCustomSynEdit; const T: Integer); +begin Self.TabWidth := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditTabWidth_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.TabWidth; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditActiveSelectionMode_W(Self: TCustomSynEdit; const T: TSynSelectionMode); +begin Self.ActiveSelectionMode := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditActiveSelectionMode_R(Self: TCustomSynEdit; var T: TSynSelectionMode); +begin T := Self.ActiveSelectionMode; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelectionMode_W(Self: TCustomSynEdit; const T: TSynSelectionMode); +begin Self.SelectionMode := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelectionMode_R(Self: TCustomSynEdit; var T: TSynSelectionMode); +begin T := Self.SelectionMode; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelectedColor_W(Self: TCustomSynEdit; const T: TSynSelectedColor); +begin Self.SelectedColor := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelectedColor_R(Self: TCustomSynEdit; var T: TSynSelectedColor); +begin T := Self.SelectedColor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollBars_W(Self: TCustomSynEdit; const T: TScrollStyle); +begin Self.ScrollBars := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollBars_R(Self: TCustomSynEdit; var T: TScrollStyle); +begin T := Self.ScrollBars; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollHintFormat_W(Self: TCustomSynEdit; const T: TScrollHintFormat); +begin Self.ScrollHintFormat := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollHintFormat_R(Self: TCustomSynEdit; var T: TScrollHintFormat); +begin T := Self.ScrollHintFormat; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollHintColor_W(Self: TCustomSynEdit; const T: TColor); +begin Self.ScrollHintColor := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollHintColor_R(Self: TCustomSynEdit; var T: TColor); +begin T := Self.ScrollHintColor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditRightEdgeColor_W(Self: TCustomSynEdit; const T: TColor); +begin Self.RightEdgeColor := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditRightEdgeColor_R(Self: TCustomSynEdit; var T: TColor); +begin T := Self.RightEdgeColor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditRightEdge_W(Self: TCustomSynEdit; const T: Integer); +begin Self.RightEdge := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditRightEdge_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.RightEdge; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOverwriteCaret_W(Self: TCustomSynEdit; const T: TSynEditCaretType); +begin Self.OverwriteCaret := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOverwriteCaret_R(Self: TCustomSynEdit; var T: TSynEditCaretType); +begin T := Self.OverwriteCaret; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOptions_W(Self: TCustomSynEdit; const T: TSynEditorOptions); +begin Self.Options := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOptions_R(Self: TCustomSynEdit; var T: TSynEditorOptions); +begin T := Self.Options; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditMaxUndo_W(Self: TCustomSynEdit; const T: Integer); +begin Self.MaxUndo := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditMaxUndo_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.MaxUndo; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditKeystrokes_W(Self: TCustomSynEdit; const T: TSynEditKeyStrokes); +begin Self.Keystrokes := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditKeystrokes_R(Self: TCustomSynEdit; var T: TSynEditKeyStrokes); +begin T := Self.Keystrokes; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditIsScrolling_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.IsScrolling; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditInsertMode_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.InsertMode := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditInsertMode_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.InsertMode; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditInsertCaret_W(Self: TCustomSynEdit; const T: TSynEditCaretType); +begin Self.InsertCaret := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditInsertCaret_R(Self: TCustomSynEdit; var T: TSynEditCaretType); +begin T := Self.InsertCaret; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHideSelection_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.HideSelection := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHideSelection_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.HideSelection; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditGutter_W(Self: TCustomSynEdit; const T: TSynGutter); +begin Self.Gutter := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditGutter_R(Self: TCustomSynEdit; var T: TSynGutter); +begin T := Self.Gutter; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditExtraLineSpacing_W(Self: TCustomSynEdit; const T: Integer); +begin Self.ExtraLineSpacing := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditExtraLineSpacing_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.ExtraLineSpacing; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBorderStyle_W(Self: TCustomSynEdit; const T: TSynBorderStyle); +begin Self.BorderStyle := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBorderStyle_R(Self: TCustomSynEdit; var T: TSynBorderStyle); +begin T := Self.BorderStyle; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBookMarkOptions_W(Self: TCustomSynEdit; const T: TSynBookMarkOpt); +begin Self.BookMarkOptions := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBookMarkOptions_R(Self: TCustomSynEdit; var T: TSynBookMarkOpt); +begin T := Self.BookMarkOptions; end; + +(*----------------------------------------------------------------------------*) +{$IF CompilerVersion >= 23} +procedure TCustomSynEditAllFoldRanges_R(Self: TCustomSynEdit; var T: TSynFoldRanges); +begin T := Self.AllFoldRanges; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditUseCodeFolding_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.UseCodeFolding := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditUseCodeFolding_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.UseCodeFolding; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCodeFolding_W(Self: TCustomSynEdit; const T: TSynCodeFolding); +begin Self.CodeFolding := T; end; + + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCodeFolding_R(Self: TCustomSynEdit; var T: TSynCodeFolding); +begin T := Self.CodeFolding; end; +{$IFEND} + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnProcessCommand_W(Self: TCustomSynEdit; const T: TProcessCommandEvent); +begin Self.OnProcessCommand := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnProcessCommand_R(Self: TCustomSynEdit; var T: TProcessCommandEvent); +begin T := Self.OnProcessCommand; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditRedoList_R(Self: TCustomSynEdit; var T: TSynEditUndoList); +begin T := Self.RedoList; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditUndoList_R(Self: TCustomSynEdit; var T: TSynEditUndoList); +begin T := Self.UndoList; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordAtMouse_R(Self: TCustomSynEdit; var T: UnicodeString); +begin T := Self.WordAtMouse; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordAtCursor_R(Self: TCustomSynEdit; var T: UnicodeString); +begin T := Self.WordAtCursor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditTopLine_W(Self: TCustomSynEdit; const T: Integer); +begin Self.TopLine := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditTopLine_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.TopLine; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditText_W(Self: TCustomSynEdit; const T: UnicodeString); +begin Self.Text := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditText_R(Self: TCustomSynEdit; var T: UnicodeString); +begin T := Self.Text; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditStateFlags_R(Self: TCustomSynEdit; var T: TSynStateFlags); +begin T := Self.StateFlags; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelText_W(Self: TCustomSynEdit; const T: UnicodeString); +begin Self.SelText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelText_R(Self: TCustomSynEdit; var T: UnicodeString); +begin T := Self.SelText; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelTabLine_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.SelTabLine; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelTabBlock_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.SelTabBlock; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelLength_W(Self: TCustomSynEdit; const T: Integer); +begin Self.SelLength := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelLength_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.SelLength; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelAvail_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.SelAvail; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSearchEngine_W(Self: TCustomSynEdit; const T: TSynEditSearchCustom); +begin Self.SearchEngine := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSearchEngine_R(Self: TCustomSynEdit; var T: TSynEditSearchCustom); +begin T := Self.SearchEngine; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditReadOnly_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.ReadOnly := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditReadOnly_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.ReadOnly; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditPaintLock_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.PaintLock; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditModified_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.Modified := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditModified_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.Modified; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditMaxScrollWidth_W(Self: TCustomSynEdit; const T: Integer); +begin Self.MaxScrollWidth := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditMaxScrollWidth_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.MaxScrollWidth; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditMarks_R(Self: TCustomSynEdit; var T: TSynEditMarkList); +begin T := Self.Marks; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLines_W(Self: TCustomSynEdit; const T: TUnicodeStrings); +begin Self.Lines := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLines_R(Self: TCustomSynEdit; var T: TUnicodeStrings); +begin T := Self.Lines; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLineText_W(Self: TCustomSynEdit; const T: UnicodeString); +begin Self.LineText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLineText_R(Self: TCustomSynEdit; var T: UnicodeString); +begin T := Self.LineText; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLinesInWindow_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.LinesInWindow; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLineHeight_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.LineHeight; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLeftChar_W(Self: TCustomSynEdit; const T: Integer); +begin Self.LeftChar := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLeftChar_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.LeftChar; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHintMode_W(Self: TCustomSynEdit; const T: TSynHintMode); +begin Self.HintMode := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHintMode_R(Self: TCustomSynEdit; var T: TSynHintMode); +begin T := Self.HintMode; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHighlighter_W(Self: TCustomSynEdit; const T: TSynCustomHighlighter); +begin Self.Highlighter := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHighlighter_R(Self: TCustomSynEdit; var T: TSynCustomHighlighter); +begin T := Self.Highlighter; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditFont_W(Self: TCustomSynEdit; const T: TFont); +begin Self.Font := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditFont_R(Self: TCustomSynEdit; var T: TFont); +begin T := Self.Font; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCharWidth_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.CharWidth; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCharsInWindow_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.CharsInWindow; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditDisplayLineCount_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.DisplayLineCount; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditDisplayXY_R(Self: TCustomSynEdit; var T: TDisplayCoord); +begin T := Self.DisplayXY; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditDisplayY_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.DisplayY; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditDisplayX_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.DisplayX; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditActiveLineColor_W(Self: TCustomSynEdit; const T: TColor); +begin Self.ActiveLineColor := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditActiveLineColor_R(Self: TCustomSynEdit; var T: TColor); +begin T := Self.ActiveLineColor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretXY_W(Self: TCustomSynEdit; const T: TBufferCoord); +begin Self.CaretXY := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretXY_R(Self: TCustomSynEdit; var T: TBufferCoord); +begin T := Self.CaretXY; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretY_W(Self: TCustomSynEdit; const T: Integer); +begin Self.CaretY := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretY_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.CaretY; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretX_W(Self: TCustomSynEdit; const T: Integer); +begin Self.CaretX := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretX_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.CaretX; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCanUndo_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.CanUndo; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCanRedo_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.CanRedo; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCanPaste_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.CanPaste; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBlockEnd_W(Self: TCustomSynEdit; const T: TBufferCoord); +begin Self.BlockEnd := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBlockEnd_R(Self: TCustomSynEdit; var T: TBufferCoord); +begin T := Self.BlockEnd; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBlockBegin_W(Self: TCustomSynEdit; const T: TBufferCoord); +begin Self.BlockBegin := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBlockBegin_R(Self: TCustomSynEdit; var T: TBufferCoord); +begin T := Self.BlockBegin; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAdditionalWordBreakChars_W(Self: TCustomSynEdit; const T: TSysCharSet); +begin Self.AdditionalWordBreakChars := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAdditionalWordBreakChars_R(Self: TCustomSynEdit; var T: TSysCharSet); +begin T := Self.AdditionalWordBreakChars; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAdditionalIdentChars_W(Self: TCustomSynEdit; const T: TSysCharSet); +begin Self.AdditionalIdentChars := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAdditionalIdentChars_R(Self: TCustomSynEdit; var T: TSysCharSet); +begin T := Self.AdditionalIdentChars; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAlwaysShowCaret_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.AlwaysShowCaret := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAlwaysShowCaret_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.AlwaysShowCaret; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelEnd_W(Self: TCustomSynEdit; const T: Integer); +begin Self.SelEnd := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelEnd_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.SelEnd; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelStart_W(Self: TCustomSynEdit; const T: Integer); +begin Self.SelStart := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelStart_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.SelStart; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkListOnChange_W(Self: TSynEditMarkList; const T: TNotifyEvent); +begin Self.OnChange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkListOnChange_R(Self: TSynEditMarkList; var T: TNotifyEvent); +begin T := Self.OnChange; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkListEdit_R(Self: TSynEditMarkList; var T: TCustomSynEdit); +begin T := Self.Edit; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkListItems_W(Self: TSynEditMarkList; const T: TSynEditMark; const t1: Integer); +begin Self.Items[t1] := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkListItems_R(Self: TSynEditMarkList; var T: TSynEditMark; const t1: Integer); +begin T := Self.Items[t1]; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkIsBookmark_R(Self: TSynEditMark; var T: Boolean); +begin T := Self.IsBookmark; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkInternalImage_W(Self: TSynEditMark; const T: Boolean); +begin Self.InternalImage := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkInternalImage_R(Self: TSynEditMark; var T: Boolean); +begin T := Self.InternalImage; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkVisible_W(Self: TSynEditMark; const T: Boolean); +begin Self.Visible := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkVisible_R(Self: TSynEditMark; var T: Boolean); +begin T := Self.Visible; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkBookmarkNumber_W(Self: TSynEditMark; const T: Integer); +begin Self.BookmarkNumber := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkBookmarkNumber_R(Self: TSynEditMark; var T: Integer); +begin T := Self.BookmarkNumber; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkImageIndex_W(Self: TSynEditMark; const T: Integer); +begin Self.ImageIndex := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkImageIndex_R(Self: TSynEditMark; var T: Integer); +begin T := Self.ImageIndex; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkEdit_R(Self: TSynEditMark; var T: TCustomSynEdit); +begin T := Self.Edit; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkChar_W(Self: TSynEditMark; const T: Integer); +begin Self.Char := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkChar_R(Self: TSynEditMark; var T: Integer); +begin T := Self.Char; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkLine_W(Self: TSynEditMark; const T: Integer); +begin Self.Line := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkLine_R(Self: TSynEditMark; var T: Integer); +begin T := Self.Line; end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TSynEdit(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TSynEdit) do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TCustomSynEdit(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TCustomSynEdit) do + begin + RegisterPropertyHelper(@TCustomSynEditSelStart_R,@TCustomSynEditSelStart_W,'SelStart'); + RegisterPropertyHelper(@TCustomSynEditSelEnd_R,@TCustomSynEditSelEnd_W,'SelEnd'); + RegisterPropertyHelper(@TCustomSynEditAlwaysShowCaret_R,@TCustomSynEditAlwaysShowCaret_W,'AlwaysShowCaret'); + RegisterMethod(@TCustomSynEdit.UpdateCaret, 'UpdateCaret'); + RegisterMethod(@TCustomSynEdit.AddKey, 'AddKey'); + RegisterMethod(@TCustomSynEdit.AddKey, 'AddKey'); + RegisterMethod(@TCustomSynEdit.BeginUndoBlock, 'BeginUndoBlock'); + RegisterMethod(@TCustomSynEdit.BeginUpdate, 'BeginUpdate'); + RegisterMethod(@TCustomSynEdit.CaretInView, 'CaretInView'); + RegisterMethod(@TCustomSynEdit.CharIndexToRowCol, 'CharIndexToRowCol'); + RegisterMethod(@TCustomSynEdit.Clear, 'Clear'); + RegisterMethod(@TCustomSynEdit.ClearAll, 'ClearAll'); + RegisterMethod(@TCustomSynEdit.ClearBookMark, 'ClearBookMark'); + RegisterMethod(@TCustomSynEdit.ClearSelection, 'ClearSelection'); + RegisterVirtualMethod(@TCustomSynEdit.CommandProcessor, 'CommandProcessor'); + RegisterMethod(@TCustomSynEdit.ClearUndo, 'ClearUndo'); + RegisterMethod(@TCustomSynEdit.CopyToClipboard, 'CopyToClipboard'); + RegisterMethod(@TCustomSynEdit.CutToClipboard, 'CutToClipboard'); + RegisterMethod(@TCustomSynEdit.DoCopyToClipboard, 'DoCopyToClipboard'); + RegisterMethod(@TCustomSynEdit.EndUndoBlock, 'EndUndoBlock'); + RegisterMethod(@TCustomSynEdit.EndUpdate, 'EndUpdate'); + RegisterMethod(@TCustomSynEdit.EnsureCursorPosVisible, 'EnsureCursorPosVisible'); + RegisterMethod(@TCustomSynEdit.EnsureCursorPosVisibleEx, 'EnsureCursorPosVisibleEx'); + RegisterVirtualMethod(@TCustomSynEdit.FindMatchingBracket, 'FindMatchingBracket'); + RegisterVirtualMethod(@TCustomSynEdit.GetMatchingBracket, 'GetMatchingBracket'); + RegisterVirtualMethod(@TCustomSynEdit.GetMatchingBracketEx, 'GetMatchingBracketEx'); + RegisterVirtualMethod(@TCustomSynEdit.ExecuteCommand, 'ExecuteCommand'); + RegisterMethod(@TCustomSynEdit.ExpandAtWideGlyphs, 'ExpandAtWideGlyphs'); + RegisterMethod(@TCustomSynEdit.GetBookMark, 'GetBookMark'); + RegisterMethod(@TCustomSynEdit.GetHighlighterAttriAtRowCol, 'GetHighlighterAttriAtRowCol'); + RegisterMethod(@TCustomSynEdit.GetHighlighterAttriAtRowColEx, 'GetHighlighterAttriAtRowColEx'); + RegisterMethod(@TCustomSynEdit.GetPositionOfMouse, 'GetPositionOfMouse'); + RegisterMethod(@TCustomSynEdit.GetWordAtRowCol, 'GetWordAtRowCol'); + RegisterVirtualMethod(@TCustomSynEdit.GotoBookMark, 'GotoBookMark'); + RegisterVirtualMethod(@TCustomSynEdit.GotoLineAndCenter, 'GotoLineAndCenter'); + RegisterVirtualMethod(@TCustomSynEdit.IsIdentChar, 'IsIdentChar'); + RegisterVirtualMethod(@TCustomSynEdit.IsWhiteChar, 'IsWhiteChar'); + RegisterVirtualMethod(@TCustomSynEdit.IsWordBreakChar, 'IsWordBreakChar'); + RegisterMethod(@TCustomSynEdit.InsertBlock, 'InsertBlock'); + RegisterMethod(@TCustomSynEdit.InsertLine, 'InsertLine'); + RegisterMethod(@TCustomSynEdit.UnifiedSelection, 'UnifiedSelection'); + RegisterMethod(@TCustomSynEdit.DoBlockIndent, 'DoBlockIndent'); + RegisterMethod(@TCustomSynEdit.DoBlockUnindent, 'DoBlockUnindent'); + RegisterMethod(@TCustomSynEdit.InvalidateGutter, 'InvalidateGutter'); + RegisterMethod(@TCustomSynEdit.InvalidateGutterLine, 'InvalidateGutterLine'); + RegisterMethod(@TCustomSynEdit.InvalidateGutterLines, 'InvalidateGutterLines'); + RegisterMethod(@TCustomSynEdit.InvalidateLine, 'InvalidateLine'); + RegisterMethod(@TCustomSynEdit.InvalidateLines, 'InvalidateLines'); + RegisterMethod(@TCustomSynEdit.InvalidateSelection, 'InvalidateSelection'); + RegisterMethod(@TCustomSynEdit.MarkModifiedLinesAsSaved, 'MarkModifiedLinesAsSaved'); + RegisterMethod(@TCustomSynEdit.ResetModificationIndicator, 'ResetModificationIndicator'); + RegisterMethod(@TCustomSynEdit.IsBookmark, 'IsBookmark'); + RegisterMethod(@TCustomSynEdit.IsPointInSelection, 'IsPointInSelection'); + RegisterMethod(@TCustomSynEdit.LockUndo, 'LockUndo'); + RegisterMethod(@TCustomSynEdit.BufferToDisplayPos, 'BufferToDisplayPos'); + RegisterMethod(@TCustomSynEdit.DisplayToBufferPos, 'DisplayToBufferPos'); + RegisterMethod(@TCustomSynEdit.LineToRow, 'LineToRow'); + RegisterMethod(@TCustomSynEdit.RowToLine, 'RowToLine'); + RegisterMethod(@TCustomSynEdit.PasteFromClipboard, 'PasteFromClipboard'); + RegisterVirtualMethod(@TCustomSynEdit.NextWordPos, 'NextWordPos'); + RegisterVirtualMethod(@TCustomSynEdit.NextWordPosEx, 'NextWordPosEx'); + RegisterVirtualMethod(@TCustomSynEdit.WordStart, 'WordStart'); + RegisterVirtualMethod(@TCustomSynEdit.WordStartEx, 'WordStartEx'); + RegisterVirtualMethod(@TCustomSynEdit.WordEnd, 'WordEnd'); + RegisterVirtualMethod(@TCustomSynEdit.WordEndEx, 'WordEndEx'); + RegisterVirtualMethod(@TCustomSynEdit.PrevWordPos, 'PrevWordPos'); + RegisterVirtualMethod(@TCustomSynEdit.PrevWordPosEx, 'PrevWordPosEx'); + RegisterMethod(@TCustomSynEdit.PixelsToRowColumn, 'PixelsToRowColumn'); + RegisterMethod(@TCustomSynEdit.PixelsToNearestRowColumn, 'PixelsToNearestRowColumn'); + RegisterMethod(@TCustomSynEdit.Redo, 'Redo'); + RegisterMethod(@TCustomSynEdit.RegisterCommandHandler, 'RegisterCommandHandler'); + RegisterMethod(@TCustomSynEdit.RowColumnToPixels, 'RowColumnToPixels'); + RegisterMethod(@TCustomSynEdit.RowColToCharIndex, 'RowColToCharIndex'); + RegisterMethod(@TCustomSynEdit.SearchReplace, 'SearchReplace'); + RegisterMethod(@TCustomSynEdit.SelectAll, 'SelectAll'); + RegisterMethod(@TCustomSynEdit.SetBookMark, 'SetBookMark'); + RegisterMethod(@TCustomSynEdit.SetCaretAndSelection, 'SetCaretAndSelection'); + RegisterVirtualMethod(@TCustomSynEdit.SetDefaultKeystrokes, 'SetDefaultKeystrokes'); + RegisterMethod(@TCustomSynEdit.SetSelWord, 'SetSelWord'); + RegisterMethod(@TCustomSynEdit.SetWordBlock, 'SetWordBlock'); + RegisterMethod(@TCustomSynEdit.Undo, 'Undo'); + RegisterMethod(@TCustomSynEdit.UnlockUndo, 'UnlockUndo'); + RegisterMethod(@TCustomSynEdit.UnregisterCommandHandler, 'UnregisterCommandHandler'); + RegisterMethod(@TCustomSynEdit.AddKeyUpHandler, 'AddKeyUpHandler'); + RegisterMethod(@TCustomSynEdit.RemoveKeyUpHandler, 'RemoveKeyUpHandler'); + RegisterMethod(@TCustomSynEdit.AddKeyDownHandler, 'AddKeyDownHandler'); + RegisterMethod(@TCustomSynEdit.RemoveKeyDownHandler, 'RemoveKeyDownHandler'); + RegisterMethod(@TCustomSynEdit.AddKeyPressHandler, 'AddKeyPressHandler'); + RegisterMethod(@TCustomSynEdit.RemoveKeyPressHandler, 'RemoveKeyPressHandler'); + RegisterMethod(@TCustomSynEdit.AddFocusControl, 'AddFocusControl'); + RegisterMethod(@TCustomSynEdit.RemoveFocusControl, 'RemoveFocusControl'); + RegisterMethod(@TCustomSynEdit.AddMouseDownHandler, 'AddMouseDownHandler'); + RegisterMethod(@TCustomSynEdit.RemoveMouseDownHandler, 'RemoveMouseDownHandler'); + RegisterMethod(@TCustomSynEdit.AddMouseUpHandler, 'AddMouseUpHandler'); + RegisterMethod(@TCustomSynEdit.RemoveMouseUpHandler, 'RemoveMouseUpHandler'); + RegisterMethod(@TCustomSynEdit.AddMouseCursorHandler, 'AddMouseCursorHandler'); + RegisterMethod(@TCustomSynEdit.RemoveMouseCursorHandler, 'RemoveMouseCursorHandler'); + RegisterMethod(@TCustomSynEdit.SetLinesPointer, 'SetLinesPointer'); + RegisterMethod(@TCustomSynEdit.RemoveLinesPointer, 'RemoveLinesPointer'); + RegisterMethod(@TCustomSynEdit.HookTextBuffer, 'HookTextBuffer'); + RegisterMethod(@TCustomSynEdit.UnHookTextBuffer, 'UnHookTextBuffer'); + {$IF CompilerVersion >= 23} + RegisterMethod(@TCustomSynEdit.CollapseAll, 'CollapseAll'); + RegisterMethod(@TCustomSynEdit.UncollapseAll, 'UncollapseAll'); + RegisterMethod(@TCustomSynEdit.Collapse, 'Collapse'); + RegisterMethod(@TCustomSynEdit.Uncollapse, 'Uncollapse'); + RegisterMethod(@TCustomSynEdit.UncollapseAroundLine, 'UncollapseAroundLine'); + RegisterMethod(@TCustomSynEdit.CollapseNearest, 'CollapseNearest'); + RegisterMethod(@TCustomSynEdit.UncollapseNearest, 'UncollapseNearest'); + RegisterMethod(@TCustomSynEdit.CollapseLevel, 'CollapseLevel'); + RegisterMethod(@TCustomSynEdit.UnCollapseLevel, 'UnCollapseLevel'); + RegisterMethod(@TCustomSynEdit.CollapseFoldType, 'CollapseFoldType'); + RegisterMethod(@TCustomSynEdit.UnCollapseFoldType, 'UnCollapseFoldType'); + {$IFEND} + RegisterPropertyHelper(@TCustomSynEditAdditionalIdentChars_R,@TCustomSynEditAdditionalIdentChars_W,'AdditionalIdentChars'); + RegisterPropertyHelper(@TCustomSynEditAdditionalWordBreakChars_R,@TCustomSynEditAdditionalWordBreakChars_W,'AdditionalWordBreakChars'); + RegisterPropertyHelper(@TCustomSynEditBlockBegin_R,@TCustomSynEditBlockBegin_W,'BlockBegin'); + RegisterPropertyHelper(@TCustomSynEditBlockEnd_R,@TCustomSynEditBlockEnd_W,'BlockEnd'); + RegisterPropertyHelper(@TCustomSynEditCanPaste_R,nil,'CanPaste'); + RegisterPropertyHelper(@TCustomSynEditCanRedo_R,nil,'CanRedo'); + RegisterPropertyHelper(@TCustomSynEditCanUndo_R,nil,'CanUndo'); + RegisterPropertyHelper(@TCustomSynEditCaretX_R,@TCustomSynEditCaretX_W,'CaretX'); + RegisterPropertyHelper(@TCustomSynEditCaretY_R,@TCustomSynEditCaretY_W,'CaretY'); + RegisterPropertyHelper(@TCustomSynEditCaretXY_R,@TCustomSynEditCaretXY_W,'CaretXY'); + RegisterPropertyHelper(@TCustomSynEditActiveLineColor_R,@TCustomSynEditActiveLineColor_W,'ActiveLineColor'); + RegisterPropertyHelper(@TCustomSynEditDisplayX_R,nil,'DisplayX'); + RegisterPropertyHelper(@TCustomSynEditDisplayY_R,nil,'DisplayY'); + RegisterPropertyHelper(@TCustomSynEditDisplayXY_R,nil,'DisplayXY'); + RegisterPropertyHelper(@TCustomSynEditDisplayLineCount_R,nil,'DisplayLineCount'); + RegisterPropertyHelper(@TCustomSynEditCharsInWindow_R,nil,'CharsInWindow'); + RegisterPropertyHelper(@TCustomSynEditCharWidth_R,nil,'CharWidth'); + RegisterPropertyHelper(@TCustomSynEditFont_R,@TCustomSynEditFont_W,'Font'); + RegisterPropertyHelper(@TCustomSynEditHighlighter_R,@TCustomSynEditHighlighter_W,'Highlighter'); + RegisterPropertyHelper(@TCustomSynEditHintMode_R,@TCustomSynEditHintMode_W,'HintMode'); + RegisterPropertyHelper(@TCustomSynEditLeftChar_R,@TCustomSynEditLeftChar_W,'LeftChar'); + RegisterPropertyHelper(@TCustomSynEditLineHeight_R,nil,'LineHeight'); + RegisterPropertyHelper(@TCustomSynEditLinesInWindow_R,nil,'LinesInWindow'); + RegisterPropertyHelper(@TCustomSynEditLineText_R,@TCustomSynEditLineText_W,'LineText'); + RegisterPropertyHelper(@TCustomSynEditLines_R,@TCustomSynEditLines_W,'Lines'); + RegisterPropertyHelper(@TCustomSynEditMarks_R,nil,'Marks'); + RegisterPropertyHelper(@TCustomSynEditMaxScrollWidth_R,@TCustomSynEditMaxScrollWidth_W,'MaxScrollWidth'); + RegisterPropertyHelper(@TCustomSynEditModified_R,@TCustomSynEditModified_W,'Modified'); + RegisterPropertyHelper(@TCustomSynEditPaintLock_R,nil,'PaintLock'); + RegisterPropertyHelper(@TCustomSynEditReadOnly_R,@TCustomSynEditReadOnly_W,'ReadOnly'); + RegisterPropertyHelper(@TCustomSynEditSearchEngine_R,@TCustomSynEditSearchEngine_W,'SearchEngine'); + RegisterPropertyHelper(@TCustomSynEditSelAvail_R,nil,'SelAvail'); + RegisterPropertyHelper(@TCustomSynEditSelLength_R,@TCustomSynEditSelLength_W,'SelLength'); + RegisterPropertyHelper(@TCustomSynEditSelTabBlock_R,nil,'SelTabBlock'); + RegisterPropertyHelper(@TCustomSynEditSelTabLine_R,nil,'SelTabLine'); + RegisterPropertyHelper(@TCustomSynEditSelText_R,@TCustomSynEditSelText_W,'SelText'); + RegisterPropertyHelper(@TCustomSynEditStateFlags_R,nil,'StateFlags'); + RegisterPropertyHelper(@TCustomSynEditText_R,@TCustomSynEditText_W,'Text'); + RegisterPropertyHelper(@TCustomSynEditTopLine_R,@TCustomSynEditTopLine_W,'TopLine'); + RegisterPropertyHelper(@TCustomSynEditWordAtCursor_R,nil,'WordAtCursor'); + RegisterPropertyHelper(@TCustomSynEditWordAtMouse_R,nil,'WordAtMouse'); + RegisterPropertyHelper(@TCustomSynEditUndoList_R,nil,'UndoList'); + RegisterPropertyHelper(@TCustomSynEditRedoList_R,nil,'RedoList'); + RegisterPropertyHelper(@TCustomSynEditOnProcessCommand_R,@TCustomSynEditOnProcessCommand_W,'OnProcessCommand'); + {$IF CompilerVersion >= 23} + RegisterPropertyHelper(@TCustomSynEditCodeFolding_R,@TCustomSynEditCodeFolding_W,'CodeFolding'); + RegisterPropertyHelper(@TCustomSynEditUseCodeFolding_R,@TCustomSynEditUseCodeFolding_W,'UseCodeFolding'); + RegisterPropertyHelper(@TCustomSynEditAllFoldRanges_R,nil,'AllFoldRanges'); + {$IFEND} + RegisterPropertyHelper(@TCustomSynEditBookMarkOptions_R,@TCustomSynEditBookMarkOptions_W,'BookMarkOptions'); + RegisterPropertyHelper(@TCustomSynEditBorderStyle_R,@TCustomSynEditBorderStyle_W,'BorderStyle'); + RegisterPropertyHelper(@TCustomSynEditExtraLineSpacing_R,@TCustomSynEditExtraLineSpacing_W,'ExtraLineSpacing'); + RegisterPropertyHelper(@TCustomSynEditGutter_R,@TCustomSynEditGutter_W,'Gutter'); + RegisterPropertyHelper(@TCustomSynEditHideSelection_R,@TCustomSynEditHideSelection_W,'HideSelection'); + RegisterPropertyHelper(@TCustomSynEditInsertCaret_R,@TCustomSynEditInsertCaret_W,'InsertCaret'); + RegisterPropertyHelper(@TCustomSynEditInsertMode_R,@TCustomSynEditInsertMode_W,'InsertMode'); + RegisterPropertyHelper(@TCustomSynEditIsScrolling_R,nil,'IsScrolling'); + RegisterPropertyHelper(@TCustomSynEditKeystrokes_R,@TCustomSynEditKeystrokes_W,'Keystrokes'); + RegisterPropertyHelper(@TCustomSynEditMaxUndo_R,@TCustomSynEditMaxUndo_W,'MaxUndo'); + RegisterPropertyHelper(@TCustomSynEditOptions_R,@TCustomSynEditOptions_W,'Options'); + RegisterPropertyHelper(@TCustomSynEditOverwriteCaret_R,@TCustomSynEditOverwriteCaret_W,'OverwriteCaret'); + RegisterPropertyHelper(@TCustomSynEditRightEdge_R,@TCustomSynEditRightEdge_W,'RightEdge'); + RegisterPropertyHelper(@TCustomSynEditRightEdgeColor_R,@TCustomSynEditRightEdgeColor_W,'RightEdgeColor'); + RegisterPropertyHelper(@TCustomSynEditScrollHintColor_R,@TCustomSynEditScrollHintColor_W,'ScrollHintColor'); + RegisterPropertyHelper(@TCustomSynEditScrollHintFormat_R,@TCustomSynEditScrollHintFormat_W,'ScrollHintFormat'); + RegisterPropertyHelper(@TCustomSynEditScrollBars_R,@TCustomSynEditScrollBars_W,'ScrollBars'); + RegisterPropertyHelper(@TCustomSynEditSelectedColor_R,@TCustomSynEditSelectedColor_W,'SelectedColor'); + RegisterPropertyHelper(@TCustomSynEditSelectionMode_R,@TCustomSynEditSelectionMode_W,'SelectionMode'); + RegisterPropertyHelper(@TCustomSynEditActiveSelectionMode_R,@TCustomSynEditActiveSelectionMode_W,'ActiveSelectionMode'); + RegisterPropertyHelper(@TCustomSynEditTabWidth_R,@TCustomSynEditTabWidth_W,'TabWidth'); + RegisterPropertyHelper(@TCustomSynEditWantReturns_R,@TCustomSynEditWantReturns_W,'WantReturns'); + RegisterPropertyHelper(@TCustomSynEditWantTabs_R,@TCustomSynEditWantTabs_W,'WantTabs'); + RegisterPropertyHelper(@TCustomSynEditWordWrap_R,@TCustomSynEditWordWrap_W,'WordWrap'); + RegisterPropertyHelper(@TCustomSynEditWordWrapGlyph_R,@TCustomSynEditWordWrapGlyph_W,'WordWrapGlyph'); + RegisterPropertyHelper(@TCustomSynEditOnChange_R,@TCustomSynEditOnChange_W,'OnChange'); + RegisterPropertyHelper(@TCustomSynEditOnClearBookmark_R,@TCustomSynEditOnClearBookmark_W,'OnClearBookmark'); + RegisterPropertyHelper(@TCustomSynEditOnCommandProcessed_R,@TCustomSynEditOnCommandProcessed_W,'OnCommandProcessed'); + RegisterPropertyHelper(@TCustomSynEditOnContextHelp_R,@TCustomSynEditOnContextHelp_W,'OnContextHelp'); + RegisterPropertyHelper(@TCustomSynEditOnDropFiles_R,@TCustomSynEditOnDropFiles_W,'OnDropFiles'); + RegisterPropertyHelper(@TCustomSynEditOnGutterClick_R,@TCustomSynEditOnGutterClick_W,'OnGutterClick'); + RegisterPropertyHelper(@TCustomSynEditOnGutterGetText_R,@TCustomSynEditOnGutterGetText_W,'OnGutterGetText'); + RegisterPropertyHelper(@TCustomSynEditOnGutterPaint_R,@TCustomSynEditOnGutterPaint_W,'OnGutterPaint'); + RegisterPropertyHelper(@TCustomSynEditOnMouseCursor_R,@TCustomSynEditOnMouseCursor_W,'OnMouseCursor'); + RegisterPropertyHelper(@TCustomSynEditOnKeyPress_R,@TCustomSynEditOnKeyPress_W,'OnKeyPress'); + RegisterPropertyHelper(@TCustomSynEditOnPaint_R,@TCustomSynEditOnPaint_W,'OnPaint'); + RegisterPropertyHelper(@TCustomSynEditOnPlaceBookmark_R,@TCustomSynEditOnPlaceBookmark_W,'OnPlaceBookmark'); + RegisterPropertyHelper(@TCustomSynEditOnProcessUserCommand_R,@TCustomSynEditOnProcessUserCommand_W,'OnProcessUserCommand'); + RegisterPropertyHelper(@TCustomSynEditOnReplaceText_R,@TCustomSynEditOnReplaceText_W,'OnReplaceText'); + RegisterPropertyHelper(@TCustomSynEditOnSpecialLineColors_R,@TCustomSynEditOnSpecialLineColors_W,'OnSpecialLineColors'); + RegisterPropertyHelper(@TCustomSynEditOnSpecialTokenAttributes_R,@TCustomSynEditOnSpecialTokenAttributes_W,'OnSpecialTokenAttributes'); + RegisterPropertyHelper(@TCustomSynEditOnStatusChange_R,@TCustomSynEditOnStatusChange_W,'OnStatusChange'); + RegisterPropertyHelper(@TCustomSynEditOnPaintTransient_R,@TCustomSynEditOnPaintTransient_W,'OnPaintTransient'); + RegisterPropertyHelper(@TCustomSynEditOnScroll_R,@TCustomSynEditOnScroll_W,'OnScroll'); + RegisterPropertyHelper(@TCustomSynEditOnTokenHint_R,@TCustomSynEditOnTokenHint_W,'OnTokenHint'); + {$IF CompilerVersion >= 23} + RegisterPropertyHelper(@TCustomSynEditOnScanForFoldRanges_R,@TCustomSynEditOnScanForFoldRanges_W,'OnScanForFoldRanges'); + {$IFEND} + RegisterPropertyHelper(@TCustomSynEditOnSearchNotFound_R,@TCustomSynEditOnSearchNotFound_W,'OnSearchNotFound'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TSynEditPlugin(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TSynEditPlugin) do + begin + RegisterConstructor(@TSynEditPlugin.Create, 'Create'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TSynEditMarkList(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TSynEditMarkList) do + begin + RegisterConstructor(@TSynEditMarkList.Create, 'Create'); + RegisterMethod(@TSynEditMarkList.First, 'First'); + RegisterMethod(@TSynEditMarkList.Last, 'Last'); + RegisterMethod(@TSynEditMarkList.Extract, 'Extract'); + RegisterMethod(@TSynEditMarkList.ClearLine, 'ClearLine'); + RegisterMethod(@TSynEditMarkList.GetMarksForLine, 'GetMarksForLine'); + RegisterMethod(@TSynEditMarkList.Place, 'Place'); + RegisterPropertyHelper(@TSynEditMarkListItems_R,@TSynEditMarkListItems_W,'Items'); + RegisterPropertyHelper(@TSynEditMarkListEdit_R,nil,'Edit'); + RegisterPropertyHelper(@TSynEditMarkListOnChange_R,@TSynEditMarkListOnChange_W,'OnChange'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TSynEditMark(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TSynEditMark) do + begin + RegisterConstructor(@TSynEditMark.Create, 'Create'); + RegisterPropertyHelper(@TSynEditMarkLine_R,@TSynEditMarkLine_W,'Line'); + RegisterPropertyHelper(@TSynEditMarkChar_R,@TSynEditMarkChar_W,'Char'); + RegisterPropertyHelper(@TSynEditMarkEdit_R,nil,'Edit'); + RegisterPropertyHelper(@TSynEditMarkImageIndex_R,@TSynEditMarkImageIndex_W,'ImageIndex'); + RegisterPropertyHelper(@TSynEditMarkBookmarkNumber_R,@TSynEditMarkBookmarkNumber_W,'BookmarkNumber'); + RegisterPropertyHelper(@TSynEditMarkVisible_R,@TSynEditMarkVisible_W,'Visible'); + RegisterPropertyHelper(@TSynEditMarkInternalImage_R,@TSynEditMarkInternalImage_W,'InternalImage'); + RegisterPropertyHelper(@TSynEditMarkIsBookmark_R,nil,'IsBookmark'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_SynEdit(CL: TPSRuntimeClassImporter); +begin +// with CL.Add(ESynEditError) do + with CL.Add(TCustomSynEdit) do + RIRegister_TSynEditMark(CL); + RIRegister_TSynEditMarkList(CL); + RIRegister_TSynEditPlugin(CL); + RIRegister_TCustomSynEdit(CL); + RIRegister_TSynEdit(CL); +end; + + + +{ TPSImport_SynEdit } +(*----------------------------------------------------------------------------*) +procedure TPSImport_SynEdit.CompileImport1(CompExec: TPSScript); +begin + SIRegister_SynEdit(CompExec.Comp); +end; +(*----------------------------------------------------------------------------*) +procedure TPSImport_SynEdit.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); +begin + RIRegister_SynEdit(ri); +end; +(*----------------------------------------------------------------------------*) + + +end. diff --git a/Source/arm.inc b/Source/arm.inc index 454a74a2..e3e34274 100644 --- a/Source/arm.inc +++ b/Source/arm.inc @@ -297,7 +297,8 @@ begin { add var params here } btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btUnicodeString, btWideString, btWideChar, {$ENDIF} btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency - {$IFNDEF PS_NOINT64}, bts64, btU64{$ENDIF}: addgen(dword(fvar.dta)); + {$IFNDEF PS_NOINT64}, bts64{$ENDIF} + {$IFNDEF PS_NOUINT64}, btU64{$ENDIF}: addgen(dword(fvar.dta)); else begin writeln(stderr, 'Parameter type not recognised!'); Exit; @@ -307,7 +308,8 @@ begin case fvar.aType.BaseType of // btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btWideString, btWideChar, {$ENDIF} // btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency -// {$IFNDEF PS_NOINT64}, bts64{$ENDIF}: writeln('normal param'); +// {$IFNDEF PS_NOINT64}, bts64{$ENDIF} +// {$IFNDEF PS_NOUINT64}, btU64{$ENDIF}: writeln('normal param'); { add normal params here } btString: addgen(dword(pstring(fvar.dta)^)); @@ -333,14 +335,15 @@ begin {$endif} btPChar: addgen(dword(ppchar(fvar.dta)^)); btChar: addgen(dword(pchar(fvar.dta)^)); - {$IFNDEF PS_NOINT64}bts64: begin + {$IFNDEF PS_NOINT64}bts64: begin {$IFDEF FPC_abi_eabi} addgend(qword(pint64(fvar.dta)^)); {$ELSE} addgen(dword(pint64(fvar.dta)^ and $ffffffff)); addgen(dword(pint64(fvar.dta)^ shr 32)); {$ENDIF} - end; + end;{$ENDIF PS_NOINT64} + {$IFNDEF PS_NOUINT64} btU64: begin {$IFDEF FPC_abi_eabi} addgend(qword(puint64(fvar.dta)^)); @@ -348,7 +351,7 @@ begin addgen(dword(puint64(fvar.dta)^ and $ffffffff)); addgen(dword(puint64(fvar.dta)^ shr 32)); {$ENDIF} - end;{$ENDIF} + end;{$ENDIF PS_NOUINT64} btStaticArray: addgen(dword(fvar.dta)); btRecord: for j := 0 to (fvar.atype.realsize div 4)-1 do addgen(pdword(fvar.dta + j*4)^); @@ -376,8 +379,10 @@ begin btU32, btS32,btPChar: pdword(res.dta)^ := lo(armasmcall(rint, rfloat, address, st, stindex, rtINT)); {$IFNDEF PS_NOINT64} btS64: pqword(res.dta)^ := armasmcall(rint, rfloat, address, st, stindex,rtINT); +{$ENDIF PS_NOINT64} +{$IFNDEF PS_NOUINT64} btU64: puint64(res.dta)^ := armasmcall(rint, rfloat, address, st, stindex,rtINT); -{$ENDIF} +{$ENDIF PS_NOUINT64} {$IFDEF FPC_abi_eabi} btSingle: pdword(res.dta)^ := lo(armasmcall(rint, rfloat, address, st, stindex, rtFLOAT)); {$ELSE} diff --git a/Source/powerpc.inc b/Source/powerpc.inc index 1e54e42b..2f75d99d 100644 --- a/Source/powerpc.inc +++ b/Source/powerpc.inc @@ -307,7 +307,8 @@ begin { add var params here } btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btWideString, btWideChar, {$ENDIF} btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency - {$IFNDEF PS_NOINT64}, bts64, btU64{$ENDIF}: addgen(dword(fvar.dta)); { TODO: test all } + {$IFNDEF PS_NOINT64}, bts64{$ENDIF} + {$IFNDEF PS_NOUINT64}, btu64{$ENDIF}: addgen(dword(fvar.dta)); { TODO: test all } else begin writeln(stderr, 'Parameter type not recognised!'); Exit; @@ -317,7 +318,8 @@ begin case fvar.aType.BaseType of // btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btWideString, btWideChar, {$ENDIF} // btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency -// {$IFNDEF PS_NOINT64}, bts64{$ENDIF}: writeln('normal param'); +// {$IFNDEF PS_NOINT64}, bts64{$ENDIF} +// {$IFNDEF PS_NOUINT64}, btu64{$ENDIF}: writeln('normal param'); { add normal params here } btString: addgen(dword(pstring(fvar.dta)^)); @@ -331,11 +333,12 @@ begin {$IFNDEF PS_NOINT64}bts64: begin addgen(dword(pint64(fvar.dta)^ shr 32)); addgen(dword(pint64(fvar.dta)^ and $ffffffff)); - end; - btU64: begin + end;{$ENDIF PS_NOINT64} + {$IFNDEF PS_NOUINT64}btu64: begin addgen(dword(puint64(fvar.dta)^ shr 32)); addgen(dword(puint64(fvar.dta)^ and $ffffffff)); - end;{$ENDIF} + end;{$ENDIF PS_NOUINT64} + btStaticArray: addgen(dword(fvar.dta)); btRecord: for j := 0 to (fvar.atype.realsize div 4)-1 do addgen(pdword(fvar.dta + j*4)^); diff --git a/Source/uPSC_DB.pas b/Source/uPSC_DB.pas index 9aedadd9..d3e599fd 100644 --- a/Source/uPSC_DB.pas +++ b/Source/uPSC_DB.pas @@ -85,7 +85,7 @@ procedure SIRegister_DB(Cl: TPSPascalCompiler); implementation Uses Sysutils; -Function RegClassS(cl : TPSPascalCompiler;Const InheritsFrom,Classname : String) : TPSCompileTimeClass; +Function RegClassS(cl : TPSPascalCompiler;Const InheritsFrom,Classname : AnsiString) : TPSCompileTimeClass; begin Result := cl.FindClass(Classname); if Result = nil then diff --git a/Source/uPSC_Math.pas b/Source/uPSC_Math.pas new file mode 100644 index 00000000..1093d4ef --- /dev/null +++ b/Source/uPSC_Math.pas @@ -0,0 +1,203 @@ +{ Compile time Date Time library } +unit uPSC_Math; + +interface + +uses + uPSCompiler, uPSUtils; + +procedure RegisterMathLibrary_C(S: TPSPascalCompiler); + +implementation + +uses + Math; + +procedure RegisterMathLibrary_C(S: TPSPascalCompiler); +begin + S.AddConstant( 'MinSingle', MinSingle ); + S.AddConstant( 'MaxSingle', MaxSingle ); + S.AddConstant( 'MinDouble', MinDouble ); + S.AddConstant( 'MaxDouble', MaxDouble ); + S.AddConstant( 'MinExtended', MinExtended ); + S.AddConstant( 'MaxExtended', MaxExtended ); + S.AddConstant( 'MinComp', MinComp ); + S.AddConstant( 'MaxComp', MaxComp ); + S.AddConstant( 'NaN', NaN ); + S.AddConstant( 'Infinity', Infinity ); + S.AddConstant( 'NegInfinity', NegInfinity ); + S.AddConstant( 'NegativeValue', NegativeValue ); + S.AddConstant( 'ZeroValue', ZeroValue ); + S.AddConstant( 'PositiveValue', PositiveValue ); + + {$IF CompilerVersion > 23} + S.AddConstant( 'seSSE', seSSE ); + S.AddConstant( 'seSSE2', seSSE2 ); + S.AddConstant( 'seSSE3', seSSE3 ); + S.AddConstant( 'seSSSE3', seSSSE3 ); + S.AddConstant( 'seSSE41', seSSE41 ); + S.AddConstant( 'seSSE42', seSSE42 ); + S.AddConstant( 'sePOPCNT', sePOPCNT ); + S.AddConstant( 'seAESNI', seAESNI ); + S.AddConstant( 'sePCLMULQDQ', sePCLMULQDQ ); + {$IFEND} + + S.AddTypeS( 'TPaymentTime', '(ptEndOfPeriod, ptStartOfPeriod)' ); + + s.AddDelphiFunction('function ArcCos(const X : Extended) : Extended;'); + s.AddDelphiFunction('function ArcSin(const X : Extended) : Extended;'); + s.AddDelphiFunction('function ArcTan2(const Y, X: Extended): Extended;'); + s.AddDelphiFunction('procedure SinCos(const Theta: Extended; var Sin, Cos: Extended);'); + s.AddDelphiFunction('function Tan(const X: Extended): Extended;'); + s.AddDelphiFunction('function Cotan(const X: Extended): Extended;'); + s.AddDelphiFunction('function Secant(const X: Extended): Extended;'); + s.AddDelphiFunction('function Cosecant(const X: Extended): Extended;'); + s.AddDelphiFunction('function Hypot(const X, Y: Extended): Extended;'); + s.AddDelphiFunction('function Hypot_(const X, Y, Z: Extended): Extended;'); + s.AddDelphiFunction('function RadToDeg(const Radians: Extended): Extended;'); + s.AddDelphiFunction('function RadToGrad(const Radians: Extended): Extended;'); + s.AddDelphiFunction('function RadToCycle(const Radians: Extended): Extended;'); + s.AddDelphiFunction('function DegToRad(const Degrees: Extended): Extended;'); + s.AddDelphiFunction('function DegToGrad(const Degrees: Extended): Extended;'); + s.AddDelphiFunction('function DegToCycle(const Degrees: Extended): Extended;'); + {$IF CompilerVersion >= 23} + s.AddDelphiFunction('function DegNormalize(const Degrees: Extended): Extended;'); + {$IFEND} + s.AddDelphiFunction('function GradToRad(const Grads: Extended): Extended;'); + s.AddDelphiFunction('function GradToDeg(const Grads: Extended): Extended;'); + s.AddDelphiFunction('function GradToCycle(const Grads: Extended): Extended;'); + s.AddDelphiFunction('function CycleToRad(const Cycles: Extended): Extended;'); + s.AddDelphiFunction('function CycleToDeg(const Cycles: Extended): Extended;'); + s.AddDelphiFunction('function CycleToGrad(const Cycles: Extended): Extended;'); + s.AddDelphiFunction('function Cot(const X: Extended): Extended;'); + s.AddDelphiFunction('function Sec(const X: Extended): Extended;'); + s.AddDelphiFunction('function Csc(const X: Extended): Extended;'); + s.AddDelphiFunction('function Cosh(const X: Extended): Extended;'); + s.AddDelphiFunction('function Sinh(const X: Extended): Extended;'); + s.AddDelphiFunction('function Tanh(const X: Extended): Extended;'); + s.AddDelphiFunction('function CotH(const X: Extended): Extended;'); + s.AddDelphiFunction('function SecH(const X: Extended): Extended;'); + s.AddDelphiFunction('function CscH(const X: Extended): Extended;'); + s.AddDelphiFunction('function ArcCot(const X: Extended): Extended;'); + s.AddDelphiFunction('function ArcSec(const X: Extended): Extended;'); + s.AddDelphiFunction('function ArcCsc(const X: Extended): Extended;'); + s.AddDelphiFunction('function ArcCosh(const X: Extended): Extended;'); + s.AddDelphiFunction('function ArcSinh(const X: Extended): Extended;'); + s.AddDelphiFunction('function ArcTanh(const X: Extended): Extended;'); + s.AddDelphiFunction('function ArcCotH(const X: Extended): Extended;'); + s.AddDelphiFunction('function ArcSecH(const X: Extended): Extended;'); + s.AddDelphiFunction('function ArcCscH(const X: Extended): Extended;'); + s.AddDelphiFunction('function LnXP1(const X: Extended): Extended;'); + s.AddDelphiFunction('function Log10(const X: Extended): Extended;'); + s.AddDelphiFunction('function Log2(const X: Extended): Extended;'); + s.AddDelphiFunction('function LogN(const Base, X: Extended): Extended;'); + s.AddDelphiFunction('function IntPower(const Base: Extended; const Exponent: Integer): Extended;'); + s.AddDelphiFunction('function Power(const Base, Exponent: Extended): Extended;'); + s.AddDelphiFunction('procedure Frexp(const X: Extended; var Mantissa: Extended; var Exponent: Integer);'); + s.AddDelphiFunction('function Ldexp(const X: Extended; const P: Integer): Extended;'); + s.AddDelphiFunction('function Ceil(const X: Extended): Integer;'); + s.AddDelphiFunction('function Floor(const X: Extended): Integer;'); + s.AddDelphiFunction('function Poly(const X: Extended; const Coefficients: array of Extended): Extended;'); + {$IF CompilerVersion < 22} + s.AddDelphiFunction('function Mean(const Data: array of Double): Extended;'); + s.AddDelphiFunction('function Sum(const Data: array of Double): Extended;'); + {$ELSE} + s.AddDelphiFunction('function Mean(const Data: array of Extended): Extended;'); + s.AddDelphiFunction('function Sum(const Data: array of Extended): Extended;'); + {$IFEND} + s.AddDelphiFunction('function SumInt(const Data: array of Integer): Integer;'); + {$IF CompilerVersion < 22} + s.AddDelphiFunction('function SumOfSquares(const Data: array of Double): Extended;'); + s.AddDelphiFunction('procedure SumsAndSquares(const Data: array of Double; var Sum, SumOfSquares: Extended);'); + {$ELSE} + s.AddDelphiFunction('function SumOfSquares(const Data: array of Extended): Extended;'); + s.AddDelphiFunction('procedure SumsAndSquares(const Data: array of Extended; var Sum, SumOfSquares: Extended);'); + {$IFEND} + {$IF CompilerVersion < 22} + s.AddDelphiFunction('function MinValue(const Data: array of Double): Double;'); + {$ELSE} + s.AddDelphiFunction('function MinValue(const Data: array of Extended): Extended;'); + {$IFEND} + s.AddDelphiFunction('function MinIntValue(const Data: array of Integer): Integer;'); + s.AddDelphiFunction('function Min(const A, B: Int64): Int64;'); + s.AddDelphiFunction('function MinF(const A, B: Extended): Extended;'); + {$IF CompilerVersion < 22} + s.AddDelphiFunction('function MaxValue(const Data: array of Double): Double;'); + {$ELSE} + s.AddDelphiFunction('function MaxValue(const Data: array of Extended): Extended;'); + {$IFEND} + s.AddDelphiFunction('function MaxIntValue(const Data: array of Integer): Integer;'); + s.AddDelphiFunction('function Max(const A, B: Int64): Int64;'); + s.AddDelphiFunction('function MaxF(const A, B: Extended): Extended;'); + {$IF CompilerVersion < 22} + s.AddDelphiFunction('function StdDev(const Data: array of Double): Extended;'); + s.AddDelphiFunction('procedure MeanAndStdDev(const Data: array of Double; var Mean, StdDev: Extended);'); + s.AddDelphiFunction('function PopnStdDev(const Data: array of Double): Extended;'); + s.AddDelphiFunction('function Variance(const Data: array of Double): Extended;'); + s.AddDelphiFunction('function PopnVariance(const Data: array of Double): Extended;'); + s.AddDelphiFunction('function TotalVariance(const Data: array of Double): Extended;'); + s.AddDelphiFunction('function Norm(const Data: array of Double): Extended;'); + {$ELSE} + s.AddDelphiFunction('function StdDev(const Data: array of Extended): Extended;'); + s.AddDelphiFunction('procedure MeanAndStdDev(const Data: array of Extended; var Mean, StdDev: Extended);'); + s.AddDelphiFunction('function PopnStdDev(const Data: array of Extended): Extended;'); + s.AddDelphiFunction('function Variance(const Data: array of Extended): Extended;'); + s.AddDelphiFunction('function PopnVariance(const Data: array of Extended): Extended;'); + s.AddDelphiFunction('function TotalVariance(const Data: array of Extended): Extended;'); + s.AddDelphiFunction('function Norm(const Data: array of Extended): Extended;'); + {$IFEND} + s.AddDelphiFunction('procedure MomentSkewKurtosis(const Data: array of Double; var M1, M2, M3, M4, Skew, Kurtosis: Extended);'); + s.AddDelphiFunction('function RandG(Mean, StdDev: Extended): Extended;'); + s.AddDelphiFunction('function IsNan(const AValue: Extended): Boolean;'); + {$IF CompilerVersion < 22} + s.AddDelphiFunction('function IsInfinite(const AValue: Double): Boolean;'); + {$ELSE} + s.AddDelphiFunction('function IsInfinite(const AValue: Extended): Boolean;'); + {$IFEND} + {$IF CompilerVersion < 22} + s.AddDelphiFunction('function Sign(const AValue: Double): ShortInt{TValueSign};'); + {$ELSE} + s.AddDelphiFunction('function Sign(const AValue: Extended): ShortInt{TValueSign};'); + {$IFEND} + s.AddDelphiFunction('function CompareValueF(const A : Extended; B: Extended; Epsilon: Extended{ = 0}): ShortInt{TValueRelationship};'); + s.AddDelphiFunction('function CompareValue(const A : Int64; B: Int64): ShortInt{TValueRelationship};'); + s.AddDelphiFunction('function SameValueF(const A : Extended; B: Extended; Epsilon: Extended{ = 0}): Boolean;'); + s.AddDelphiFunction('function SameValue(const A : Int64; B: Int64): Boolean;'); + s.AddDelphiFunction('function IsZero(const A: Extended; Epsilon: Extended{ = 0}): Boolean;'); + s.AddDelphiFunction('function IfThen(AValue: Boolean; const ATrue: Extended; const AFalse: Extended{ = 0.0}): Extended;'); + {$IF CompilerVersion > 22} + s.AddDelphiFunction('function FMod(const ANumerator, ADenominator: Extended): Extended;'); + {$IFEND} + s.AddDelphiFunction('function RandomRange(const AFrom, ATo: Integer): Integer;'); + {$IF CompilerVersion < 22} + s.AddDelphiFunction('function RandomFrom(const AValues: array of Double): Double;'); + s.AddDelphiFunction('function InRange(const AValue, AMin, AMax: Double): Boolean;'); + s.AddDelphiFunction('function EnsureRange(const AValue, AMin, AMax: Double): Double;'); + s.AddDelphiFunction('procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: Word);'); + {$ELSE} + s.AddDelphiFunction('function RandomFrom(const AValues: array of Extended): Extended;'); + s.AddDelphiFunction('function InRange(const AValue, AMin, AMax: Extended): Boolean;'); + s.AddDelphiFunction('function EnsureRange(const AValue, AMin, AMax: Extended): Extended;'); + s.AddDelphiFunction('procedure DivMod(Dividend: Cardinal; Divisor: Word; var Result, Remainder: Word);'); + {$IFEND} + s.AddDelphiFunction('function RoundTo(const AValue: Extended; const ADigit: ShortInt{TRoundToEXRangeExtended}): Extended;'); + {$IF CompilerVersion < 22} + s.AddDelphiFunction('function SimpleRoundTo(const AValue: Double; const ADigit: ShortInt{TRoundToRange = -2}): Double;'); + {$ELSE} + s.AddDelphiFunction('function SimpleRoundTo(const AValue: Extended; const ADigit: ShortInt{TRoundToRange = -2}): Extended;'); + {$IFEND} + s.AddDelphiFunction('function DoubleDecliningBalance(const Cost, Salvage: Extended; Life, Period: Integer): Extended;'); + s.AddDelphiFunction('function FutureValue(const Rate: Extended; NPeriods: Integer; const Payment, PresentValue: Extended; PaymentTime: TPaymentTime): Extended;'); + s.AddDelphiFunction('function InterestPayment(const Rate: Extended; Period, NPeriods: Integer; const PresentValue, FutureValue: Extended; PaymentTime: TPaymentTime): Extended;'); + s.AddDelphiFunction('function InterestRate(NPeriods: Integer; const Payment, PresentValue, FutureValue: Extended; PaymentTime: TPaymentTime): Extended;'); + s.AddDelphiFunction('function InternalRateOfReturn(const Guess: Extended; const CashFlows: array of Double): Extended;'); + s.AddDelphiFunction('function NumberOfPeriods(const Rate: Extended; Payment: Extended; const PresentValue, FutureValue: Extended; PaymentTime: TPaymentTime): Extended;'); + s.AddDelphiFunction('function NetPresentValue(const Rate: Extended; const CashFlows: array of Double; PaymentTime: TPaymentTime): Extended;'); + s.AddDelphiFunction('function Payment(Rate: Extended; NPeriods: Integer; const PresentValue, FutureValue: Extended; PaymentTime: TPaymentTime): Extended;'); + s.AddDelphiFunction('function PeriodPayment(const Rate: Extended; Period, NPeriods: Integer; const PresentValue, FutureValue: Extended; PaymentTime: TPaymentTime): Extended;'); + s.AddDelphiFunction('function PresentValue(const Rate: Extended; NPeriods: Integer; const Payment, FutureValue: Extended; PaymentTime: TPaymentTime): Extended;'); + s.AddDelphiFunction('function SLNDepreciation(const Cost, Salvage: Extended; Life: Integer): Extended;'); + s.AddDelphiFunction('function SYDDepreciation(const Cost, Salvage: Extended; Life, Period: Integer): Extended;'); +end; + +end. diff --git a/Source/uPSC_StrUtils.pas b/Source/uPSC_StrUtils.pas new file mode 100644 index 00000000..99d58753 --- /dev/null +++ b/Source/uPSC_StrUtils.pas @@ -0,0 +1,155 @@ +{ Compile time Date Time library } +unit uPSC_StrUtils; + +interface + +uses + uPSCompiler, uPSUtils; + +procedure RegisterStrUtilsLibrary_C(S: TPSPascalCompiler); + +implementation + +uses + StrUtils; + +procedure RegisterStrUtilsLibrary_C(S: TPSPascalCompiler); +begin +(* +type + TSoundexLength = 1..MaxInt; + TSoundexIntLength = 1..8; + +const + { Default word delimiters are any character except the core alphanumerics. } + WordDelimiters: set of Byte = [0..255] - + [Ord('a')..Ord('z'), Ord('A')..Ord('Z'), Ord('1')..Ord('9'), Ord('0')]; +*) + + S.AddTypeS('TStringSeachOption', '(soDown, soMatchCase, soWholeWord)'); + S.AddTypeS('TStringSearchOptions', 'set of TStringSeachOption'); + S.AddTypeS('TCompareTextProc', 'function(const AText, AOther: string): Boolean;'); + + S.AddTypeS('TStringDynArray', 'Array of String'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function ResemblesText(const AText, AOther: string): Boolean;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiResemblesText(const AText, AOther: string): Boolean;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function ContainsText(const AText, ASubText: string): Boolean;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiContainsText(const AText, ASubText: string): Boolean;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function StartsText(const ASubText, AText: string): Boolean;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiStartsText(const ASubText, AText: string): Boolean;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function EndsText(const ASubText, AText: string): Boolean;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiEndsText(const ASubText, AText: string): Boolean;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function ReplaceText(const AText, AFromText, AToText: string): string;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiReplaceText(const AText, AFromText, AToText: string): string;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function MatchText(const AText: string; const AValues: array of string): Boolean;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiMatchText(const AText: string; const AValues: array of string): Boolean;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function IndexText(const AText: string; const AValues: array of string): Integer;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiIndexText(const AText: string; const AValues: array of string): Integer;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function ContainsStr(const AText, ASubText: string): Boolean;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiContainsStr(const AText, ASubText: string): Boolean;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function StartsStr(const ASubText, AText: string): Boolean;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiStartsStr(const ASubText, AText: string): Boolean;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function EndsStr(const ASubText, AText: string): Boolean;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiEndsStr(const ASubText, AText: string): Boolean;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function ReplaceStr(const AText, AFromText, AToText: string): string;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiReplaceStr(const AText, AFromText, AToText: string): string;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function MatchStr(const AText: string; const AValues: array of string): Boolean;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function IndexStr(const AText: string; const AValues: array of string): Integer;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiIndexStr(const AText: string; const AValues: array of string): Integer;'); + + s.AddDelphiFunction('function DupeString(const AText: string; ACount: Integer): string;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function ReverseString(const AText: string): string;'); + {$ENDIF UNICODE} + s.AddDelphiFunction('function AnsiReverseString(const AText: string): string;'); + + s.AddDelphiFunction('function StuffString(const AText: string; AStart, ALength: Cardinal; const ASubText: string): string;'); + s.AddDelphiFunction('function RandomFrom(const AValues: array of string): string;'); + s.AddDelphiFunction('function IfThen(AValue: Boolean; const ATrue: string; AFalse: string{ = ''}): string;'); + {$IFDEF UNICODE} + s.AddDelphiFunction('function SplitString(const S, Delimiters: string): TStringDynArray;'); + {$ENDIF UNICODE} + + {$IFDEF UNICODE} + s.AddDelphiFunction('function LeftStr(const AText: string; const ACount: Integer): string;'); + s.AddDelphiFunction('function RightStr(const AText: string; const ACount: Integer): string;'); + s.AddDelphiFunction('function MidStr(const AText: string; const AStart, ACount: Integer): string;'); + {$ELSE} + s.AddDelphiFunction('function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;'); + s.AddDelphiFunction('function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString;'); + s.AddDelphiFunction('function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;'); + {$ENDIF UNICODE} + + s.AddDelphiFunction('function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;'); + s.AddDelphiFunction('function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;'); + s.AddDelphiFunction('function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString;'); + s.AddDelphiFunction('function AnsiLeftStr(const AText: string; const ACount: Integer): string;'); + s.AddDelphiFunction('function AnsiRightStr(const AText: string; const ACount: Integer): string;'); + s.AddDelphiFunction('function AnsiMidStr(const AText: string; const AStart, ACount: Integer): string;'); + + {$IFDEF UNICODE} + s.AddDelphiFunction('function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TStringSearchOptions{ = [soDown]}): PChar;'); + {$ELSE} + s.AddDelphiFunction('function SearchBuf(Buf: PAnsiChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: AnsiString; Options: TStringSearchOptions{ = [soDown]}): PAnsiChar;'); + {$ENDIF} + + {$IFDEF UNICODE} + s.AddDelphiFunction('function PosEx(const SubStr, S: string; Offset: Integer{ = 1}): Integer;'); + {$ELSE} + s.AddDelphiFunction('function PosEx(const SubStr, S: string; Offset: Cardinal{ = 1}): Integer;'); + {$ENDIF UNICODE} + +(* + s.AddDelphiFunction('function Soundex(const AText: string; ALength: TSoundexLength{ = 4}): string;'); + s.AddDelphiFunction('function SoundexInt(const AText: string; ALength: TSoundexIntLength{ = 4}): Integer;'); + s.AddDelphiFunction('function DecodeSoundexInt(AValue: Integer): string;'); + s.AddDelphiFunction('function SoundexWord(const AText: string): Word;'); + s.AddDelphiFunction('function DecodeSoundexWord(AValue: Word): string;'); + s.AddDelphiFunction('function SoundexSimilar(const AText, AOther: string; ALength: TSoundexLength{ = 4}): Boolean;'); + s.AddDelphiFunction('function SoundexCompare(const AText, AOther: string; ALength: TSoundexLength{ = 4}): Integer;'); + s.AddDelphiFunction('function SoundexProc(const AText, AOther: string): Boolean;'); +*) +end; + +end. diff --git a/Source/uPSC_SysUtils.pas b/Source/uPSC_SysUtils.pas new file mode 100644 index 00000000..51dc1ffc --- /dev/null +++ b/Source/uPSC_SysUtils.pas @@ -0,0 +1,418 @@ +unit uPSC_SysUtils; + +interface + +{$WARN SYMBOL_PLATFORM OFF} + +uses + uPSCompiler, uPSUtils; + +procedure RegisterSysUtilsLibrary_C(S: TPSPascalCompiler); + +implementation + +uses + SysUtils; + +procedure RegisterSysUtilsLibrary_C(S: TPSPascalCompiler); +var + T : String; +begin + {$IF CompilerVersion >= 28} + S.AddConstant('INVALID_HANDLE_VALUE', INVALID_HANDLE_VALUE); + {$IFEND} + + S.AddConstant('fmOpenRead', fmOpenRead); + S.AddConstant('fmOpenWrite', fmOpenWrite); + S.AddConstant('fmOpenReadWrite', fmOpenReadWrite); + {$IF Declared( fmExclusive )} + S.AddConstant('fmExclusive', fmExclusive); + {$IFEND} + S.AddConstant('fmShareCompat', fmShareCompat); + S.AddConstant('fmShareExclusive', fmShareExclusive); + S.AddConstant('fmShareDenyWrite', fmShareDenyWrite); + S.AddConstant('fmShareDenyRead', fmShareDenyRead); + S.AddConstant('fmShareDenyNone', fmShareDenyNone); + + {$IF Declared( faInvalid )} + S.AddConstant('faInvalid', faInvalid); + {$IFEND} + S.AddConstant('faReadOnly', faReadOnly); + S.AddConstant('faHidden', faHidden); + S.AddConstant('faSysFile', faSysFile); + S.AddConstant('faVolumeID', faVolumeID); + S.AddConstant('faDirectory', faDirectory); + S.AddConstant('faArchive', faArchive); + {$IF Declared( faNormal )} + S.AddConstant('faNormal', faNormal); + S.AddConstant('faTemporary', faTemporary); + {$IFEND} + S.AddConstant('faSymLink', faSymLink); + {$IF Declared( faCompressed )} + S.AddConstant('faCompressed', faCompressed); + S.AddConstant('faEncrypted', faEncrypted); + S.AddConstant('faVirtual', faVirtual ); + {$IFEND} + S.AddConstant('faAnyFile', faAnyFile); + + S.AddConstant('PathDelim', tbtChar( PathDelim ) ); + S.AddConstant('DriveDelim', tbtChar( DriveDelim ) ); + S.AddConstant('PathSep', tbtChar( PathSep ) ); + + S.AddConstant('DefaultTrueBoolStr', DefaultTrueBoolStr); + S.AddConstant('DefaultFalseBoolStr', DefaultFalseBoolStr); + + S.AddConstant('MinCurrency', MinCurrency); + S.AddConstant('MaxCurrency', MaxCurrency); + + S.AddTypeS( 'TSysCharSet', 'set of AnsiChar' ); +// S.AddTypeS( 'TIntegerSet', 'set of 0..31{SizeOf(Integer) * 8 - 1}' ); + S.AddTypeS( 'TByteArray', 'array[0..32767] of Byte;' ); + S.AddTypeS( 'TWordArray', 'array[0..16383] of Word;' ); + S.AddTypeCopyN( 'TFileName', 'string' ); + + S.AddTypeS( 'TFloatValue', '(fvExtended, fvCurrency)' ); + S.AddTypeS( 'TFloatFormat', '(ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency)' ); + S.AddTypeS( 'TFloatRec', 'record Exponent: Smallint; Negative: Boolean; Digits: array[0..20] of Byte; end;' ); + S.AddTypeS( 'TTimeStamp', 'record Time: Integer; Date: Integer; end;' ); + S.AddTypeS( 'TMbcsByteType', '(mbSingleByte, mbLeadByte, mbTrailByte)' ); + S.AddTypeS( 'TBytes', 'Array of Byte' ); + + {$IF CompilerVersion >= 28} + S.AddTypeS( 'TLocaleOptions', '(loInvariantLocale, loUserLocale)' ); + {$IFEND} + + S.AddTypeCopyN( 'HMODULE', 'THandle' ); + + t := '{packed }record dwFileAttributes: Integer; ftCreationTime: Int64; ftLastAccessTime: Int64; ftLastWriteTime: Int64; nFileSizeHigh: Integer; nFileSizeLow: Integer; dwReserved0: Integer; dwReserved1: Integer; cFileName: array[0..259] of Char; ' + 'cAlternateFileName: array[0..13] of Char; end;'; + S.AddTypeS( 'TWin32FindData', t ); + + {$IF CompilerVersion >= 28} + S.AddTypeS( 'TSearchRec', 'record Time: Integer; Size: Int64; Attr: Integer; Name: TFileName; ExcludeAttr: Integer; FindHandle: THandle; FindData: TWin32FindData; end;' ); + {$ELSE} + S.AddTypeS( 'TSearchRec', 'record Time: Integer; Size: Integer; Attr: Integer; Name: TFileName; ExcludeAttr: Integer; FindHandle: THandle; FindData: TWin32FindData; end;' ); + {$IFEND} + + {$IF CompilerVersion >= 28} + S.AddTypeS( 'TEraInfo', 'record EraName: string; EraOffset: Integer; EraStart: TDate; EraEnd: TDate; end;' ); + t := 'record CurrencyString: string; CurrencyFormat: Byte; CurrencyDecimals: Byte; DateSeparator: Char; TimeSeparator: Char; ListSeparator: Char; ShortDateFormat: string; LongDateFormat: string; TimeAMString: string; TimePMString: string; ShortTimeFormat:' + + ' string; LongTimeFormat: string; ShortMonthNames: array[1..12] of string; LongMonthNames: array[1..12] of string; ShortDayNames: array[1..7] of string; LongDayNames: array[1..7] of string; EraInfo: array of TEraInfo; ThousandSeparator: Char; ' + + 'DecimalSeparator: Char; TwoDigitYearCenturyWindow: Word; NegCurrFormat: Byte; NormalizedLocaleName: string; end;'; + S.AddTypeS( 'TFormatSettings', t ); + {$ELSE} + t := 'CurrencyFormat: Byte; NegCurrFormat: Byte; ThousandSeparator: Char; DecimalSeparator: Char; CurrencyDecimals: Byte; DateSeparator: Char; TimeSeparator: Char; ListSeparator: Char; CurrencyString: string; ShortDateFormat: string; LongDateFormat: string; ' + + 'TimeAMString: string; TimePMString: string; ShortTimeFormat: string; LongTimeFormat: string; ShortMonthNames: array[1..12] of string; LongMonthNames: array[1..12] of string; ShortDayNames: array[1..7] of string; LongDayNames: array[1..7] of string;' + + ' TwoDigitYearCenturyWindow: Word; end;'; + S.AddTypeS( 'TFormatSettings', t ); + {$IFEND} + +// s.AddDelphiFunction('function UpperCase(const S: string): string;' ); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function UpperCaseS(const S: string; LocaleOptions: TLocaleOptions): string;' ); + {$IFEND} +// s.AddDelphiFunction('function LowerCase(const S: string): string;' ); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function LowerCaseS(const S: string; LocaleOptions: TLocaleOptions): string;' ); + {$IFEND} + s.AddDelphiFunction('function CompareStr(const S1, S2: string): Integer;' ); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function CompareStrS(const S1, S2: string; LocaleOptions: TLocaleOptions): Integer;' ); + {$IFEND} + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function SameStr(const S1, S2: string): Boolean;' ); + s.AddDelphiFunction('function SameStrS(const S1, S2: string; LocaleOptions: TLocaleOptions): Boolean;' ); + {$IFEND} + s.AddDelphiFunction('function CompareMem(P1, P2: Pointer; Length: Integer): Boolean;' ); + s.AddDelphiFunction('function CompareText(const S1, S2: string): Integer;' ); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function CompareTextS(const S1, S2: string; LocaleOptions: TLocaleOptions): Integer;' ); + {$IFEND} + s.AddDelphiFunction('function SameText(const S1, S2: string): Boolean;' ); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function SameTextS(const S1, S2: string; LocaleOptions: TLocaleOptions): Boolean;' ); + {$IFEND} +// s.AddDelphiFunction('function AnsiUpperCase(const S: string): string;' ); +// s.AddDelphiFunction('function AnsiLowerCase(const S: string): string;' ); + s.AddDelphiFunction('function AnsiCompareStr(const S1, S2: string): Integer;' ); + s.AddDelphiFunction('function AnsiSameStr(const S1, S2: string): Boolean;' ); + s.AddDelphiFunction('function AnsiCompareText(const S1, S2: string): Integer;' ); + s.AddDelphiFunction('function AnsiSameText(const S1, S2: string): Boolean;' ); + s.AddDelphiFunction('function AnsiStrComp(S1, S2: PChar): Integer;' ); + s.AddDelphiFunction('function AnsiStrIComp(S1, S2: PChar): Integer;' ); + s.AddDelphiFunction('function AnsiStrLComp(S1, S2: PChar; MaxLen: Cardinal): Integer;' ); + s.AddDelphiFunction('function AnsiStrLIComp(S1, S2: PChar; MaxLen: Cardinal): Integer;' ); + s.AddDelphiFunction('function AnsiStrLower(Str: PChar): PChar;' ); + s.AddDelphiFunction('function AnsiStrUpper(Str: PChar): PChar;' ); + s.AddDelphiFunction('function AnsiLastChar(const S: string): PChar;' ); + s.AddDelphiFunction('function AnsiStrLastChar(P: PChar): PChar;' ); + s.AddDelphiFunction('function WideUpperCase(const S: WideString): WideString;' ); + s.AddDelphiFunction('function WideLowerCase(const S: WideString): WideString;' ); + s.AddDelphiFunction('function WideCompareStr(const S1, S2: WideString): Integer;' ); + s.AddDelphiFunction('function WideSameStr(const S1, S2: WideString): Boolean;' ); + s.AddDelphiFunction('function WideCompareText(const S1, S2: WideString): Integer;' ); + s.AddDelphiFunction('function WideSameText(const S1, S2: WideString): Boolean;' ); +// s.AddDelphiFunction('function Trim(const S: string): string;' ); + s.AddDelphiFunction('function TrimLeft(const S: string): string;' ); + s.AddDelphiFunction('function TrimRight(const S: string): string;' ); + s.AddDelphiFunction('function QuotedStr(const S: string): string;' ); + s.AddDelphiFunction('function AnsiQuotedStr(const S: string; Quote: Char): string;' ); + s.AddDelphiFunction('function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string;' ); + s.AddDelphiFunction('function AnsiDequotedStr(const S: string; AQuote: Char): string;' ); + + s.AddDelphiFunction('function GetCurrentDir: string;' ); + s.AddDelphiFunction('function SetCurrentDir(const Dir: string): Boolean;' ); + s.AddDelphiFunction('function CreateDir(const Dir: string): Boolean;' ); + s.AddDelphiFunction('function RemoveDir(const Dir: string): Boolean;' ); + s.AddDelphiFunction('function StrLen(const Str: PChar): Cardinal;' ); + s.AddDelphiFunction('function StrEnd(const Str: PChar): PChar;' ); + s.AddDelphiFunction('function StrMove(Dest: PChar; const Source: PChar; Count: Cardinal): PChar;' ); + s.AddDelphiFunction('function StrCopy(Dest: PChar; const Source: PChar): PChar;' ); + s.AddDelphiFunction('function StrECopy(Dest:PChar; const Source: PChar): PChar;' ); + s.AddDelphiFunction('function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;' ); + s.AddDelphiFunction('function StrPCopy(Dest: PChar; const Source: string): PChar;' ); + s.AddDelphiFunction('function StrPLCopy(Dest: PChar; const Source: string; MaxLen: Cardinal): PChar;' ); + s.AddDelphiFunction('function StrCat(Dest: PChar; const Source: PChar): PChar;' ); + s.AddDelphiFunction('function StrLCat(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;' ); + s.AddDelphiFunction('function StrComp(const Str1, Str2: PChar): Integer;' ); + s.AddDelphiFunction('function StrIComp(const Str1, Str2: PChar): Integer;' ); + s.AddDelphiFunction('function StrLComp(const Str1, Str2: PChar; MaxLen: Cardinal): Integer;' ); + s.AddDelphiFunction('function StrLIComp(const Str1, Str2: PChar; MaxLen: Cardinal): Integer;' ); + s.AddDelphiFunction('function StrScan(const Str: PChar; AChr: Char): PChar;' ); + s.AddDelphiFunction('function StrRScan(const Str: PChar; AChr: Char): PChar;' ); + s.AddDelphiFunction('function StrPos(const Str1, Str2: PChar): PChar;' ); + s.AddDelphiFunction('function StrUpper(Str: PChar): PChar;' ); + s.AddDelphiFunction('function StrLower(Str: PChar): PChar;' ); + s.AddDelphiFunction('function StrPas(const Str: PChar): string;' ); + s.AddDelphiFunction('function StrAlloc(Size: Cardinal): PChar;' ); + s.AddDelphiFunction('function StrBufSize(const Str: PChar): Cardinal;' ); + s.AddDelphiFunction('function StrNew(const Str: PChar): PChar;' ); + s.AddDelphiFunction('procedure StrDispose(Str: PChar);' ); + s.AddDelphiFunction('function Format(const Format: string; const Args: array of const): string;' ); + s.AddDelphiFunction('function FormatS(const Format: string; const Args: array of const; const AFormatSettings: TFormatSettings): string;' ); + s.AddDelphiFunction('procedure FmtStr(var Result: string; const Format: string; const Args: array of const);' ); + s.AddDelphiFunction('procedure FmtStrS(var Result: string; const Format: string; const Args: array of const; const AFormatSettings: TFormatSettings);' ); + s.AddDelphiFunction('function StrFmt(Buffer, Format: PChar; const Args: array of const): PChar;' ); + s.AddDelphiFunction('function StrFmtS(Buffer, Format: PChar; const Args: array of const; const FormatSettings: TFormatSettings): PChar;' ); + s.AddDelphiFunction('function StrLFmt(Buffer: PChar; MaxBufLen: Cardinal; Format: PChar; const Args: array of const): PChar;' ); + s.AddDelphiFunction('function StrLFmtS(Buffer: PChar; MaxBufLen: Cardinal; Format: PChar; const Args: array of const; const FormatSettings: TFormatSettings): PChar;' ); +// s.AddDelphiFunction('function FormatBuf(var Buffer; BufLen: Cardinal; const Format; FmtLen: Cardinal; const Args: array of const): Cardinal;' ); +// s.AddDelphiFunction('function FormatBufS(var Buffer; BufLen: Cardinal; const Format; FmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;' ); + s.AddDelphiFunction('function WideFormat(const Format: WideString; const Args: array of const): WideString;' ); + s.AddDelphiFunction('function WideFormatS(const Format: WideString; const Args: array of const; const AFormatSettings: TFormatSettings): WideString;' ); + s.AddDelphiFunction('procedure WideFmtStr(var Result: WideString; const Format: WideString; const Args: array of const);' ); + s.AddDelphiFunction('procedure WideFmtStrS(var Result: WideString; const Format: WideString; const Args: array of const; const AFormatSettings: TFormatSettings);' ); +// s.AddDelphiFunction('function WideFormatBuf(var Buffer; BufLen: Cardinal; const Format; FmtLen: Cardinal; const Args: array of const): Cardinal;' ); +// s.AddDelphiFunction('function WideFormatBufS(var Buffer; BufLen: Cardinal; const Format; FmtLen: Cardinal; const Args: array of const; const AFormatSettings: TFormatSettings): Cardinal;' ); + + s.AddDelphiFunction('procedure Sleep(milliseconds: Cardinal);'); + s.AddDelphiFunction('function GetModuleName(Module: HMODULE): string;'); + s.AddDelphiFunction('function ByteToCharLen(const S: string; MaxLen: Integer): Integer;'); + s.AddDelphiFunction('function CharToByteLen(const S: string; MaxLen: Integer): Integer;'); + s.AddDelphiFunction('function ByteToCharIndex(const S: string; Index: Integer): Integer;'); + s.AddDelphiFunction('function CharToByteIndex(const S: string; Index: Integer): Integer;'); + s.AddDelphiFunction('function StrCharLength(const Str: PChar): Integer;'); + s.AddDelphiFunction('function StrNextChar(const Str: PChar): PChar;'); + s.AddDelphiFunction('function CharLength(const S: String; Index: Integer): Integer;'); + s.AddDelphiFunction('function NextCharIndex(const S: String; Index: Integer): Integer;'); + s.AddDelphiFunction('function IsPathDelimiter(const S: string; Index: Integer): Boolean;'); + s.AddDelphiFunction('function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;'); + s.AddDelphiFunction('function IncludeTrailingPathDelimiter(const S: string): string;'); + s.AddDelphiFunction('function IncludeTrailingBackslash(const S: string): string; platform;'); + s.AddDelphiFunction('function ExcludeTrailingPathDelimiter(const S: string): string;'); + s.AddDelphiFunction('function ExcludeTrailingBackslash(const S: string): string; platform;'); + s.AddDelphiFunction('function LastDelimiter(const Delimiters, S: string): Integer;'); + s.AddDelphiFunction('function AnsiCompareFileName(const S1, S2: string): Integer;'); + s.AddDelphiFunction('function SameFileName(const S1, S2: string): Boolean;'); + s.AddDelphiFunction('function AnsiLowerCaseFileName(const S: string): string;'); + s.AddDelphiFunction('function AnsiUpperCaseFileName(const S: string): string;'); + s.AddDelphiFunction('function AnsiPos(const Substr, S: string): Integer;'); + s.AddDelphiFunction('function AnsiStrPos(Str, SubStr: PChar): PChar;'); +// s.AddDelphiFunction('function AnsiStrRScan(Str: PChar; Chr: Char): PChar;'); +// s.AddDelphiFunction('function AnsiStrScan(Str: PChar; Chr: Char): PChar;'); + S.AddTypeS( 'TReplaceFlag', '(rfReplaceAll, rfIgnoreCase)' ); + S.AddTypeS( 'TReplaceFlags', 'set of TReplaceFlag' ); + s.AddDelphiFunction('function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;'); + + s.AddDelphiFunction('function CheckWin32Version(AMajor: Integer; AMinor: Integer{ = 0}): Boolean;'); + s.AddDelphiFunction('function GetFileVersion(const AFileName: string): Cardinal;'); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function GetProductVersion(const AFileName: string; var AMajor, AMinor, ABuild: Cardinal): Boolean;'); + {$IFEND} + s.AddDelphiFunction('procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings);'); + + s.AddDelphiFunction('function ForceDirectories(Dir: string): Boolean;'); + s.AddDelphiFunction('function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer;'); + s.AddDelphiFunction('function FindNext(var F: TSearchRec): Integer;'); + s.AddDelphiFunction('procedure FindClose(var F: TSearchRec);'); + s.AddDelphiFunction('function FileGetDate(Handle: Integer): Integer;'); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function FileSetDate(const FileName: string; Age: Integer): Integer;'); + {$ELSE} + s.AddDelphiFunction('function FileSetDate(Handle: THandle; Age: Integer): Integer;'); + {$IFEND} + + s.AddDelphiFunction('function FileIsReadOnly(const FileName: string): Boolean;'); + s.AddDelphiFunction('function FileSetReadOnly(const FileName: string; ReadOnly: Boolean): Boolean;'); + s.AddDelphiFunction('function DeleteFile(const FileName: string): Boolean;'); + s.AddDelphiFunction('function RenameFile(const OldName, NewName: string): Boolean;'); + s.AddDelphiFunction('function ChangeFileExt(const FileName, Extension: string): string;'); + s.AddDelphiFunction('function ExtractFilePath(const FileName: string): string;'); + s.AddDelphiFunction('function ExtractFileDir(const FileName: string): string;'); + s.AddDelphiFunction('function ExtractFileDrive(const FileName: string): string;'); + s.AddDelphiFunction('function ExtractFileName(const FileName: string): string;'); + s.AddDelphiFunction('function ExtractFileExt(const FileName: string): string;'); + s.AddDelphiFunction('function ExpandFileName(const FileName: string): string;'); + + S.AddTypeS( 'TFilenameCaseMatch', '(mkNone, mkExactMatch, mkSingleMatch, mkAmbiguous)' ); + s.AddDelphiFunction('function ExpandFileNameCase(const FileName: string; out MatchFound: TFilenameCaseMatch): string;'); + s.AddDelphiFunction('function ExpandUNCFileName(const FileName: string): string;'); + s.AddDelphiFunction('function ExtractRelativePath(const BaseName, DestName: string): string;'); + + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function ChangeFilePath(const FileName : String; Path: string): string;'); + s.AddDelphiFunction('function GetHomePath: string;'); + {$IFEND} + + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function FileAge(const FileName: string): LongInt;'); + s.AddDelphiFunction('function FileExists(const FileName: string; FollowLink: Boolean{ = True}): Boolean;'); + s.AddDelphiFunction('function DirectoryExists(const Directory: string; FollowLink: Boolean{ = True}): Boolean;'); + {$ELSE} + s.AddDelphiFunction('function FileAge(const FileName: string): Integer;'); + s.AddDelphiFunction('function FileExists(const FileName: string): Boolean;'); + s.AddDelphiFunction('function DirectoryExists(const Directory: string{; FollowLink: Boolean = True}): Boolean;'); + {$IFEND} + + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function IsValidIdent(const Ident: string; AllowDots: Boolean{ = False}): Boolean;'); + {$ELSE} + s.AddDelphiFunction('function IsValidIdent(const Ident: string): Boolean;'); + {$IFEND} + + s.AddDelphiFunction('function StrToBool(const S: string): Boolean;'); + s.AddDelphiFunction('function StrToBoolDef(const S: string; const Default: Boolean): Boolean;'); + s.AddDelphiFunction('function TryStrToBool(const S: string; out Value: Boolean): Boolean;'); + s.AddDelphiFunction('function BoolToStr(B: Boolean; UseBoolStrs: Boolean{ = False}): string;'); + + s.AddDelphiFunction('function ExtractShortPathName(const FileName: string): string;'); + s.AddDelphiFunction('function FileSearch(const Name, DirList: string): string;'); + s.AddDelphiFunction('function DiskFree(Drive: Byte): Int64;'); + s.AddDelphiFunction('function DiskSize(Drive: Byte): Int64;'); + s.AddDelphiFunction('function GetCurrentDir: string;'); +// s.AddDelphiFunction('function FloatToStr(Value: Extended): string;'); + s.AddDelphiFunction('function FloatToStrS(Value: Extended; const FormatSettings: TFormatSettings): string;'); + s.AddDelphiFunction('function CurrToStr(Value: Currency): string;'); + s.AddDelphiFunction('function CurrToStrS(Value: Currency; const FormatSettings: TFormatSettings): string;'); + s.AddDelphiFunction('function FloatToCurr(const Value: Extended): Currency;'); + s.AddDelphiFunction('function TryFloatToCurr(const Value: Extended; out AResult: Currency): Boolean;'); + s.AddDelphiFunction('function FloatToStrF(Value: Extended; Format: TFloatFormat; Precision: Integer; Digits: Integer): string;'); + s.AddDelphiFunction('function FloatToStrFS(Value: Extended; Format: TFloatFormat; Precision: Integer; Digits: Integer; const FormatSettings: TFormatSettings): string;'); + s.AddDelphiFunction('function CurrToStrF(Value: Currency; Format: TFloatFormat; Digits: Integer): string;'); + s.AddDelphiFunction('function CurrToStrFS(Value: Currency; Format: TFloatFormat; Digits: Integer; const FormatSettings: TFormatSettings): string;'); +// s.AddDelphiFunction('function FloatToText(BufferArg: PChar; const Value; ValueType: TFloatValue; Format: TFloatFormat; Precision: Integer; Digits: Integer): Integer;'); +// s.AddDelphiFunction('function FloatToTextS(BufferArg: PChar; const Value; ValueType: TFloatValue; Format: TFloatFormat; Precision: Integer; Digits: Integer; const FormatSettings: TFormatSettings): Integer;'); + s.AddDelphiFunction('function FormatFloat(const Format: string; Value: Extended): string;'); + s.AddDelphiFunction('function FormatFloatS(const Format: string; Value: Extended; const FormatSettings: TFormatSettings): string;'); + s.AddDelphiFunction('function FormatCurr(const Format: string; Value: Currency): string;'); + s.AddDelphiFunction('function FormatCurrS(const Format: string; Value: Currency; const FormatSettings: TFormatSettings): string;'); +// s.AddDelphiFunction('function FloatToTextFmt(Buf: PChar; const Value; ValueType: TFloatValue; Format: PChar): Integer;'); +// s.AddDelphiFunction('function FloatToTextFmtS(Buf: PChar; const Value; ValueType: TFloatValue; Format: PChar; const FormatSettings: TFormatSettings): Integer;'); +// s.AddDelphiFunction('function StrToFloat(const S: string): Extended;'); + s.AddDelphiFunction('function StrToFloatS(const S: string; const FormatSettings: TFormatSettings): Extended;'); + s.AddDelphiFunction('function StrToFloatDef(const S: string; const Default: Extended): Extended;'); + s.AddDelphiFunction('function StrToFloatDefS(const S: string; const Default: Extended; const FormatSettings: TFormatSettings): Extended;'); + s.AddDelphiFunction('function TryStrToFloat(const S: string; out Value: Extended): Boolean;'); + s.AddDelphiFunction('function TryStrToFloatS(const S: string; out Value: Extended; const FormatSettings: TFormatSettings): Boolean;'); + s.AddDelphiFunction('function TryStrToFloat(const S: string; out Value: Double): Boolean;'); + s.AddDelphiFunction('function TryStrToFloatS(const S: string; out Value: Double; const FormatSettings: TFormatSettings): Boolean;'); + s.AddDelphiFunction('function TryStrToFloat(const S: string; out Value: Single): Boolean;'); + s.AddDelphiFunction('function TryStrToFloatS(const S: string; out Value: Single; const FormatSettings: TFormatSettings): Boolean;'); + s.AddDelphiFunction('function StrToCurr(const S: string): Currency;'); + s.AddDelphiFunction('function StrToCurrS(const S: string; const FormatSettings: TFormatSettings): Currency;'); + s.AddDelphiFunction('function StrToCurrDef(const S: string; const Default: Currency): Currency;'); + s.AddDelphiFunction('function StrToCurrDefS(const S: string; const Default: Currency; const FormatSettings: TFormatSettings): Currency;'); + s.AddDelphiFunction('function TryStrToCurr(const S: string; out Value: Currency): Boolean;'); + s.AddDelphiFunction('function TryStrToCurrS(const S: string; out Value: Currency; const FormatSettings: TFormatSettings): Boolean;'); +// s.AddDelphiFunction('procedure FloatToDecimal(var Result: TFloatRec; const Value; ValueType: TFloatValue; Precision: Integer; Decimals: Integer);'); +// s.AddDelphiFunction('function TextToFloat(Buffer: PChar; var Value; ValueType: TFloatValue): Boolean;'); +// s.AddDelphiFunction('function TextToFloatS(Buffer: PChar; var Value; ValueType: TFloatValue; const FormatSettings: TFormatSettings): Boolean;'); + + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function TextToExtended(const S: string; var Value: Extended): Boolean;'); + s.AddDelphiFunction('function TextToExtendedS(const S: string; var Value: Extended; const AFormatSettings: TFormatSettings): Boolean;'); + s.AddDelphiFunction('function TextToDouble(const S: string; var Value: Double): Boolean;'); + s.AddDelphiFunction('function TextToDoubleS(const S: string; var Value: Double; const AFormatSettings: TFormatSettings): Boolean;'); + s.AddDelphiFunction('function TextToCurrency(const S: string; var Value: Currency): Boolean;'); + s.AddDelphiFunction('function TextToCurrencyS(const S: string; var Value: Currency; const AFormatSettings: TFormatSettings): Boolean;'); +// s.AddDelphiFunction('function HashName(Name: MarshaledAString): Cardinal;'); + {$IFEND} + + s.AddDelphiFunction('function IntToHexD(Value: Integer; Digits: Integer): string;'); + s.AddDelphiFunction('function Int64ToHexD(Value: Int64; Digits: Integer): string;'); + s.AddDelphiFunction('function TryStrToInt(const S: string; out Value: Integer): Boolean;'); + s.AddDelphiFunction('function TryStrToInt64(const S: string; out Value: Int64): Boolean;'); + + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function LoadStr(Ident: NativeUInt): string;'); + s.AddDelphiFunction('function FmtLoadStr(Ident: NativeUInt; const Args: array of const): string;'); + {$ELSE} + s.AddDelphiFunction('function LoadStr(Ident: Integer): string;'); + s.AddDelphiFunction('function FmtLoadStr(Ident: Integer; const Args: array of const): string;'); + {$IFEND} + s.AddDelphiFunction('function FileOpen(const FileName: string; Mode: LongWord): THandle;'); + s.AddDelphiFunction('function FileCreate(const FileName: string): THandle;'); + s.AddDelphiFunction('function FileCreateA(const FileName: string; Rights: Integer): THandle;'); + +// s.AddDelphiFunction('function FileRead(Handle: THandle; var Buffer; Count: LongWord): Integer;'); +// s.AddDelphiFunction('function FileWrite(Handle: THandle; const Buffer; Count: LongWord): Integer;'); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function FileRead(Handle: THandle; var Buffer: TBytes; Offset, Count: LongWord): Integer;'); + s.AddDelphiFunction('function FileWrite(Handle: THandle; const Buffer:TBytes; Offset, Count: LongWord): Integer;'); + {$IFEND} +// s.AddDelphiFunction('function FileSeek(Handle: THandle; Offset: Integer; Origin: Integer): Integer;'); + s.AddDelphiFunction('function FileSeek(Handle: THandle; const Offset: Int64; Origin: Integer): Int64;'); + s.AddDelphiFunction('procedure FileClose(Handle: THandle);'); + + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function FileSetDate(const FileName: string; Age: LongInt): Integer;'); + s.AddDelphiFunction('function FileGetAttr(const FileName: string; FollowLink: Boolean{ = True}): Integer;'); + s.AddDelphiFunction('function FileSetAttr(const FileName: string; Attr: Integer; FollowLink: Boolean{ = True}): Integer;'); + {$ELSE} + s.AddDelphiFunction('function FileSetDate(Handle: Integer; Age: Integer): Integer;'); + s.AddDelphiFunction('function FileGetAttr(const FileName: string): Integer;'); + s.AddDelphiFunction('function FileSetAttr(const FileName: string; Attr: Integer): Integer;'); + {$IFEND} + + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function ShortIntToHex(Value: ShortInt): string;'); + s.AddDelphiFunction('function ByteToHex(Value: Byte): string;'); + s.AddDelphiFunction('function SmallIntToHex(Value: SmallInt): string;'); + s.AddDelphiFunction('function WordToHex(Value: Word): string;'); + s.AddDelphiFunction('function IntToHex(Value: Integer): string;'); + s.AddDelphiFunction('function CardinalToHex(Value: Cardinal): string;'); + s.AddDelphiFunction('function Int64ToHex(Value: Int64): string;'); + s.AddDelphiFunction('function UInt64ToHex(Value: UInt64): string;'); + s.AddDelphiFunction('function UInt64ToHexD(Value: UInt64; Digits: Integer): string;'); + s.AddDelphiFunction('function StrToUInt(const S: string): Cardinal;'); + s.AddDelphiFunction('function StrToUIntDef(const S: string; Default: Cardinal): Cardinal;'); + s.AddDelphiFunction('function TryStrToUInt(const S: string; out Value: Cardinal): Boolean;'); + s.AddDelphiFunction('function StrToUInt64Def(const S: string; const Default: UInt64): UInt64;'); + s.AddDelphiFunction('function TryStrToUInt64(const S: string; out Value: UInt64): Boolean;'); + s.AddDelphiFunction('function IsRelativePath(const Path: string): Boolean;'); + s.AddDelphiFunction('function IsAssembly(const FileName: string): Boolean;'); + + s.AddDelphiFunction('function FileCreate(const FileName: string; Mode: LongWord; Rights: Integer): THandle;'); + s.AddDelphiFunction('function FileCreateSymLink(const Link, Target: string): Boolean;'); + + S.AddTypeS( 'TSymLinkRec', 'record TargetName: TFileName; Attr: Integer; Size: Int64; FindData: TWin32FindData; end;' ); + s.AddDelphiFunction('function FileGetSymLinkTarget(const FileName: string; var SymLinkRec: TSymLinkRec): Boolean;'); + s.AddDelphiFunction('function FileGetSymLinkTarget(const FileName: string; var TargetName: string): Boolean;'); + + S.AddTypeS( 'TFileSystemAttribute', '(fsCaseSensitive, fsCasePreserving, fsLocal, fsNetwork, fsRemovable, fsSymLink)' ); + S.AddTypeS( 'TFileSystemAttributes', 'set of TFileSystemAttribute' ); + s.AddDelphiFunction('function FileSystemAttributes(const Path: string): TFileSystemAttributes;'); + s.AddDelphiFunction('function FileGetDateTimeInfo(const FileName: string; out DateTime: TWin32FindData{TDateTimeInfoRec}; FollowLink: Boolean{ = True}): Boolean;'); + {$IFEND} +end; + +end. diff --git a/Source/uPSC_dateutils.pas b/Source/uPSC_dateutils.pas index 1b95673f..d07ff67d 100644 --- a/Source/uPSC_dateutils.pas +++ b/Source/uPSC_dateutils.pas @@ -1,34 +1,336 @@ { Compile time Date Time library } -unit uPSC_dateutils; +unit uPSC_DateUtils; interface + uses SysUtils, uPSCompiler, uPSUtils; - procedure RegisterDateTimeLibrary_C(S: TPSPascalCompiler); implementation +uses + DateUtils; + procedure RegisterDatetimeLibrary_C(S: TPSPascalCompiler); +var + Str : AnsiString; begin s.AddType('TDateTime', btDouble).ExportName := True; + {$IF CompilerVersion >= 28} + s.AddType('TDate', btDouble).ExportName := True; + s.AddType('TTime', btDouble).ExportName := True; + {$IFEND} + s.AddType('Comp', {$IFNDEF PS_NOINT64}btS64{$ELSE}btS32{$ENDIF}).ExportName := True; + + s.AddTypeS('TTimeStamp', 'record Time: Integer; Date: Integer; end;'); + s.AddTypeS('TSystemTime', 'record wYear: Word; wMonth: Word; wDayOfWeek: Word; wDay: Word; wHour: Word; wMinute: Word; wSecond: Word; wMilliseconds: Word; end;' ); + + S.AddConstant( 'MinDateTime', MinDateTime ); + S.AddConstant( 'MaxDateTime', MaxDateTime ); + + {$IF CompilerVersion >= 28} + s.AddTypeS('TEraInfo', 'record EraName: string; EraOffset: Integer; EraStart: TDate; EraEnd: TDate; end' ); + Str := 'record CurrencyString: string; CurrencyFormat: Byte; CurrencyDecimals: Byte; DateSeparator: Char; TimeSeparator: Char; ListSeparator: Char; ShortDateFormat: string; LongDateFormat: string; TimeAMString: string; TimePMString: string; ' + + 'ShortTimeFormat: string; LongTimeFormat: string; ShortMonthNames: array[1..12] of string; LongMonthNames: array[1..12] of string; ShortDayNames: array[1..7] of string; LongDayNames: array[1..7] of string; EraInfo: array of TEraInfo; ' + + 'ThousandSeparator: Char; DecimalSeparator: Char; TwoDigitYearCenturyWindow: Word; NegCurrFormat: Byte; NormalizedLocaleName: string; end;'; + s.AddTypeS( 'TFormatSettings', Str ); + {$ELSE} + Str := 'record CurrencyFormat: Byte; NegCurrFormat: Byte; ThousandSeparator: Char; DecimalSeparator: Char; CurrencyDecimals: Byte; DateSeparator: Char; TimeSeparator: Char; ListSeparator: Char; CurrencyString: string; ShortDateFormat: string; ' + + 'LongDateFormat: string; TimeAMString: string; TimePMString: string; ShortTimeFormat: string; LongTimeFormat: string; ShortMonthNames: array[1..12] of string; LongMonthNames: array[1..12] of string; ShortDayNames: array[1..7] of string; ' + + 'LongDayNames: array[1..7] of string; TwoDigitYearCenturyWindow: Word; end'; + s.AddTypeS( 'TFormatSettings', Str ); + {$IFEND} + + S.AddConstant('HoursPerDay', HoursPerDay); + S.AddConstant('MinsPerHour', MinsPerHour); + S.AddConstant('SecsPerMin', SecsPerMin); + S.AddConstant('MSecsPerSec', MSecsPerSec); + S.AddConstant('MinsPerDay', MinsPerDay); + S.AddConstant('SecsPerDay', SecsPerDay); + {$IF CompilerVersion >= 28} + S.AddConstant('SecsPerHour', SecsPerHour); + S.AddConstant('MSecsPerDay', MSecsPerDay); + {$IFEND} + + S.AddConstant('DateDelta', DateDelta); + S.AddConstant('UnixDateDelta', UnixDateDelta); + + s.AddDelphiFunction('function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;'); + s.AddDelphiFunction('function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;'); + s.AddDelphiFunction('function MSecsToTimeStamp(MSecs: Comp): TTimeStamp;'); + s.AddDelphiFunction('function TimeStampToMSecs(const TimeStamp: TTimeStamp): Comp;'); + s.AddDelphiFunction('function EncodeDate(Year, Month, Day: Word): TDateTime;'); s.AddDelphiFunction('function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;'); s.AddDelphiFunction('function TryEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;'); s.AddDelphiFunction('function TryEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;'); s.AddDelphiFunction('procedure DecodeDate(const DateTime: TDateTime; var Year, Month, Day: Word);'); + s.AddDelphiFunction('function DecodeDateFully(const DateTime: TDateTime; var Year, Month, Day, DOW: Word): Boolean;'); s.AddDelphiFunction('procedure DecodeTime(const DateTime: TDateTime; var Hour, Min, Sec, MSec: Word);'); + + {$IFDEF MSWINDOWS} + s.AddDelphiFunction('procedure DateTimeToSystemTime(const DateTime: TDateTime; var SystemTime: TSystemTime);'); + s.AddDelphiFunction('function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;'); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function TrySystemTimeToDateTime(const SystemTime: TSystemTime; out DateTime: TDateTime): Boolean;'); + {$IFEND} + {$ENDIF MSWINDOWS} + + // SysUtils s.AddDelphiFunction('function DayOfWeek(const DateTime: TDateTime): Word;'); s.AddDelphiFunction('function Date: TDateTime;'); s.AddDelphiFunction('function Time: TDateTime;'); s.AddDelphiFunction('function Now: TDateTime;'); - s.AddDelphiFunction('function DateTimeToUnix(D: TDateTime): Int64;'); - s.AddDelphiFunction('function UnixToDateTime(U: Int64): TDateTime;'); - - s.AddDelphiFunction('function DateToStr(D: TDateTime): string;'); + s.AddDelphiFunction('function CurrentYear: Word;'); + s.AddDelphiFunction('function IncMonth(const DateTime: TDateTime; NumberOfMonths: Integer{ = 1}): TDateTime;'); + s.AddDelphiFunction('procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer{ = 1});'); + s.AddDelphiFunction('procedure ReplaceTime(var DateTime: TDateTime; const NewTime: TDateTime);'); + s.AddDelphiFunction('procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime);'); + s.AddDelphiFunction('function IsLeapYear(Year: Word): Boolean;'); + s.AddDelphiFunction('function DateToStr(const DateTime: TDateTime): string;'); + s.AddDelphiFunction('function DateToStrS(const DateTime: TDateTime; const AFormatSettings: TFormatSettings): string;'); + s.AddDelphiFunction('function TimeToStr(const DateTime: TDateTime): string;'); + s.AddDelphiFunction('function TimeToStrS(const DateTime: TDateTime; const AFormatSettings: TFormatSettings): string;'); + s.AddDelphiFunction('function DateTimeToStr(const DateTime: TDateTime): string;'); + s.AddDelphiFunction('function DateTimeToStrS(const DateTime: TDateTime; const AFormatSettings: TFormatSettings): string;'); s.AddDelphiFunction('function StrToDate(const S: string): TDateTime;'); + s.AddDelphiFunction('function StrToDateS(const S: string; const AFormatSettings: TFormatSettings): TDateTime;'); + s.AddDelphiFunction('function StrToDateDef(const S: string; const Default: TDateTime): TDateTime;'); + s.AddDelphiFunction('function StrToDateDefS(const S: string; const Default: TDateTime; const AFormatSettings: TFormatSettings): TDateTime;'); + s.AddDelphiFunction('function TryStrToDate(const S: string; out Value: TDateTime): Boolean;'); + s.AddDelphiFunction('function TryStrToDateS(const S: string; out Value: TDateTime; const AFormatSettings: TFormatSettings): Boolean;'); + s.AddDelphiFunction('function StrToTime(const S: string): TDateTime;'); + s.AddDelphiFunction('function StrToTimeS(const S: string; const AFormatSettings: TFormatSettings): TDateTime;'); + s.AddDelphiFunction('function StrToTimeDef(const S: string; const Default: TDateTime): TDateTime;'); + s.AddDelphiFunction('function StrToTimeDefS(const S: string; const Default: TDateTime; const AFormatSettings: TFormatSettings): TDateTime;'); + s.AddDelphiFunction('function TryStrToTime(const S: string; out Value: TDateTime): Boolean;'); + s.AddDelphiFunction('function TryStrToTimeS(const S: string; out Value: TDateTime; const AFormatSettings: TFormatSettings): Boolean;'); + s.AddDelphiFunction('function StrToDateTime(const S: string): TDateTime;'); + s.AddDelphiFunction('function StrToDateTimeS(const S: string; const AFormatSettings: TFormatSettings): TDateTime;'); + s.AddDelphiFunction('function StrToDateTimeDef(const S: string; const Default: TDateTime): TDateTime;'); + s.AddDelphiFunction('function StrToDateTimeDefS(const S: string; const Default: TDateTime; const AFormatSettings: TFormatSettings): TDateTime;'); + s.AddDelphiFunction('function TryStrToDateTime(const S: string; out Value: TDateTime): Boolean;'); + s.AddDelphiFunction('function TryStrToDateTimeS(const S: string; out Value: TDateTime; const AFormatSettings: TFormatSettings): Boolean;'); s.AddDelphiFunction('function FormatDateTime(const fmt: string; D: TDateTime): string;'); + s.AddDelphiFunction('function FormatDateTimeS(const Format: string; DateTime: TDateTime; const AFormatSettings: TFormatSettings): string;'); + s.AddDelphiFunction('procedure DateTimeToString(var Result: string; const Format: string; DateTime: TDateTime);'); + s.AddDelphiFunction('procedure DateTimeToStringS(var Result: string; const Format: string; DateTime: TDateTime; const AFormatSettings: TFormatSettings);'); + s.AddDelphiFunction('function FloatToDateTime(const Value: Extended): TDateTime;'); + s.AddDelphiFunction('function TryFloatToDateTime(const Value: Extended; out AResult: TDateTime): Boolean;'); + s.AddDelphiFunction('function FileDateToDateTime(FileDate: LongInt): TDateTime;' ); + s.AddDelphiFunction('function DateTimeToFileDate(DateTime: TDateTime): LongInt;' ); + + // DateUtils + s.AddDelphiFunction('function DateOf(const AValue: TDateTime): TDateTime;'); + s.AddDelphiFunction('function TimeOf(const AValue: TDateTime): TDateTime;'); + s.AddDelphiFunction('function IsInLeapYear(const AValue: TDateTime): Boolean;'); + s.AddDelphiFunction('function IsPM(const AValue: TDateTime): Boolean;'); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function IsAM(const AValue: TDateTime): Boolean;'); + {$IFEND} + s.AddDelphiFunction('function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;'); + s.AddDelphiFunction('function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;'); + s.AddDelphiFunction('function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;'); + s.AddDelphiFunction('function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;'); + s.AddDelphiFunction('function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;'); + s.AddDelphiFunction('function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;'); + s.AddDelphiFunction('function WeeksInYear(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function WeeksInAYear(const AYear: Word): Word;'); + s.AddDelphiFunction('function DaysInYear(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function DaysInAYear(const AYear: Word): Word;'); + s.AddDelphiFunction('function DaysInMonth(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function DaysInAMonth(const AYear, AMonth: Word): Word;'); + s.AddDelphiFunction('function Today: TDateTime;'); + s.AddDelphiFunction('function Yesterday: TDateTime;'); + s.AddDelphiFunction('function Tomorrow: TDateTime;'); + s.AddDelphiFunction('function IsToday(const AValue: TDateTime): Boolean;'); + s.AddDelphiFunction('function IsSameDay(const AValue, ABasis: TDateTime): Boolean;'); + s.AddDelphiFunction('function YearOf(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function MonthOf(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function WeekOf(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function DayOf(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function HourOf(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function MinuteOf(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function SecondOf(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function MilliSecondOf(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function StartOfTheYear(const AValue: TDateTime): TDateTime;'); + s.AddDelphiFunction('function EndOfTheYear(const AValue: TDateTime): TDateTime;'); + s.AddDelphiFunction('function StartOfAYear(const AYear: Word): TDateTime;'); + s.AddDelphiFunction('function EndOfAYear(const AYear: Word): TDateTime;'); + s.AddDelphiFunction('function StartOfTheMonth(const AValue: TDateTime): TDateTime;'); + s.AddDelphiFunction('function EndOfTheMonth(const AValue: TDateTime): TDateTime;'); + s.AddDelphiFunction('function StartOfAMonth(const AYear, AMonth: Word): TDateTime;'); + s.AddDelphiFunction('function EndOfAMonth(const AYear, AMonth: Word): TDateTime;'); + s.AddDelphiFunction('function StartOfTheWeek(const AValue: TDateTime): TDateTime;'); + s.AddDelphiFunction('function EndOfTheWeek(const AValue: TDateTime): TDateTime;'); + s.AddDelphiFunction('function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word{ = 1}): TDateTime;'); + s.AddDelphiFunction('function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word{ = 7}): TDateTime;'); + s.AddDelphiFunction('function StartOfTheDay(const AValue: TDateTime): TDateTime;'); + s.AddDelphiFunction('function EndOfTheDay(const AValue: TDateTime): TDateTime;'); + s.AddDelphiFunction('function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime;'); + s.AddDelphiFunction('function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime;'); + s.AddDelphiFunction('function MonthOfTheYear(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function WeekOfTheYear(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function DayOfTheYear(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function HourOfTheYear(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function MinuteOfTheYear(const AValue: TDateTime): Cardinal;'); + s.AddDelphiFunction('function SecondOfTheYear(const AValue: TDateTime): Cardinal;'); + s.AddDelphiFunction('function MilliSecondOfTheYear(const AValue: TDateTime): Int64;'); + s.AddDelphiFunction('function WeekOfTheMonth(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function DayOfTheMonth(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function HourOfTheMonth(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function MinuteOfTheMonth(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function SecondOfTheMonth(const AValue: TDateTime): Cardinal;'); + s.AddDelphiFunction('function MilliSecondOfTheMonth(const AValue: TDateTime): Cardinal;'); + s.AddDelphiFunction('function DayOfTheWeek(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function HourOfTheWeek(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function MinuteOfTheWeek(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function SecondOfTheWeek(const AValue: TDateTime): Cardinal;'); + s.AddDelphiFunction('function MilliSecondOfTheWeek(const AValue: TDateTime): Cardinal;'); + s.AddDelphiFunction('function HourOfTheDay(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function MinuteOfTheDay(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function SecondOfTheDay(const AValue: TDateTime): Cardinal;'); + s.AddDelphiFunction('function MilliSecondOfTheDay(const AValue: TDateTime): Cardinal;'); + s.AddDelphiFunction('function MinuteOfTheHour(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function SecondOfTheHour(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function MilliSecondOfTheHour(const AValue: TDateTime): Cardinal;'); + s.AddDelphiFunction('function SecondOfTheMinute(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function MilliSecondOfTheMinute(const AValue: TDateTime): Cardinal;'); + s.AddDelphiFunction('function MilliSecondOfTheSecond(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;'); + s.AddDelphiFunction('function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;'); + s.AddDelphiFunction('function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;'); + s.AddDelphiFunction('function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;'); + s.AddDelphiFunction('function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;'); + s.AddDelphiFunction('function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;'); + s.AddDelphiFunction('function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;'); + s.AddDelphiFunction('function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;'); + s.AddDelphiFunction('function YearsBetween(const ANow, AThen: TDateTime): Integer;'); + s.AddDelphiFunction('function MonthsBetween(const ANow, AThen: TDateTime): Integer;'); + s.AddDelphiFunction('function WeeksBetween(const ANow, AThen: TDateTime): Integer;'); + s.AddDelphiFunction('function DaysBetween(const ANow, AThen: TDateTime): Integer;'); + s.AddDelphiFunction('function HoursBetween(const ANow, AThen: TDateTime): Int64;'); + s.AddDelphiFunction('function MinutesBetween(const ANow, AThen: TDateTime): Int64;'); + s.AddDelphiFunction('function SecondsBetween(const ANow, AThen: TDateTime): Int64;'); + s.AddDelphiFunction('function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;'); + {$IF CompilerVersion >= 28} + s.AddDelphiFunction('function DateTimeInRange(ADateTime: TDateTime; AStartDateTime, AEndDateTime: TDateTime; aInclusive: Boolean{ = True}): Boolean;'); + s.AddDelphiFunction('function DateInRange(ADate: TDate; AStartDate, AEndDate: TDate; AInclusive: Boolean{ = True}): Boolean;'); + s.AddDelphiFunction('function TimeInRange(ATime: TTime; AStartTime, AEndTime: TTime; AInclusive: Boolean{ = True}): Boolean;'); + {$IFEND} + s.AddDelphiFunction('function YearSpan(const ANow, AThen: TDateTime): Double;'); + s.AddDelphiFunction('function MonthSpan(const ANow, AThen: TDateTime): Double;'); + s.AddDelphiFunction('function WeekSpan(const ANow, AThen: TDateTime): Double;'); + s.AddDelphiFunction('function DaySpan(const ANow, AThen: TDateTime): Double;'); + s.AddDelphiFunction('function HourSpan(const ANow, AThen: TDateTime): Double;'); + s.AddDelphiFunction('function MinuteSpan(const ANow, AThen: TDateTime): Double;'); + s.AddDelphiFunction('function SecondSpan(const ANow, AThen: TDateTime): Double;'); + s.AddDelphiFunction('function MilliSecondSpan(const ANow, AThen: TDateTime): Double;'); + s.AddDelphiFunction('function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer{ = 1}): TDateTime;'); + s.AddDelphiFunction('function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer{ = 1}): TDateTime;'); + s.AddDelphiFunction('function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer{ = 1}): TDateTime;'); + s.AddDelphiFunction('function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64{ = 1}): TDateTime;'); + s.AddDelphiFunction('function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64{ = 1}): TDateTime;'); + s.AddDelphiFunction('function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64{ = 1}): TDateTime;'); + s.AddDelphiFunction('function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64{ = 1}): TDateTime;'); + s.AddDelphiFunction('function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;'); + s.AddDelphiFunction('procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);'); + s.AddDelphiFunction('function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word{ = 1}): TDateTime;'); + s.AddDelphiFunction('procedure DecodeDateWeek(const AValue: TDateTime; out AYear, AWeekOfYear, ADayOfWeek: Word);'); + s.AddDelphiFunction('function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;'); + s.AddDelphiFunction('procedure DecodeDateDay(const AValue: TDateTime; out AYear, ADayOfYear: Word);'); + s.AddDelphiFunction('function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;'); + s.AddDelphiFunction('procedure DecodeDateMonthWeek(const AValue: TDateTime; out AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);'); + s.AddDelphiFunction('function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; out AValue: TDateTime): Boolean;'); + s.AddDelphiFunction('function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; out AValue: TDateTime; const ADayOfWeek: Word{ = 1}): Boolean;'); + s.AddDelphiFunction('function TryEncodeDateDay(const AYear, ADayOfYear: Word; out AValue: TDateTime): Boolean;'); + s.AddDelphiFunction('function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;'); + s.AddDelphiFunction('function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;'); + s.AddDelphiFunction('function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;'); + s.AddDelphiFunction('function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;'); + s.AddDelphiFunction('function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;'); + s.AddDelphiFunction('function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;'); + s.AddDelphiFunction('function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;'); + s.AddDelphiFunction('function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;'); + s.AddDelphiFunction('function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;'); + s.AddDelphiFunction('function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;'); + s.AddDelphiFunction('function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;'); + s.AddDelphiFunction('function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; out AResult: TDateTime): Boolean;'); + s.AddDelphiFunction('function CompareDateTime(const A, B: TDateTime): ShortInt{TValueRelationship};'); + s.AddDelphiFunction('function SameDateTime(const A, B: TDateTime): Boolean;'); + s.AddDelphiFunction('function CompareDate(const A, B: TDateTime): ShortInt{TValueRelationship};'); + s.AddDelphiFunction('function SameDate(const A, B: TDateTime): Boolean;'); + s.AddDelphiFunction('function CompareTime(const A, B: TDateTime): ShortInt{TValueRelationship};'); + s.AddDelphiFunction('function SameTime(const A, B: TDateTime): Boolean;'); + s.AddDelphiFunction('function NthDayOfWeek(const AValue: TDateTime): Word;'); + s.AddDelphiFunction('procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; out AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);'); + s.AddDelphiFunction('function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;'); + s.AddDelphiFunction('function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; out AValue: TDateTime): Boolean;'); + s.AddDelphiFunction('procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime{ = 0});'); + s.AddDelphiFunction('procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);'); + s.AddDelphiFunction('procedure InvalidDateDayError(const AYear, ADayOfYear: Word);'); + s.AddDelphiFunction('procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);'); + s.AddDelphiFunction('procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);'); + s.AddDelphiFunction('function DateTimeToJulianDate(const AValue: TDateTime): Double;'); + s.AddDelphiFunction('function JulianDateToDateTime(const AValue: Double): TDateTime;'); + s.AddDelphiFunction('function TryJulianDateToDateTime(const AValue: Double; out ADateTime: TDateTime): Boolean;'); + s.AddDelphiFunction('function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;'); + s.AddDelphiFunction('function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;'); + s.AddDelphiFunction('function TryModifiedJulianDateToDateTime(const AValue: Double; out ADateTime: TDateTime): Boolean;'); + s.AddDelphiFunction('function DateTimeToUnix(const AValue: TDateTime; AInputIsUTC: Boolean{ = True}): Int64;'); + s.AddDelphiFunction('function UnixToDateTime(const AValue: Int64; AReturnUTC: Boolean{ = True}): TDateTime;'); + {$IF CompilerVersion > 23} + s.AddDelphiFunction('function DateTimeToMilliseconds(const ADateTime: TDateTime): Int64;'); + s.AddDelphiFunction('function TimeToMilliseconds(const ATime: TTime): Integer;'); + s.AddDelphiFunction('function ISO8601ToDate(const AISODate: string; AReturnUTC: Boolean{ = True}): TDateTime;'); + s.AddDelphiFunction('function TryISO8601ToDate(const AISODate: string; out Value: TDateTime; AReturnUTC: Boolean{ = True}): Boolean;'); + s.AddDelphiFunction('function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean{ = True}): string;'); + {$IFEND} + + {$IF CompilerVersion >= 28} + S.AddTypeS('TLocalTimeType', '(lttStandard, lttDaylight, lttAmbiguous, lttInvalid)'); + {$IFEND} + s.AddConstant('DaysPerWeek',DaysPerWeek); + s.AddConstant('WeeksPerFortnight',WeeksPerFortnight); + S.AddConstant('MonthsPerYear',MonthsPerYear); + S.AddConstant('YearsPerDecade',YearsPerDecade); + S.AddConstant('YearsPerCentury',YearsPerCentury); + S.AddConstant('YearsPerMillennium',YearsPerMillennium); + S.AddConstant('DayMonday',DayMonday); + S.AddConstant('DayTuesday',DayTuesday); + S.AddConstant('DayWednesday',DayWednesday); + S.AddConstant('DayThursday',DayThursday); + S.AddConstant('DayFriday',DayFriday); + S.AddConstant('DaySaturday',DaySaturday); + S.AddConstant('DaySunday',DaySunday); + {$IF CompilerVersion >= 28} + S.AddConstant('MonthJanuary',MonthJanuary); + S.AddConstant('MonthFebruary',MonthFebruary); + S.AddConstant('MonthMarch',MonthMarch); + S.AddConstant('MonthApril',MonthApril); + S.AddConstant('MonthMay',MonthMay); + S.AddConstant('MonthJune',MonthJune); + S.AddConstant('MonthJuly',MonthJuly); + S.AddConstant('MonthAugust',MonthAugust); + S.AddConstant('MonthSeptember',MonthSeptember); + S.AddConstant('MonthOctober',MonthOctober); + S.AddConstant('MonthNovember',MonthNovember); + S.AddConstant('MonthDecember',MonthDecember); + {$IFEND} + S.AddConstant('OneHour',OneHour); + S.AddConstant('OneMinute',OneMinute); + S.AddConstant('OneSecond',OneSecond); + S.AddConstant('OneMillisecond',OneMillisecond); + {$IF CompilerVersion >= 28} + S.AddConstant('EpochAsJulianDate',EpochAsJulianDate); + S.AddConstant('EpochAsUnixDate',EpochAsUnixDate); + {$IFEND} + S.AddConstant('RecodeLeaveFieldAsIs',RecodeLeaveFieldAsIs); + + S.AddConstant('ApproxDaysPerMonth',ApproxDaysPerMonth); + S.AddConstant('ApproxDaysPerYear',ApproxDaysPerYear); end; end. diff --git a/Source/uPSCompiler.pas b/Source/uPSCompiler.pas index 561045c8..57863487 100644 --- a/Source/uPSCompiler.pas +++ b/Source/uPSCompiler.pas @@ -1,6 +1,13 @@ unit uPSCompiler; {$I PascalScript.inc} interface + +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CAST OFF} +{$WARN UNSAFE_CODE OFF} + +{$DEFINE PS_USESSUPPORT} + uses {$IFNDEF DELPHI3UP}{$IFNDEF PS_NOINTERFACES}{$IFNDEF LINUX}Windows, Ole2,{$ENDIF} {$ENDIF}{$ENDIF}SysUtils, uPSUtils; @@ -148,6 +155,9 @@ TIfRVariant = record {$IFNDEF PS_NOINT64} 17: (ts64: Tbts64); {$ENDIF} + {$IFNDEF PS_NOUINT64} + 23: (tu64: Tbtu64); + {$ENDIF} 19: (tchar: tbtChar); {$IFNDEF PS_NOWIDESTRING} 18: (twidestring: Pointer); @@ -155,9 +165,6 @@ TIfRVariant = record {$ENDIF} 21: (ttype: TPSType); 22: (tunistring: Pointer); - {$IFNDEF PS_NOINT64} - 23: (tu64: Tbtu64); - {$ENDIF} end; TPSRecordFieldTypeDef = class(TObject) @@ -711,6 +718,9 @@ TPSConstant = class(TObject) {$IFNDEF PS_NOINT64} procedure SetInt64(const Val: Int64); + {$ENDIF} + + {$IFNDEF PS_NOUINT64} procedure SetUInt64(const Val: UInt64); {$ENDIF} @@ -925,6 +935,7 @@ TPSBlockInfo = class(TObject) TPSOnFunction = procedure(name: tbtString; Pos, Row, Col: Integer) of object; + TPSOnAddFunction = procedure(Declaration: tbtString) of object; TPSPascalCompiler = class protected @@ -967,9 +978,10 @@ TPSPascalCompiler = class FOnFunctionStart: TPSOnFunction; FOnFunctionEnd: TPSOnFunction; FAttributesOpenTokenID, FAttributesCloseTokenID: TPsPasToken; - {$IFNDEF PS_NOINT64} + FOnAddFunction : TPSOnAddFunction; + {$IF NOT Defined( PS_NOINT64 ) AND NOT Defined( PS_NOUINT64 )} FExecIs64Bit: Boolean; - {$ENDIF} + {$IFEND} FWithCount: Integer; FTryCount: Integer; @@ -1078,9 +1090,10 @@ TPSPascalCompiler = class procedure CheckForUnusedVars(Func: TPSInternalProcedure); function ProcIsDuplic(Decl: TPSParametersDecl; const FunctionName, FunctionParamNames: tbtString; const s: tbtString; Func: TPSInternalProcedure): Boolean; public - function GetConstant(const Name: tbtString): TPSConstant; + function GetConstant(const Name: tbtString): TPSConstant; + function GetVariable(const Name: tbtString): TPSVar; - function UseExternalProc(const Name: tbtString): TPSParametersDecl; + function UseExternalProc(const Name: tbtString): TPSParametersDecl; function FindProc(const aName: tbtString): Cardinal; @@ -1146,11 +1159,39 @@ TPSPascalCompiler = class function AddTypeCopyN(const Name, FType: tbtString): TPSType; - function AddConstant(const Name: tbtString; FType: TPSType): TPSConstant; + function AddConstant(const Name: tbtString; FType: TPSType): TPSConstant; overload; function AddConstantN(const Name, FType: tbtString): TPSConstant; - function AddVariable(const Name: tbtString; FType: TPSType): TPSVar; +// function AddConstant(const Name: tbtString; const Value ): TPSConstant; overload; + function AddConstant(const Name: tbtString; const Value: Integer): TPSConstant; overload; + {$IF CompilerVersion > 23} + function AddConstant(const Name: tbtString; const Value: Cardinal): TPSConstant; overload; + {$IFEND} + {$IFNDEF PS_NOINT64} + {$IF CompilerVersion > 23} + function AddConstant(const Name: tbtString; const Value: Int64): TPSConstant; overload; + {$IFEND} + {$ENDIF PS_NOINT64} + {$IFNDEF PS_NOUINT64} + function AddConstant(const Name: tbtString; const Value: UInt64): TPSConstant; overload; + {$ENDIF PS_NOUINT64} + function AddConstant(const Name: tbtString; const Value: tbtString): TPSConstant; overload; + function AddConstant(const Name: tbtString; const Value: tbtChar): TPSConstant; overload; + {$IFNDEF PS_NOWIDESTRING} + function AddConstant(const Name: tbtString; const Value: WideChar): TPSConstant; overload; + function AddConstant(const Name: tbtString; const Value: tbtwidestring): TPSConstant; overload; + {$IF CompilerVersion >= 23} + function AddConstant(const Name: tbtString; const Value: tbtunicodestring): TPSConstant; overload; + {$IFEND} + {$ENDIF PS_NOWIDESTRING} + function AddConstant(const Name: tbtString; const Value: Double): TPSConstant; overload; + function AddConstant(const Name: tbtString; const Value: Extended): TPSConstant; overload; + {$IF CompilerVersion > 23} + function AddConstant(const Name: tbtString; const Value: TDateTime): TPSConstant; overload; + {$IFEND} + + function AddVariable(const Name: tbtString; FType: TPSType): TPSVar; overload; function AddVariableN(const Name, FType: tbtString): TPSVar; @@ -1162,6 +1203,8 @@ TPSPascalCompiler = class function AddUsedPtrVariableN(const Name, FType: tbtString): TPSVar; +// function AddRecordWithRTTI( const ATypeInfo: Pointer ): TPSType; + function FindType(const Name: tbtString): TPSType; function MakeDecl(decl: TPSParametersDecl): tbtString; @@ -1224,9 +1267,11 @@ TPSPascalCompiler = class property AttributesCloseTokenID: TPSPasToken read FAttributesCloseTokenID write FAttributesCloseTokenID; - {$IFNDEF PS_NOINT64} + property OnAddFunction: TPSOnAddFunction read FOnAddFunction write FOnAddFunction; + + {$IF NOT Defined( PS_NOINT64 ) AND NOT Defined( PS_NOUINT64 )} property ExecIs64Bit: Boolean read FExecIs64Bit write FExecIs64Bit; - {$ENDIF} + {$IFEND} {$WARNINGS OFF} property UnitName: tbtString read FUnitName; @@ -1773,7 +1818,8 @@ procedure DisposeVariant(p: PIfRVariant); implementation -uses {$IFDEF DELPHI5}ComObj, {$ENDIF}{$IFDEF PS_FPC_HAS_COM}ComObj, {$ENDIF}Classes, typInfo; +uses + {$IFDEF DELPHI5}ComObj, {$ENDIF}{$IFDEF PS_FPC_HAS_COM}ComObj, {$ENDIF}Classes, typInfo; {$IFDEF DELPHI3UP} resourceString @@ -1908,14 +1954,14 @@ function BlockWriteVariant(BlockInfo: TPSBlockInfo; p: PIfRVariant{$IFNDEF PS_NO var du8: tbtu8; du16: tbtu16; - {$IFNDEF PS_NOINT64} + {$IF NOT Defined( PS_NOINT64 ) AND NOT Defined( PS_NOUINT64 ) } {$IFDEF CPU64_and_TExtended80Rec_present} TempReallyExtended: TExtended80Rec; {$ENDIF} - {$IFNDEF CPU64} + {$IFDEF CPU64} TempDouble: Double; {$ENDIF} - {$ENDIF} + {$IFEND} begin Result := True; @@ -1939,9 +1985,9 @@ function BlockWriteVariant(BlockInfo: TPSBlockInfo; p: PIfRVariant{$IFNDEF PS_NO btDouble: BlockWriteData(BlockInfo, p^.tdouble, sizeof(tbtDouble)); btExtended: begin - {$IFNDEF PS_NOINT64} + {$IF NOT Defined( PS_NOINT64 ) AND NOT Defined( PS_NOUINT64 )} if ExecIs64Bit then begin - {$IFNDEF CPU64} + {$IFDEF CPU64} { On 64-bit Exec, Extended is an alias for Double, so write a Double instead } TempDouble := tbtDouble(p^.textended); BlockWriteData(BlockInfo, TempDouble, sizeof(tbtDouble)); @@ -1963,7 +2009,7 @@ function BlockWriteVariant(BlockInfo: TPSBlockInfo; p: PIfRVariant{$IFNDEF PS_NO end; {$ELSE} BlockWriteData(BlockInfo, p^.textended, sizeof(tbtExtended)); - {$ENDIF} + {$IFEND} end; btCurrency: BlockWriteData(BlockInfo, p^.tcurrency, sizeof(tbtCurrency)); btChar: BlockWriteData(BlockInfo, p^.tchar, 1); @@ -1995,7 +2041,9 @@ function BlockWriteVariant(BlockInfo: TPSBlockInfo; p: PIfRVariant{$IFNDEF PS_NO bts32,btu32: BlockWriteData(BlockInfo, p^.tu32, 4); {$IFNDEF PS_NOINT64} bts64: BlockWriteData(BlockInfo, p^.ts64, 8); - btU64: BlockWriteData(BlockInfo, p^.tu64, 8); + {$ENDIF} + {$IFNDEF PS_NOINT64} + btu64: BlockWriteData(BlockInfo, p^.tu64, 8); {$ENDIF} btProcPtr: BlockWriteData(BlockInfo, p^.tu32, 4); {$IFDEF DEBUG} @@ -2088,7 +2136,6 @@ function ParseMethodEx(Owner: TPSPascalCompiler; const FClassName: tbtString; De modifier: TPSParameterMode; VCType: TPSType; ERow, EPos, ECol: Integer; - begin if CustomParser = nil then begin Parser := TPSPascalParser.Create; @@ -2231,8 +2278,8 @@ function ParseMethodEx(Owner: TPSPascalCompiler; const FClassName: tbtString; De VCType := FindAndAddType(Owner, '!OPENARRAYOFSTRING', 'array of string'); btPChar: VCType := FindAndAddType(Owner, '!OPENARRAYOFPCHAR', {$IFDEF PS_PANSICHAR}'array of PAnsiChar'{$ELSE}'array of PChar'{$ENDIF}); btNotificationVariant, btVariant: VCType := FindAndAddType(Owner, '!OPENARRAYOFVARIANT', 'array of Variant'); - {$IFNDEF PS_NOINT64}btS64: VCType := FindAndAddType(Owner, '!OPENARRAYOFS64', 'array of Int64'); - btU64: VCType := FindAndAddType(Owner, '!OPENARRAYOFU64', 'array of UInt64');{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: VCType := FindAndAddType(Owner, '!OPENARRAYOFS64', 'array of Int64');{$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: VCType := FindAndAddType(Owner, '!OPENARRAYOFU64', 'array of UInt64');{$ENDIF} btChar: VCType := FindAndAddType(Owner, '!OPENARRAYOFCHAR', 'array of Char'); {$IFNDEF PS_NOWIDESTRING} btWideString: VCType := FindAndAddType(Owner, '!OPENARRAYOFWIDESTRING', 'array of WideString'); @@ -2727,10 +2774,8 @@ procedure CopyVariantContents(Src, Dest: PIfRVariant); btextended: Dest^.textended := src^.textended; btCurrency: Dest^.tcurrency := Src^.tcurrency; btchar: Dest^.tchar := src^.tchar; - {$IFNDEF PS_NOINT64} - bts64: dest^.ts64 := src^.ts64; - btU64: dest^.tu64 := src^.tu64; - {$ENDIF} + {$IFNDEF PS_NOINT64}bts64: dest^.ts64 := src^.ts64;{$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: dest^.tu64 := src^.tu64;{$ENDIF} btset, btstring: tbtstring(dest^.tstring) := tbtstring(src^.tstring); {$IFNDEF PS_NOWIDESTRING} btunicodestring: tbtunicodestring(dest^.tunistring) := tbtunicodestring(src^.tunistring); @@ -2807,7 +2852,7 @@ function TPSPascalCompiler.GetTypeCopyLink(p: TPSType): TPSType; function IsIntType(b: TPSBaseType): Boolean; begin case b of - btU8, btS8, btU16, btS16, btU32, btS32{$IFNDEF PS_NOINT64}, btS64, btU64{$ENDIF}: Result := True; + btU8, btS8, btU16, btS16, btU32, btS32{$IFNDEF PS_NOINT64}, btS64{$ENDIF}{$IFNDEF PS_NOUINT64}, btU64{$ENDIF}: Result := True; else Result := False; end; @@ -2848,7 +2893,7 @@ function IsRealType(b: TPSBaseType): Boolean; function IsIntRealType(b: TPSBaseType): Boolean; begin case b of - btSingle, btDouble, btCurrency, btExtended, btU8, btS8, btU16, btS16, btU32, btS32{$IFNDEF PS_NOINT64}, btS64, btU64{$ENDIF}: + btSingle, btDouble, btCurrency, btExtended, btU8, btS8, btU16, btS16, btU32, btS32{$IFNDEF PS_NOINT64}, btS64{$ENDIF}{$IFNDEF PS_NOUINT64}, btU64{$ENDIF}: Result := True; else Result := False; @@ -2912,7 +2957,9 @@ function GetUInt(Src: PIfRVariant; var s: Boolean): Cardinal; btS32: Result := Src^.ts32; {$IFNDEF PS_NOINT64} bts64: Result := src^.ts64; - btU64: Result := src^.tu64; + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: Result := src^.tu64; {$ENDIF} btChar: Result := ord(Src^.tchar); {$IFNDEF PS_NOWIDESTRING} @@ -2938,7 +2985,9 @@ function GetInt(Src: PIfRVariant; var s: Boolean): Longint; btS32: Result := Src^.ts32; {$IFNDEF PS_NOINT64} bts64: Result := src^.ts64; - btU64: Result := src^.tu64; + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: Result := src^.tu64; {$ENDIF} btChar: Result := ord(Src^.tchar); {$IFNDEF PS_NOWIDESTRING} @@ -2952,6 +3001,7 @@ function GetInt(Src: PIfRVariant; var s: Boolean): Longint; end; end; end; + {$IFNDEF PS_NOINT64} function GetInt64(Src: PIfRVariant; var s: Boolean): Int64; begin @@ -2963,7 +3013,7 @@ function GetInt64(Src: PIfRVariant; var s: Boolean): Int64; btU32: Result := Src^.tu32; btS32: Result := Src^.ts32; bts64: Result := src^.ts64; - btU64: Result := src^.tu64; + btu64: Result := src^.tu64; btChar: Result := ord(Src^.tchar); {$IFNDEF PS_NOWIDESTRING} btWideChar: Result := ord(tbtwidechar(src^.twidechar)); @@ -2976,7 +3026,9 @@ function GetInt64(Src: PIfRVariant; var s: Boolean): Int64; end; end; end; +{$ENDIF} +{$IFNDEF PS_NOUINT64} function GetUInt64(Src: PIfRVariant; var s: Boolean): UInt64; begin case Src.FType.BaseType of @@ -2987,7 +3039,7 @@ function GetUInt64(Src: PIfRVariant; var s: Boolean): UInt64; btU32: Result := Src^.tu32; btS32: Result := Src^.ts32; bts64: Result := src^.ts64; - btU64: Result := src^.tu64; + btu64: Result := src^.tu64; btChar: Result := ord(Src^.tchar); {$IFNDEF PS_NOWIDESTRING} btWideChar: Result := ord(tbtwidechar(src^.twidechar)); @@ -3013,7 +3065,9 @@ function GetReal(Src: PIfRVariant; var s: Boolean): Extended; btS32: Result := Src^.ts32; {$IFNDEF PS_NOINT64} bts64: Result := src^.ts64; - btU64: Result := src^.tu64; + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: Result := src^.tu64; {$ENDIF} btChar: Result := ord(Src^.tchar); {$IFNDEF PS_NOWIDESTRING} @@ -3276,9 +3330,9 @@ function TPSPascalCompiler.IsCompatibleType(p1, p2: TPSType; Cast: Boolean): Boo Result := True else begin // nx change start - allow casting class -> nativeint and vice versa - {$IFNDEF PS_NOINT64} if FExecIs64Bit then + {$IF NOT Defined( PS_NOINT64 ) AND NOT Defined( PS_NOUINT64 )} if FExecIs64Bit then ClassAsIntTypes := [btU64, btS64] - else {$ENDIF} + else {$IFEND} ClassAsIntTypes := [btU32, btS32]; if p1.BaseType = btclass then Result := TPSClassType(p1).cl.IsCompatibleWith(p2) or (p2.BaseType in ClassAsIntTypes) @@ -3319,8 +3373,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: var1^.ts16 := var1^.ts16 + Getint(Var2, Result); btEnum, btU32: var1^.tu32 := var1^.tu32 + GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 + Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 + GetInt64(Var2, Result); - btU64: var1^.tu64 := var1^.tu64 + GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 + GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 + GetUInt64(Var2, Result); {$ENDIF} btSingle: var1^.tsingle := var1^.tsingle + GetReal( Var2, Result); btDouble: var1^.tdouble := var1^.tdouble + GetReal( Var2, Result); btExtended: var1^.textended := var1^.textended + GetReal( Var2, Result); @@ -3357,8 +3411,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: var1^.ts16 := var1^.ts16 - Getint(Var2, Result); btEnum, btU32: var1^.tu32 := var1^.tu32 - GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 - Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 - GetInt64(Var2, Result); - btU64: var1^.tu64 := var1^.tu64 - GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 - GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 - GetUInt64(Var2, Result); {$ENDIF} btSingle: var1^.tsingle := var1^.tsingle - GetReal( Var2, Result); btDouble: var1^.tdouble := var1^.tdouble - GetReal(Var2, Result); btExtended: var1^.textended := var1^.textended - GetReal(Var2, Result); @@ -3382,8 +3436,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: var1^.ts16 := var1^.ts16 * Getint(Var2, Result); btU32: var1^.tu32 := var1^.tu32 * GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 * Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 * GetInt64(Var2, Result); - btU64: var1^.tu64 := var1^.tu64 * GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 * GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 * GetUInt64(Var2, Result); {$ENDIF} btSingle: var1^.tsingle := var1^.tsingle * GetReal(Var2, Result); btDouble: var1^.tdouble := var1^.tdouble * GetReal(Var2, Result); btExtended: var1^.textended := var1^.textended * GetReal( Var2, Result); @@ -3420,8 +3474,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: var1^.ts16 := var1^.ts16 div Getint(Var2, Result); btU32: var1^.tu32 := var1^.tu32 div GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 div Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 div GetInt64(Var2, Result); - btU64: var1^.tu64 := var1^.tu64 div GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 div GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 div GetUInt64(Var2, Result); {$ENDIF} else Result := False; end; end; @@ -3435,8 +3489,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: var1^.ts16 := var1^.ts16 div Getint(Var2, Result); btU32: var1^.tu32 := var1^.tu32 div GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 div Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 div GetInt64(Var2, Result); - btU64: var1^.tu64 := var1^.tu64 div GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 div GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 div GetUInt64(Var2, Result); {$ENDIF} btSingle: var1^.tsingle := var1^.tsingle / GetReal( Var2, Result); btDouble: var1^.tdouble := var1^.tdouble / GetReal( Var2, Result); btExtended: var1^.textended := var1^.textended / GetReal( Var2, Result); @@ -3454,8 +3508,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: var1^.ts16 := var1^.ts16 mod Getint(Var2, Result); btU32: var1^.tu32 := var1^.tu32 mod GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 mod Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 mod GetInt64(Var2, Result); - btU64: var1^.tu64 := var1^.tu64 mod GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 mod GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 mod GetUInt64(Var2, Result); {$ENDIF} else Result := False; end; end; @@ -3468,8 +3522,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: var1^.ts16 := var1^.ts16 shl Getint(Var2, Result); btU32: var1^.tu32 := var1^.tu32 shl GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 shl Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 shl GetInt64(Var2, Result); - btU64: var1^.tu64 := var1^.tu64 shl GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 shl GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.ts64 shl GetUInt64(Var2, Result); {$ENDIF} else Result := False; end; end; @@ -3482,8 +3536,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: var1^.ts16 := var1^.ts16 shr Getint(Var2, Result); btU32: var1^.tu32 := var1^.tu32 shr GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 shr Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 shr GetInt64( Var2, Result); - btU64: var1^.tu64 := var1^.tu64 shr GetUInt64( Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 shr GetInt64( Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 shr GetUInt64( Var2, Result); {$ENDIF} else Result := False; end; end; @@ -3497,8 +3551,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btU32: var1^.tu32 := var1^.tu32 and GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 and Getint(Var2, Result); btEnum: var1^.ts32 := var1^.ts32 and Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 and GetInt64(Var2, Result); - btU64: var1^.tu64 := var1^.tu64 and GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 and GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 and GetUInt64(Var2, Result); {$ENDIF} else Result := False; end; end; @@ -3511,8 +3565,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: var1^.ts16 := var1^.ts16 or Getint(Var2, Result); btU32: var1^.tu32 := var1^.tu32 or GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 or Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 or GetInt64(Var2, Result); - btU64: var1^.tu64 := var1^.tu64 or GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 or GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 or GetUInt64(Var2, Result); {$ENDIF} btEnum: var1^.ts32 := var1^.ts32 or Getint(Var2, Result); else Result := False; end; @@ -3526,8 +3580,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: var1^.ts16 := var1^.ts16 xor Getint(Var2, Result); btU32: var1^.tu32 := var1^.tu32 xor GetUint(Var2, Result); btS32: var1^.ts32 := var1^.ts32 xor Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 xor GetInt64(Var2, Result); - btU64: var1^.tu64 := var1^.tu64 xor GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: var1^.ts64 := var1^.ts64 xor GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 xor GetUInt64(Var2, Result); {$ENDIF} btEnum: var1^.ts32 := var1^.ts32 xor Getint(Var2, Result); else Result := False; end; @@ -3541,8 +3595,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: b := var1^.ts16 >= Getint(Var2, Result); btU32: b := var1^.tu32 >= GetUint(Var2, Result); btS32: b := var1^.ts32 >= Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 >= GetInt64(Var2, Result); - btU64: b := var1^.tu64 >= GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 >= GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: b := var1^.tu64 >= GetUInt64(Var2, Result); {$ENDIF} btSingle: b := var1^.tsingle >= GetReal( Var2, Result); btDouble: b := var1^.tdouble >= GetReal( Var2, Result); btExtended: b := var1^.textended >= GetReal( Var2, Result); @@ -3568,8 +3622,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: b := var1^.ts16 <= Getint(Var2, Result); btU32: b := var1^.tu32 <= GetUint(Var2, Result); btS32: b := var1^.ts32 <= Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 <= GetInt64(Var2, Result); - btU64: b := var1^.tu64 <= GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 <= GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: b := var1^.tu64 <= GetUInt64(Var2, Result); {$ENDIF} btSingle: b := var1^.tsingle <= GetReal( Var2, Result); btDouble: b := var1^.tdouble <= GetReal( Var2, Result); btExtended: b := var1^.textended <= GetReal( Var2, Result); @@ -3595,8 +3649,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: b := var1^.ts16 > Getint(Var2, Result); btU32: b := var1^.tu32 > GetUint(Var2, Result); btS32: b := var1^.ts32 > Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 > GetInt64(Var2, Result); - btU64: b := var1^.tu64 > GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 > GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: b := var1^.tu64 > GetUInt64(Var2, Result); {$ENDIF} btSingle: b := var1^.tsingle > GetReal( Var2, Result); btDouble: b := var1^.tdouble > GetReal( Var2, Result); btExtended: b := var1^.textended > GetReal( Var2, Result); @@ -3615,8 +3669,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: b := var1^.ts16 < Getint(Var2, Result); btU32: b := var1^.tu32 < GetUint(Var2, Result); btS32: b := var1^.ts32 < Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 < GetInt64(Var2, Result); - btU64: b := var1^.tu64 < GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 < GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: b := var1^.ts64 < GetUInt64(Var2, Result); {$ENDIF} btSingle: b := var1^.tsingle < GetReal( Var2, Result); btDouble: b := var1^.tdouble < GetReal( Var2, Result); btExtended: b := var1^.textended < GetReal( Var2, Result); @@ -3634,8 +3688,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btU16: b := var1^.tu16 <> GetUint(Var2, Result); btS16: b := var1^.ts16 <> Getint(Var2, Result); btU32: b := var1^.tu32 <> GetUint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 <> GetInt64(Var2, Result); - btU64: b := var1^.tu64 <> GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 <> GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: b := var1^.tu64 <> GetUInt64(Var2, Result); {$ENDIF} btS32: b := var1^.ts32 <> Getint(Var2, Result); btSingle: b := var1^.tsingle <> GetReal( Var2, Result); btDouble: b := var1^.tdouble <> GetReal( Var2, Result); @@ -3671,8 +3725,8 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: b := var1^.ts16 = Getint(Var2, Result); btU32: b := var1^.tu32 = GetUint(Var2, Result); btS32: b := var1^.ts32 = Getint(Var2, Result); - {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 = GetInt64(Var2, Result); - btU64: b := var1^.tu64 = GetUInt64(Var2, Result);{$ENDIF} + {$IFNDEF PS_NOINT64}btS64: b := var1^.ts64 = GetInt64(Var2, Result); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: b := var1^.tu64 = GetUInt64(Var2, Result); {$ENDIF} btSingle: b := var1^.tsingle = GetReal( Var2, Result); btDouble: b := var1^.tdouble = GetReal( Var2, Result); btExtended: b := var1^.textended = GetReal( Var2, Result); @@ -4124,7 +4178,9 @@ function TPSPascalCompiler.ReadType(const Name: tbtString; FParser: TPSPascalPar btS32: FArrayStart := tempf.ts32; {$IFNDEF PS_NOINT64} bts64: FArrayStart := tempf.ts64; - btU64: FArrayStart := tempf.tu64; + {$ENDIF} + {$IFNDEF PS_NOINT64} + btu64: FArrayStart := tempf.tu64; {$ENDIF} else begin @@ -4157,7 +4213,9 @@ function TPSPascalCompiler.ReadType(const Name: tbtString; FParser: TPSPascalPar btS32: FArrayLength := tempf.ts32; {$IFNDEF PS_NOINT64} bts64: FArrayLength := tempf.ts64; - btU64: FArrayLength := tempf.tu64; + {$ENDIF} + {$IFNDEF PS_NOINT64} + btu64: FArrayLength := tempf.tu64; {$ENDIF} else DisposeVariant(tempf); @@ -5671,13 +5729,37 @@ function TPSPascalCompiler.ReadString: PIfRVariant; {$ENDIF} end; - function TPSPascalCompiler.ReadInteger(const s: tbtString): PIfRVariant; var R: {$IFNDEF PS_NOINT64}Int64;{$ELSE}Longint;{$ENDIF} + {$IFNDEF PS_NOUINT64} + UI : UInt64; + {$ENDIF} begin New(Result); {$IFNDEF PS_NOINT64} + {$IFNDEF PS_NOUINT64} + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} + UI := StrToUInt64Def(string(s), 0); + if ( UI > High( Int64 ) ) then + begin + InitializeVariant(Result, at2ut(FindBaseType(btu64))); + Result^.tu64 := UI; + Exit; + end; + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} + {$ENDIF PS_NOUINT64} + r := StrToInt64Def(string(s), 0); if (r >= Low(Integer)) and (r <= High(Integer)) then begin @@ -5696,7 +5778,7 @@ function TPSPascalCompiler.ReadInteger(const s: tbtString): PIfRVariant; r := StrToIntDef(s, 0); InitializeVariant(Result, at2ut(FindBaseType(bts32))); Result^.ts32 := r; -{$ENDIF} +{$ENDIF PS_NOINT64} end; function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; @@ -6599,7 +6681,7 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; if AllowData then begin BlockWriteByte(BlockInfo, 1); - if not BlockWriteVariant(BlockInfo, TPSValueData(x).Data{$IFNDEF PS_NOINT64}, FExecIs64Bit{$ENDIF}) then + if not BlockWriteVariant(BlockInfo, TPSValueData(x).Data{$IF NOT Defined( PS_NOINT64 ) AND NOT Defined( PS_NOUINT64 )}, FExecIs64Bit{$IFEND}) then Result := False; end else @@ -7787,7 +7869,6 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; end; h := MakeHash(s); - for l := 0 to BlockInfo.Proc.ProcVars.Count - 1 do begin if (PIFPSProcVar(BlockInfo.Proc.ProcVars[l]).NameHash = h) and @@ -8974,7 +9055,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; bts32: TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts32 := not TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts32; {$IFNDEF PS_NOINT64} bts64: TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64 := not TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; - btU64: TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64 := not TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64 := not TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; {$ENDIF} else begin @@ -8999,7 +9082,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; bts32: TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts32 := -TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts32; {$IFNDEF PS_NOINT64} bts64: TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64 := -TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; - btU64: TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64 := -TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64 := -TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; {$ENDIF} btSingle: TPSValueData(TPSUnValueOp(p).FVal1).Data^.tsingle := -TPSValueData(TPSUnValueOp(p).FVal1).Data^.tsingle; btDouble: TPSValueData(TPSUnValueOp(p).FVal1).Data^.tdouble := -TPSValueData(TPSUnValueOp(p).FVal1).Data^.tdouble; @@ -9037,6 +9122,8 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; btS32: TPSValueData(preplace).Data.tu8 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS32; {$IFNDEF PS_NOINT64} btS64: TPSValueData(preplace).Data.tu8 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: TPSValueData(preplace).Data.tu8 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; {$ENDIF} else @@ -9063,7 +9150,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; btS32: TPSValueData(preplace).Data.ts8 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS32; {$IFNDEF PS_NOINT64} btS64: TPSValueData(preplace).Data.ts8 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; - btU64: TPSValueData(preplace).Data.tu8 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64 + {$ENDIF} + {$IFNDEF PS_NOINT64} + btU64: TPSValueData(preplace).Data.ts8 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; {$ENDIF} else begin @@ -9089,6 +9178,8 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; btS32: TPSValueData(preplace).Data.tu16 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS32; {$IFNDEF PS_NOINT64} btS64: TPSValueData(preplace).Data.tu16 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: TPSValueData(preplace).Data.tu16 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; {$ENDIF} else @@ -9115,6 +9206,8 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; btS32: TPSValueData(preplace).Data.ts16 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS32; {$IFNDEF PS_NOINT64} btS64: TPSValueData(preplace).Data.ts16 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: TPSValueData(preplace).Data.ts16 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; {$ENDIF} else @@ -9141,6 +9234,8 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; btS32: TPSValueData(preplace).Data.tu32 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS32; {$IFNDEF PS_NOINT64} btS64: TPSValueData(preplace).Data.tu32 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: TPSValueData(preplace).Data.tu32 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; {$ENDIF} else @@ -9167,6 +9262,8 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; btS32: TPSValueData(preplace).Data.ts32 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS32; {$IFNDEF PS_NOINT64} btS64: TPSValueData(preplace).Data.ts32 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: TPSValueData(preplace).Data.ts32 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; {$ENDIF} else @@ -9203,6 +9300,8 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; end; end; end; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: begin case TPSValueData(TPSUnValueOp(p).FVal1).Data.Ftype.basetype of @@ -9243,6 +9342,8 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; btS32: TPSValueData(preplace).Data.tchar := tbtchar(TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS32); {$IFNDEF PS_NOINT64} btS64: TPSValueData(preplace).Data.tchar := tbtchar(TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64); + {$ENDIF} + {$IFNDEF PS_NOINT64} btU64: TPSValueData(preplace).Data.tchar := tbtchar(TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64); {$ENDIF} else @@ -9268,6 +9369,8 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; btS32: TPSValueData(preplace).Data.twidechar := tbtwidechar(TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS32); {$IFNDEF PS_NOINT64} btS64: TPSValueData(preplace).Data.twidechar := tbtwidechar(TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: TPSValueData(preplace).Data.twidechar := tbtwidechar(TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64); {$ENDIF} else @@ -9954,7 +10057,7 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; exit; end; case lType.BaseType of - btU8, btS8, btU16, btS16, btU32, btS32, {$IFNDEF PS_NOINT64} btS64, btU64, {$ENDIF} btVariant, btEnum: ; + btU8, btS8, btU16, btS16, btU32, btS32, {$IFNDEF PS_NOINT64} btS64, {$ENDIF}{$IFNDEF PS_NOUINT64} btU64, {$ENDIF} btVariant, btEnum: ; else begin MakeError('', ecTypeMismatch, ''); @@ -10002,7 +10105,7 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; exit; end; case lType.BaseType of - btVariant, btEnum, btU8, btS8, btU16, btS16, btU32, {$IFNDEF PS_NOINT64} btS64, btU64, {$ENDIF} btS32: ; + btVariant, btEnum, btU8, btS8, btU16, btS16, btU32, {$IFNDEF PS_NOINT64} btS64, {$ENDIF}{$IFNDEF PS_NOUINT64} btU64, {$ENDIF} btS32: ; else begin MakeError('', ecTypeMismatch, ''); @@ -11612,7 +11715,7 @@ function TPSPascalCompiler.Compile(const s: tbtString): Boolean; {$IFDEF CPU64_and_TExtended80Rec_present} TempReallyExtended: TExtended80Rec; {$ENDIF} - {$IFNDEF CPU64} + {$IFDEF CPU64} TempDouble: Double; {$ENDIF} {$ENDIF} @@ -11642,7 +11745,7 @@ function TPSPascalCompiler.Compile(const s: tbtString): Boolean; begin {$IFNDEF PS_NOINT64} if FExecIs64Bit then begin - {$IFNDEF CPU64} + {$IFDEF CPU64} { On 64-bit Exec, Extended is an alias for Double, so write a Double instead } TempDouble := tbtDouble(p^.textended); WriteData(TempDouble, sizeof(tbtDouble)); @@ -11691,7 +11794,9 @@ function TPSPascalCompiler.Compile(const s: tbtString): Boolean; bts32,btu32: WriteData(p^.tu32, 4); {$IFNDEF PS_NOINT64} bts64: WriteData(p^.ts64, 8); - btU64: WriteData(p^.tu64, 8); + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: WriteData(p^.tu64, 8); {$ENDIF} btProcPtr: WriteData(p^.tu32, 4); {$IFDEF DEBUG} @@ -12207,7 +12312,6 @@ function TPSPascalCompiler.Compile(const s: tbtString): Boolean; if Parse then begin - {$ENDIF} FUses.Add(s); if @FOnUses <> nil then begin @@ -12245,8 +12349,11 @@ function TPSPascalCompiler.Compile(const s: tbtString): Boolean; end; end; end; - {$IFDEF PS_USESSUPPORT} end; + {$ELSE} + MakeError('', ecUnknownIdentifier, S); + Result := False; + exit; {$ENDIF} FParser.Next; if FParser.CurrTokenID = CSTI_Semicolon then break @@ -12669,9 +12776,10 @@ constructor TPSPascalCompiler.Create; FMessages := TPSList.Create; FAttributesOpenTokenID := CSTI_OpenBlock; FAttributesCloseTokenID := CSTI_CloseBlock; - {$IFNDEF PS_NOINT64} + FOnAddFunction := nil; + {$IF NOT Defined( PS_NOINT64 ) AND NOT Defined( PS_NOUINT64 )} FExecIs64Bit := {$IFDEF CPU64} True {$ELSE} False {$ENDIF}; - {$ENDIF} + {$IFEND} end; destructor TPSPascalCompiler.Destroy; @@ -12710,6 +12818,7 @@ procedure TPSPascalCompiler.DefineStandardTypes; i: Longint; begin AddType('Byte', btU8); + AddTypeCopyN('UCHAR', 'Byte'); FDefaultBoolType := AddTypeS('Boolean', '(False, True)'); FDefaultBoolType.ExportName := True; with TPSEnumType(AddType('LongBool', btEnum)) do @@ -12724,11 +12833,15 @@ procedure TPSPascalCompiler.DefineStandardTypes; begin HighValue := 255; // make sure it's gonna be a 1 byte var end; + + AddType( 'AnsiChar', btChar); //following 2 IFDEFs should actually be UNICODE IFDEFs... - AddType({$IFDEF PS_PANSICHAR}'AnsiChar'{$ELSE}'Char'{$ENDIF}, btChar); {$IFDEF PS_PANSICHAR} AddType('Char', btWideChar); + {$ELSE} + AddTypeCopyN('Char', 'AnsiChar'); {$ENDIF} + {$IFNDEF PS_NOWIDESTRING} AddType('WideChar', btWideChar); AddType('WideString', btWideString); @@ -12747,33 +12860,88 @@ procedure TPSPascalCompiler.DefineStandardTypes; AddType('string', btString); AddType('NativeString', btString); {$ENDIF} + AddType('tbtString', btString); + FAnyString := AddType('AnyString', btString); FAnyMethod := AddTypeS('AnyMethod', 'procedure'); + + at2ut(AddType('___Pointer', btPointer)); + AddType('ShortInt', btS8); + AddType('Word', btU16); + AddTypeCopyN('USHORT', 'Word'); AddType('SmallInt', btS16); + AddTypeCopyN('SHORT', 'SmallInt'); + AddType('LongInt', btS32); - at2ut(AddType('___Pointer', btPointer)); + AddTypeCopyN('LONG', 'LongInt'); + AddType('LongWord', btU32); AddTypeCopyN('Integer', 'LongInt'); + AddTypeCopyN('FixedInt', 'LongInt'); AddTypeCopyN('Cardinal', 'LongWord'); - AddType('tbtString', btString); + AddTypeCopyN('UINT', 'LongWord'); + AddTypeCopyN('ULONG', 'LongWord'); + AddTypeCopyN('ULONG32', 'LongWord'); + {$IFNDEF PS_NOINT64} AddType('Int64', btS64); + AddTypeCopyN('LONG64', 'Int64'); + AddTypeCopyN('LONGLONG', 'Int64'); + {$ENDIF} + + {$IFNDEF PS_NOUINT64} AddType('UInt64', btU64); - if FExecIs64Bit then begin - AddType('NativeInt', btS64); - AddType('NativeUInt', btU64); - end else begin - AddType('NativeInt', btS32); - AddType('NativeUInt', btU32); - end; + AddTypeCopyN('ULONG64', 'UInt64'); + AddTypeCopyN('ULONGLONG', 'UInt64'); + AddTypeCopyN('DWORDLONG', 'UInt64'); + {$ENDIF} + + {$IFDEF Win64} + {$IFNDEF PS_NOUINT64} + AddTypeCopyN('NativeUInt', 'UInt64'); + AddTypeCopyN('THandle', 'UInt64'); + AddTypeCopyN('Pointer', 'UInt64'); + {$ELSE} + {$IFNDEF PS_NOINT64} + AddTypeCopyN('NativeUInt', 'Int64'); + AddTypeCopyN('THandle', 'Int64'); + AddTypeCopyN('Pointer', 'Int64'); + {$ELSE} + AddTypeCopyN('NativeUInt', 'LongWord'); + AddTypeCopyN('THandle', 'LongWord'); + AddTypeCopyN('Pointer', 'LongWord'); + {$ENDIF PS_NOINT64} + {$ENDIF PS_NOUINT64} + + {$IFNDEF PS_NOINT64} + AddTypeCopyN('NativeInt', 'Int64'); + {$ELSE} + AddTypeCopyN('NativeInt', 'LongInt'); + {$ENDIF PS_NOINT64} + {$ELSE} + AddTypeCopyN('NativeInt', 'LongInt'); + AddTypeCopyN('NativeUInt', 'LongWord'); + AddTypeCopyN('THandle', 'LongWord'); + AddTypeCopyN('Pointer', 'LongWord'); {$ENDIF} + AddType('Single', btSingle); AddType('Double', btDouble); AddType('Extended', btExtended); AddType('Currency', btCurrency); - AddType({$IFDEF PS_PANSICHAR}'PAnsiChar'{$ELSE}'PChar'{$ENDIF}, btPChar); + + {$IFDEF PS_PANSICHAR} + AddType('PAnsiChar', btPChar); + AddTypeCopyN('PChar', 'PAnsiChar'); + {$ELSE} + AddType('PChar', btPChar); + AddTypeCopyN('PAnsiChar', 'PChar'); + {$ENDIF} + + AddTypeCopyN('Pointer', 'LongWord'); + AddType('Variant', btVariant); AddType('!NotificationVariant', btNotificationVariant); for i := FTypes.Count -1 downto 0 do AT2UT(FTypes[i]); @@ -13292,7 +13460,9 @@ function TPSPascalCompiler.ReadConstant(FParser: TPSPascalParser; StopOn: TPSPas bts32: p1.ts32 := not p1.ts32; {$IFNDEF PS_NOINT64} bts64: p1.ts64 := not p1.ts64; - btU64: p1.tu64 := not p1.tu64; + {$ENDIF} + {$IFNDEF PS_NOINT64} + btu64: p1.tu64 := not p1.tu64; {$ENDIF} else begin @@ -13312,7 +13482,9 @@ function TPSPascalCompiler.ReadConstant(FParser: TPSPascalParser; StopOn: TPSPas bts32: p1.ts32 := -p1.ts32; {$IFNDEF PS_NOINT64} bts64: p1.ts64 := -p1.ts64; - btU64: p1.tu64 := -p1.tu64; + {$ENDIF} + {$IFNDEF PS_NOINT64} + btu64: p1.tu64 := -p1.tu64; {$ENDIF} btDouble: p1.tdouble := - p1.tDouble; btSingle: p1.tsingle := - p1.tsingle; @@ -13456,13 +13628,34 @@ procedure TPSPascalCompiler.DefineStandardProcedures; aType:=FindBaseType(btS32); //Integer end; end; - {$IFNDEF PS_NOINT64} + with AddFunction('procedure FillChar;').Decl do + begin + with AddParam do + begin + OrgName:='s'; + Mode:=pmInOut; + end; + with AddParam do + begin + OrgName:='Length'; + aType:=FindBaseType(btS32); //Integer + end; + with AddParam do + begin + OrgName:='Char'; + aType:=FindBaseType(btS32); //Integer + end; + end; + {$IF NOT Defined( PS_NOINT64 )} AddFunction('function Low: Int64;').Decl.AddParam.OrgName := 'X'; AddFunction('function High: Int64;').Decl.AddParam.OrgName := 'X'; + {$ELSEIF NOT Defined( PS_NOUINT64 )} + AddFunction('function Low: UInt64;').Decl.AddParam.OrgName := 'X'; + AddFunction('function High: UInt64;').Decl.AddParam.OrgName := 'X'; {$ELSE} AddFunction('function Low: Integer;').Decl.AddParam.OrgName := 'X'; AddFunction('function High: Integer;').Decl.AddParam.OrgName := 'X'; - {$ENDIF} + {$IFEND} with AddFunction('procedure Dec;').Decl do begin with AddParam do begin @@ -13574,6 +13767,11 @@ procedure TPSPascalCompiler.DefineStandardProcedures; AddFunction('function Int64ToStr(I: Int64): string;'); AddFunction('function StrToInt64Def(S: string; def: Int64): Int64;'); {$ENDIF} + {$IFNDEF PS_NOUINT64} + AddFunction('function StrToUInt64(S: string): UInt64;'); + AddFunction('function UInt64ToStr(I: UInt64): string;'); + AddFunction('function StrToUInt64Def(S: string; def: UInt64): Int64;'); + {$ENDIF} with AddFunction('function SizeOf: LongInt;').Decl.AddParam do begin @@ -13735,6 +13933,98 @@ function TPSPascalCompiler.AddConstantN(const Name, Result := AddConstant(Name, FindType(FType)); end; +//function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value ): TPSConstant; +//begin +// result := AddConstant( Name, FindType( 'Set' ) ); +// result.SetSet( Value ); +//end; + +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: Integer): TPSConstant; +begin + result := AddConstant( Name, FindType( 'Integer' ) ); // LONGINT + result.SetInt( Value ); +end; + +{$IF CompilerVersion > 23} +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: Cardinal): TPSConstant; +begin + result := AddConstant( Name, FindType( 'Cardinal' ) ); // LONGWORD + result.SetUInt( Value ); +end; +{$IFEND} + +{$IFNDEF PS_NOINT64} +{$IF CompilerVersion > 23} +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: Int64): TPSConstant; +begin + result := AddConstant( Name, FindType( 'Int64' ) ); // INT64 + result.SetInt64( Value ); +end; +{$IFEND} +{$ENDIF PS_NOINT64} + +{$IFNDEF PS_NOUINT64} +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: UInt64): TPSConstant; +begin + result := AddConstant( Name, FindType( 'UInt64' ) ); // UINT64 + result.SetUInt64( Value ); +end; +{$ENDIF PS_NOUINT64} + +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: tbtString): TPSConstant; +begin + result := AddConstant( Name, FindType( 'String' ) ); // STRING + result.SetString( Value ); +end; + +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: tbtChar): TPSConstant; +begin + result := AddConstant( Name, FindType( 'Char' ) ); // ANSICHAR + result.SetChar( Value ); +end; + +{$IFNDEF PS_NOWIDESTRING} +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: WideChar): TPSConstant; +begin + result := AddConstant( Name, FindType( 'WideChar' ) ); // WIDECHAR + result.SetWideChar( Value ); +end; + +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: tbtwidestring): TPSConstant; +begin + result := AddConstant( Name, FindType( 'WideString' ) ); // WIDESTRING + result.SetWideString( Value ); +end; + +{$IF CompilerVersion >= 23} +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: tbtunicodestring): TPSConstant; +begin + result := AddConstant( Name, FindType( 'UnicodeString' ) ); // UNICODESTRING + result.SetUnicodeString( Value ); +end; +{$IFEND} +{$ENDIF PS_NOWIDESTRING} + +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: Double): TPSConstant; +begin + result := AddConstant( Name, FindType( 'Double' ) ); // DOUBLE + result.SetExtended( Value ); +end; + +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: Extended): TPSConstant; +begin + result := AddConstant( Name, FindType( 'Extended' ) ); // EXTENDED + result.SetExtended( Value ); +end; + +{$IF CompilerVersion > 23} +function TPSPascalCompiler.AddConstant(const Name: tbtString; const Value: TDateTime): TPSConstant; +begin + result := AddConstant( Name, FindType( 'Double' ) ); // DOUBLE + result.SetExtended( Value ); +end; +{$IFEND} + function TPSPascalCompiler.AddTypeCopy(const Name: tbtString; TypeNo: TPSType): TPSType; begin @@ -13794,6 +14084,39 @@ function TPSPascalCompiler.AddUsedPtrVariableN(const Name, FType: tbtString): TP end; end; +(* +function TPSPascalCompiler.AddRecordWithRTTI( const ATypeInfo: Pointer{PTypeInfo} ): TPSType; +var + rt: TRttiType; + i : Integer; + fields: TArray; + S : string; +begin + result := nil; + if not Assigned( ATypeInfo ) then + Exit; + + rt := TRttiContext.Create.GetType( ATypeInfo ); + case rt.TypeKind of + tkRecord : begin + fields := rt.GetFields; + for i := 0 to High( fields ) do + begin + if Assigned( fields[i].FieldType ) then + begin + if ( fields[i].FieldType.TypeKind = tkArray ) then + S := S + Format('%s: Array [] of ; ', [ fields[i].Name ] ) + else + S := S + Format('%s: %s; ', [ fields[i].Name, fields[i].FieldType.ToString{, fields[i].GetValue(@m).ToString} ] ); + end; + end; + S := {rt.Name + ' = ' +} 'record ' + S + 'end;'; + result := AddTypeS( rt.Name, S ); + end; + end; +end; +*) + function TPSPascalCompiler.AddTypeS(const Name, Decl: tbtString): TPSType; var Parser: TPSPascalParser; @@ -13881,7 +14204,7 @@ function TPSPascalCompiler.IsIntBoolType(aType: TPSType): Boolean; if Isboolean(aType) then begin Result := True; exit;end; case aType.BaseType of - btU8, btS8, btU16, btS16, btU32, btS32{$IFNDEF PS_NOINT64}, btS64, btU64{$ENDIF}: Result := True; + btU8, btS8, btU16, btS16, btU32, btS32{$IFNDEF PS_NOINT64}, btS64{$ENDIF}{$IFNDEF PS_NOUINT64}, btU64{$ENDIF}: Result := True; else Result := False; end; @@ -13909,7 +14232,6 @@ function TPSPascalCompiler.AddDelphiFunction(const Decl: tbtString): TPSRegProc; DOrgName: tbtString; FT: TPMFuncType; i: Longint; - begin pDecl := TPSParametersDecl.Create; {$IFNDEF DELPHI_TOKYO_UP} @@ -13942,6 +14264,9 @@ function TPSPascalCompiler.AddDelphiFunction(const Decl: tbtString): TPSRegProc; else p.ImportDecl := p.ImportDecl + #0; end; + + if Assigned( FOnAddFunction ) then + FOnAddFunction( Decl ); finally pDecl.Free; end; @@ -14054,11 +14379,65 @@ function TPSPascalCompiler.FindClass(const aClass: tbtString): TPSCompileTimeCla Result := nil; end; +{ +function TransDoubleToStr(D: Double): tbtString; +begin + SetLength(Result, SizeOf(Double)); + Double((@Result[1])^) := D; +end; + +function TransSingleToStr(D: Single): tbtString; +begin + SetLength(Result, SizeOf(Single)); + Single((@Result[1])^) := D; +end; + +function TransExtendedToStr(D: Extended): tbtString; +begin + SetLength(Result, SizeOf(Extended)); + Extended((@Result[1])^) := D; +end; + +function TransLongintToStr(D: Longint): tbtString; +begin + SetLength(Result, SizeOf(Longint)); + Longint((@Result[1])^) := D; +end; + +function TransCardinalToStr(D: Cardinal): tbtString; +begin + SetLength(Result, SizeOf(Cardinal)); + Cardinal((@Result[1])^) := D; +end; + +function TransWordToStr(D: Word): tbtString; +begin + SetLength(Result, SizeOf(Word)); + Word((@Result[1])^) := D; +end; + +function TransSmallIntToStr(D: SmallInt): tbtString; +begin + SetLength(Result, SizeOf(SmallInt)); + SmallInt((@Result[1])^) := D; +end; + +function TransByteToStr(D: Byte): tbtString; +begin + SetLength(Result, SizeOf(Byte)); + Byte((@Result[1])^) := D; +end; + +function TransShortIntToStr(D: ShortInt): tbtString; +begin + SetLength(Result, SizeOf(ShortInt)); + ShortInt((@Result[1])^) := D; +end; +} function TPSPascalCompiler.GetConstant(const Name: tbtString): TPSConstant; var h, i: Longint; n: tbtString; - begin n := FastUppercase(name); h := MakeHash(n); @@ -14070,6 +14449,23 @@ function TPSPascalCompiler.GetConstant(const Name: tbtString): TPSConstant; result := nil; end; +function TPSPascalCompiler.GetVariable(const Name: tbtString): TPSVar; +var + h, i: Longint; + n: tbtString; + +begin + n := FastUppercase(name); + h := MakeHash(n); + + for i := 0 to FVars.Count -1 do + begin + result := TPSVar(FVars[i]); + if (Result.NameHash = h) and (Result.Name = n) then exit; + end; + result := nil; +end; + {$IFDEF PS_USESSUPPORT} function TPSPascalCompiler.IsInLocalUnitList(s: tbtstring): Boolean; begin @@ -14311,7 +14707,21 @@ procedure TPSConstant.SetInt(const Val: Longint); btCurrency: FValue.tcurrency := Val; {$IFNDEF PS_NOINT64} bts64: FValue.ts64 := Val; - btU64: FValue.tu64 := Val; + {$ENDIF} + {$IFNDEF PS_NOUINT64} + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} + btu64: FValue.tu64 := Val; + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} {$ENDIF} else raise EPSCompilerException.Create(RPS_ConstantValueMismatch); @@ -14319,6 +14729,7 @@ procedure TPSConstant.SetInt(const Val: Longint); end else raise EPSCompilerException.Create(RPS_ConstantValueNotAssigned) end; + {$IFNDEF PS_NOINT64} procedure TPSConstant.SetInt64(const Val: Int64); begin @@ -14334,14 +14745,28 @@ procedure TPSConstant.SetInt64(const Val: Int64); btExtended: FValue.textended := Val; btCurrency: FValue.tcurrency := Val; bts64: FValue.ts64 := Val; - btU64: FValue.tu64 := Val; + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} + btu64: FValue.tu64 := Val; + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} else raise EPSCompilerException.Create(RPS_ConstantValueMismatch); end; end else raise EPSCompilerException.Create(RPS_ConstantValueNotAssigned) end; +{$ENDIF} +{$IFNDEF PS_NOUINT64} procedure TPSConstant.SetUInt64(const Val: UInt64); begin if (FValue <> nil) then @@ -14356,7 +14781,19 @@ procedure TPSConstant.SetUInt64(const Val: UInt64); btExtended: FValue.textended := Val; btCurrency: FValue.tcurrency := Val; bts64: FValue.ts64 := Val; - btU64: FValue.tu64 := Val; + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} + btu64: FValue.tu64 := Val; + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} else raise EPSCompilerException.Create(RPS_ConstantValueMismatch); end; @@ -14364,6 +14801,7 @@ procedure TPSConstant.SetUInt64(const Val: UInt64); raise EPSCompilerException.Create(RPS_ConstantValueNotAssigned) end; {$ENDIF} + procedure TPSConstant.SetName(const Value: tbtString); begin FName := Value; @@ -14423,7 +14861,21 @@ procedure TPSConstant.SetUInt(const Val: Cardinal); btCurrency: FValue.tcurrency := Val; {$IFNDEF PS_NOINT64} bts64: FValue.ts64 := Val; - btU64: FValue.tu64 := Val; + {$ENDIF} + {$IFNDEF PS_NOINT64} + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} + btu64: FValue.tu64 := Val; + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} {$ENDIF} else raise EPSCompilerException.Create(RPS_ConstantValueMismatch); diff --git a/Source/uPSComponent.pas b/Source/uPSComponent.pas index bdeddd64..e510b0f1 100644 --- a/Source/uPSComponent.pas +++ b/Source/uPSComponent.pas @@ -2,6 +2,10 @@ {$I PascalScript.inc} interface +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CODE OFF} +{$WARN UNSAFE_CAST OFF} + uses SysUtils, Classes, uPSRuntime, uPSDebugger, uPSUtils, uPSCompiler, @@ -91,6 +95,8 @@ TIFPS3CEPlugins = class(TPSPlugins); TPSOnCompImportEvent = procedure (Sender: TObject; x: TPSPascalCompiler) of object; + TPSOnCompUsesEvent = function (Sender: TObject; x: TPSPascalCompiler; Name : tbtstring) : boolean of object; + TPSOnExecImportEvent = procedure (Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter) of object; {Script engine event function} TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object; @@ -116,6 +122,7 @@ TPSScript = class(TComponent) FUseDebugInfo: Boolean; FOnAfterExecute, FOnCompile, FOnExecute: TPSEvent; FOnCompImport: TPSOnCompImportEvent; + FOnCompUses: TPSOnCompUsesEvent; FOnExecImport: TPSOnExecImportEvent; RI: TPSRuntimeClassImporter; FPlugins: TPSPlugins; @@ -275,6 +282,8 @@ TPSScript = class(TComponent) property OnCompImport: TPSOnCompImportEvent read FOnCompImport write FOnCompImport; + property OnCompUses: TPSOnCompUsesEvent read FOnCompUses write FOnCompUses; + property OnExecImport: TPSOnExecImportEvent read FOnExecImport write FOnExecImport; property UseDebugInfo: Boolean read FUseDebugInfo write FUseDebugInfo default True; @@ -344,7 +353,9 @@ TPSScriptDebugger = class(TPSScript) procedure StepInto; virtual; procedure StepOver; virtual; - + + procedure StepTo( Line : Cardinal ); virtual; + procedure SetBreakPoint(const Fn: tbtstring; Line: Longint); procedure ClearBreakPoint(const Fn: tbtstring; Line: Longint); @@ -594,6 +605,7 @@ function TPSScript.Compile: Boolean; begin FPP.Clear; FPP.Defines.Assign(FDefines); + FPP.Compiler := FComp; FComp.OnTranslateLineInfo := CompTranslateLineInfo; Fpp.OnProcessDirective := callObjectOnProcessDirective; Fpp.OnProcessUnknowDirective := callObjectOnProcessUnknowDirective; @@ -789,11 +801,19 @@ function TPSScript.ScriptUses(Sender: TPSPascalCompiler; if Sender.Msg[i] is TPSPascalCompilerError then Result := false; end; end - else begin + else + begin + if ( @FOnCompUses <> nil ) then + begin + result := FOnCompUses( Self, Sender, Name ); + if result then + Exit; + end; + Result := DoOnUnknowUses (Sender, Name); { If Not Result then Sender.MakeError('', ecUnknownIdentifier, Name);} - end; + end; end; procedure TPSScript.SetCompiled(const Data: tbtstring); @@ -1082,7 +1102,7 @@ function TPSScript.DoOnUnknowUses(Sender: TPSPascalCompiler; Result := false; end; end else begin - FComp.MakeError(FComp.UnitName, ecUnknownIdentifier, lName); + FComp.MakeError(FComp.UnitName, ecUnknownIdentifier, Name); result := false; end; end; @@ -1472,7 +1492,13 @@ procedure TPSScriptDebugger.StepOver; raise Exception.Create(RPS_NoScript); end; - +procedure TPSScriptDebugger.StepTo( Line : Cardinal ); +begin + if (FExec.Status = isRunning) or (FExec.Status = isLoaded) then + FExec.StepTo( Line ) + else + raise Exception.Create(RPS_NoScript); +end; { TPSPluginItem } diff --git a/Source/uPSDebugger.pas b/Source/uPSDebugger.pas index 921f6b2d..d27bb4d4 100644 --- a/Source/uPSDebugger.pas +++ b/Source/uPSDebugger.pas @@ -2,6 +2,10 @@ unit uPSDebugger; {$I PascalScript.inc} interface + +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CODE OFF} + uses SysUtils, uPSRuntime, uPSUtils; @@ -9,7 +13,8 @@ interface TDebugMode = (dmRun , dmStepOver - , dmStepInto + , dmStepInto + , dmStepTo , dmPaused ); @@ -50,12 +55,20 @@ TPSCustomDebugExec = class(TPSExec) property CurrentProcVars: TIfStringList read GetCurrentProcVars; property CurrentProcParams: TIfStringList read GetCurrentProcParams; - - function GetGlobalVar(I: Cardinal): PIfVariant; - - function GetProcVar(I: Cardinal): PIfVariant; - - function GetProcParam(I: Cardinal): PIfVariant; + + function FindVariable(Name : AnsiString): PIfVariant; + + function GetGlobalVar(Name : AnsiString): PIfVariant; overload; + + function GetGlobalVar(I: Cardinal): PIfVariant; overload; + + function GetProcVar(Name : AnsiString): PIfVariant; overload; + + function GetProcVar(I: Cardinal): PIfVariant; overload; + + function GetProcParam(Name : AnsiString): PIfVariant; overload; + + function GetProcParam(I: Cardinal): PIfVariant; overload; function GetCallStack(var Count: Cardinal): tbtString; @@ -77,6 +90,7 @@ TPSDebugExec = class(TPSCustomDebugExec) FOnIdleCall: TOnIdleCall; FOnSourceLine: TOnSourceLine; FDebugEnabled: Boolean; + FStepToLine: Cardinal; protected procedure SourceChanged; @@ -94,6 +108,8 @@ TPSDebugExec = class(TPSCustomDebugExec) procedure StepInto; procedure StepOver; + + procedure StepTo( Line : Cardinal ); procedure Stop; override; @@ -230,16 +246,73 @@ function TPSCustomDebugExec.GetCurrentProcVars: TIfStringList; end else Result := nil; end; +function TPSCustomDebugExec.FindVariable(Name : AnsiString): PIfVariant; +begin + result := GetGlobalVar( Name ); + if NOT Assigned( result ) then + result := GetProcParam( Name ); + if NOT Assigned( result ) then + result := GetProcVar( Name ); +end; + +function TPSCustomDebugExec.GetGlobalVar(Name : AnsiString): PIfVariant; +var + i: integer; +begin + result := nil; + Name := FastUppercase( Name ); + for i := 0 to FGlobalVarNames.Count-1 do + begin + if ( FGlobalVarNames[ i ] = Name ) then + begin + result := FGlobalVars[i]; + break; + end; + end; +end; + function TPSCustomDebugExec.GetGlobalVar(I: Cardinal): PIfVariant; begin Result := FGlobalVars[I]; end; +function TPSCustomDebugExec.GetProcParam(Name : AnsiString): PIfVariant; +var + i: integer; +begin + result := nil; + Name := FastUppercase( Name ); + for i := 0 to CurrentProcParams.Count-1 do + begin + if ( CurrentProcParams[ i ] = Name ) then + begin + result := FStack[Cardinal(Longint(FCurrStackBase) - Longint(I) - 1)]; + break; + end; + end; +end; + function TPSCustomDebugExec.GetProcParam(I: Cardinal): PIfVariant; begin Result := FStack[Cardinal(Longint(FCurrStackBase) - Longint(I) - 1)]; end; +function TPSCustomDebugExec.GetProcVar(Name : AnsiString): PIfVariant; +var + i: integer; +begin + result := nil; + Name := FastUppercase( Name ); + for i := 0 to CurrentProcVars.Count-1 do + begin + if ( CurrentProcVars[ i ] = Name ) then + begin + result := FStack[Cardinal(Longint(FCurrStackBase) + Longint(I) + 1)]; + break; + end; + end; +end; + function TPSCustomDebugExec.GetProcVar(I: Cardinal): PIfVariant; begin Result := FStack[Cardinal(Longint(FCurrStackBase) + Longint(I) + 1)]; @@ -686,6 +759,11 @@ procedure TPSDebugExec.SourceChanged; FDebugMode := dmPaused; end; end; + dmStepTo: + begin + if FCurrentRow = FStepToLine then + FDebugMode := dmPaused; + end; end; if @FOnSourceLine <> nil then FOnSourceLine(Self, FCurrentFile, FCurrentSourcePos, FCurrentRow, FCurrentCol); @@ -720,6 +798,12 @@ procedure TPSDebugExec.StepOver; FDebugMode := dmStepOver; end; +procedure TPSDebugExec.StepTo( Line : Cardinal ); +begin + FStepToLine := Line; + FDebugMode := dmStepTo; +end; + constructor TPSDebugExec.Create; begin diff --git a/Source/uPSDisassembly.pas b/Source/uPSDisassembly.pas index ced04928..f6742cba 100644 --- a/Source/uPSDisassembly.pas +++ b/Source/uPSDisassembly.pas @@ -4,6 +4,10 @@ {$I PascalScript.inc} interface + +{$WARN UNSAFE_CODE OFF} +{$WARN UNSAFE_CAST OFF} + uses uPSRuntime, uPSUtils, sysutils; @@ -48,7 +52,7 @@ function IFPS3DataToText(const Input: tbtstring; var Output: string): Boolean; var I: TMyPSExec; - procedure Writeln(const s: string); + procedure Writeln(const s: String); begin Output := Output + s + #13#10; end; @@ -64,6 +68,7 @@ function IFPS3DataToText(const Input: tbtstring; var Output: string): Boolean; btU32: Result := 'U32'; btS32: Result := 'S32'; {$IFNDEF PS_NOINT64}bts64: Result := 'S64'; {$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: Result := 'U64'; {$ENDIF} btChar: Result := {$IFDEF PS_PANSICHAR}'AnsiChar'{$ELSE}'Char'{$ENDIF}; {$IFNDEF PS_NOWIDESTRING} btWideChar: Result := 'WideChar'; @@ -181,6 +186,7 @@ function IFPS3DataToText(const Input: tbtstring; var Output: string): Boolean; w: word; l: Cardinal; {$IFNDEF PS_NOINT64}ff: Int64;{$ENDIF} + {$IFNDEF PS_NOUINT64}ui: UInt64;{$ENDIF} e: extended; ss: single; d: double; @@ -204,6 +210,7 @@ function IFPS3DataToText(const Input: tbtstring; var Output: string): Boolean; btU32: begin if not ReadData(l, 4) then exit; Result := IntToStr(tbtu32(l)); end; btS32: begin if not ReadData(l, 4) then exit; Result := IntToStr(tbts32(l)); end; {$IFNDEF PS_NOINT64}bts64: begin if not ReadData(ff, 8) then exit; Result := IntToStr(ff); end;{$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: begin if not ReadData(ui, 8) then exit; Result := UIntToStr(ui); end;{$ENDIF} btSingle: begin if not ReadData(ss, Sizeof(tbtsingle)) then exit; Result := FloatToStr(ss); end; btDouble: begin if not ReadData(d, Sizeof(tbtdouble)) then exit; Result := FloatToStr(d); end; btExtended: begin if not ReadData(e, Sizeof(tbtextended)) then exit; Result := FloatToStr(e); end; diff --git a/Source/uPSI_Dialogs.pas b/Source/uPSI_Dialogs.pas new file mode 100644 index 00000000..24b2058d --- /dev/null +++ b/Source/uPSI_Dialogs.pas @@ -0,0 +1,1053 @@ +unit uPSI_Dialogs; +{ +This file has been generated by UnitParser v0.7, written by M. Knight +and updated by NP. v/d Spek and George Birbilis. +Source Code from Carlo Kok has been used to implement various sections of +UnitParser. Components of ROPS are used in the construction of UnitParser, +code implementing the class wrapper is taken from Carlo Kok's conv utility + +} +interface + +{$WARN UNSAFE_CODE OFF} + +uses + SysUtils + ,Classes + ,uPSComponent + ,uPSRuntime + ,uPSCompiler + ; + +type +(*----------------------------------------------------------------------------*) + TPSImport_Dialogs = class(TPSPlugin) + public + procedure CompileImport1(CompExec: TPSScript); override; + procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override; + end; + + +{ compile-time registration functions } +procedure SIRegister_TReplaceDialog(CL: TPSPascalCompiler); +procedure SIRegister_TFindDialog(CL: TPSPascalCompiler); +procedure SIRegister_TPageSetupDialog(CL: TPSPascalCompiler); +procedure SIRegister_TPrintDialog(CL: TPSPascalCompiler); +procedure SIRegister_TPrinterSetupDialog(CL: TPSPascalCompiler); +procedure SIRegister_TFontDialog(CL: TPSPascalCompiler); +procedure SIRegister_TColorDialog(CL: TPSPascalCompiler); +procedure SIRegister_TSaveDialog(CL: TPSPascalCompiler); +procedure SIRegister_TOpenDialog(CL: TPSPascalCompiler); +procedure SIRegister_TCommonDialog(CL: TPSPascalCompiler); +procedure SIRegister_Dialogs(CL: TPSPascalCompiler); + +{ run-time registration functions } +procedure RIRegister_Dialogs_Routines(S: TPSExec); +procedure RIRegister_TReplaceDialog(CL: TPSRuntimeClassImporter); +procedure RIRegister_TFindDialog(CL: TPSRuntimeClassImporter); +procedure RIRegister_TPageSetupDialog(CL: TPSRuntimeClassImporter); +procedure RIRegister_TPrintDialog(CL: TPSRuntimeClassImporter); +procedure RIRegister_TPrinterSetupDialog(CL: TPSRuntimeClassImporter); +procedure RIRegister_TFontDialog(CL: TPSRuntimeClassImporter); +procedure RIRegister_TColorDialog(CL: TPSRuntimeClassImporter); +procedure RIRegister_TSaveDialog(CL: TPSRuntimeClassImporter); +procedure RIRegister_TOpenDialog(CL: TPSRuntimeClassImporter); +procedure RIRegister_TCommonDialog(CL: TPSRuntimeClassImporter); +procedure RIRegister_Dialogs(CL: TPSRuntimeClassImporter); + +procedure Register; + +implementation + + +uses + Windows + ,Messages + ,CommDlg + ,Printers + ,Graphics + ,Controls + ,Forms + ,StdCtrls + ,Dialogs + ; + + +procedure Register; +begin + RegisterComponents('Pascal Script', [TPSImport_Dialogs]); +end; + +(* === compile-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure SIRegister_TReplaceDialog(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TFindDialog', 'TReplaceDialog') do + with CL.AddClassN(CL.FindClass('TFindDialog'),'TReplaceDialog') do + begin + RegisterMethod('function Execute( Parent : HWND ) : boolean;'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TFindDialog(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCommonDialog', 'TFindDialog') do + with CL.AddClassN(CL.FindClass('TCommonDialog'),'TFindDialog') do + begin + RegisterMethod('function Execute( Parent : HWND ) : boolean;'); + RegisterMethod('Procedure CloseDialog'); + RegisterProperty('Left', 'Integer', iptrw); + RegisterProperty('Position', 'TPoint', iptrw); + RegisterProperty('Top', 'Integer', iptrw); + RegisterProperty('FindText', 'string', iptrw); + RegisterProperty('Options', 'TFindOptions', iptrw); + RegisterProperty('OnFind', 'TNotifyEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TPageSetupDialog(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCommonDialog', 'TPageSetupDialog') do + with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPageSetupDialog') do + begin + RegisterMethod('function Execute( Parent : HWND ) : boolean;'); + RegisterMethod('Function GetDefaults : Boolean'); + RegisterProperty('PageSetupDlgRec', 'TPageSetupDlg', iptr); + RegisterProperty('MinMarginLeft', 'Integer', iptrw); + RegisterProperty('MinMarginTop', 'Integer', iptrw); + RegisterProperty('MinMarginRight', 'Integer', iptrw); + RegisterProperty('MinMarginBottom', 'Integer', iptrw); + RegisterProperty('MarginLeft', 'Integer', iptrw); + RegisterProperty('MarginTop', 'Integer', iptrw); + RegisterProperty('MarginRight', 'Integer', iptrw); + RegisterProperty('MarginBottom', 'Integer', iptrw); + RegisterProperty('Options', 'TPageSetupDialogOptions', iptrw); + RegisterProperty('PageWidth', 'Integer', iptrw); + RegisterProperty('PageHeight', 'Integer', iptrw); + RegisterProperty('Units', 'TPageMeasureUnits', iptrw); + RegisterProperty('BeforePaint', 'TPageSetupBeforePaintEvent', iptrw); + RegisterProperty('OnDrawFullPage', 'TPaintPageEvent', iptrw); + RegisterProperty('OnDrawMinMargin', 'TPaintPageEvent', iptrw); + RegisterProperty('OnDrawMargin', 'TPaintPageEvent', iptrw); + RegisterProperty('OnDrawGreekText', 'TPaintPageEvent', iptrw); + RegisterProperty('OnDrawEnvStamp', 'TPaintPageEvent', iptrw); + RegisterProperty('OnDrawRetAddress', 'TPaintPageEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TPrintDialog(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCommonDialog', 'TPrintDialog') do + with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrintDialog') do + begin + RegisterMethod('function Execute( Parent : HWND ) : boolean;'); + RegisterProperty('Collate', 'Boolean', iptrw); + RegisterProperty('Copies', 'Integer', iptrw); + RegisterProperty('FromPage', 'Integer', iptrw); + RegisterProperty('MinPage', 'Integer', iptrw); + RegisterProperty('MaxPage', 'Integer', iptrw); + RegisterProperty('Options', 'TPrintDialogOptions', iptrw); + RegisterProperty('PrintToFile', 'Boolean', iptrw); + RegisterProperty('PrintRange', 'TPrintRange', iptrw); + RegisterProperty('ToPage', 'Integer', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TPrinterSetupDialog(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCommonDialog', 'TPrinterSetupDialog') do + with CL.AddClassN(CL.FindClass('TCommonDialog'),'TPrinterSetupDialog') do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TFontDialog(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCommonDialog', 'TFontDialog') do + with CL.AddClassN(CL.FindClass('TCommonDialog'),'TFontDialog') do + begin + RegisterMethod('function Execute( Parent : HWND ) : boolean;'); + RegisterProperty('Font', 'TFont', iptrw); + RegisterProperty('Device', 'TFontDialogDevice', iptrw); + RegisterProperty('MinFontSize', 'Integer', iptrw); + RegisterProperty('MaxFontSize', 'Integer', iptrw); + RegisterProperty('Options', 'TFontDialogOptions', iptrw); + RegisterProperty('OnApply', 'TFDApplyEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TColorDialog(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCommonDialog', 'TColorDialog') do + with CL.AddClassN(CL.FindClass('TCommonDialog'),'TColorDialog') do + begin + RegisterMethod('function Execute( Parent : HWND ) : boolean;'); + RegisterProperty('Color', 'TColor', iptrw); + RegisterProperty('CustomColors', 'TStrings', iptrw); + RegisterProperty('Options', 'TColorDialogOptions', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TSaveDialog(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TOpenDialog', 'TSaveDialog') do + with CL.AddClassN(CL.FindClass('TOpenDialog'),'TSaveDialog') do + begin + RegisterMethod('function Execute( Parent : HWND ) : boolean;'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TOpenDialog(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCommonDialog', 'TOpenDialog') do + with CL.AddClassN(CL.FindClass('TCommonDialog'),'TOpenDialog') do + begin + RegisterMethod('function Execute( Parent : HWND ) : boolean;'); + RegisterProperty('FileEditStyle', 'TFileEditStyle', iptrw); + RegisterProperty('Files', 'TStrings', iptr); + RegisterProperty('HistoryList', 'TStrings', iptrw); + RegisterProperty('DefaultExt', 'string', iptrw); + RegisterProperty('FileName', 'TFileName', iptrw); + RegisterProperty('Filter', 'string', iptrw); + RegisterProperty('FilterIndex', 'Integer', iptrw); + RegisterProperty('InitialDir', 'string', iptrw); + RegisterProperty('Options', 'TOpenOptions', iptrw); + RegisterProperty('OptionsEx', 'TOpenOptionsEx', iptrw); + RegisterProperty('Title', 'string', iptrw); + RegisterProperty('OnCanClose', 'TCloseQueryEvent', iptrw); + RegisterProperty('OnFolderChange', 'TNotifyEvent', iptrw); + RegisterProperty('OnSelectionChange', 'TNotifyEvent', iptrw); + RegisterProperty('OnTypeChange', 'TNotifyEvent', iptrw); +// RegisterProperty('OnIncludeItem', 'TIncludeItemEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TCommonDialog(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TComponent', 'TCommonDialog') do + with CL.AddClassN(CL.FindClass('TComponent'),'TCommonDialog') do + begin + RegisterMethod('Function Execute : Boolean'); + RegisterProperty('Handle', 'HWnd', iptr); + RegisterProperty('Ctl3D', 'Boolean', iptrw); + RegisterProperty('HelpContext', 'THelpContext', iptrw); + RegisterProperty('OnClose', 'TNotifyEvent', iptrw); + RegisterProperty('OnShow', 'TNotifyEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_Dialogs(CL: TPSPascalCompiler); +begin + CL.AddConstantN('MaxCustomColors','LongInt').SetInt( 16); + SIRegister_TCommonDialog(CL); + CL.AddTypeS('TOpenOption', '( ofReadOnly, ofOverwritePrompt, ofHideReadOnly, ' + +'ofNoChangeDir, ofShowHelp, ofNoValidate, ofAllowMultiSelect, ofExtensionDi' + +'fferent, ofPathMustExist, ofFileMustExist, ofCreatePrompt, ofShareAware, o' + +'fNoReadOnlyReturn, ofNoTestFileCreate, ofNoNetworkButton, ofNoLongNames, o' + +'fOldStyleDialog, ofNoDereferenceLinks, ofEnableIncludeNotify, ofEnableSizi' + +'ng, ofDontAddToRecent, ofForceShowHidden )'); + CL.AddTypeS('TOpenOptions', 'set of TOpenOption'); + CL.AddTypeS('TOpenOptionEx', '( ofExNoPlacesBar )'); + CL.AddTypeS('TOpenOptionsEx', 'set of TOpenOptionEx'); + CL.AddTypeS('TFileEditStyle', '( fsEdit, fsComboBox )'); +// CL.AddTypeS('TIncludeItemEvent', 'Procedure ( const OFN : TOFNotifyEx; var In' +// +'clude : Boolean)'); + SIRegister_TOpenDialog(CL); + SIRegister_TSaveDialog(CL); + CL.AddTypeS('TColorDialogOption', '( cdFullOpen, cdPreventFullOpen, cdShowHel' + +'p, cdSolidColor, cdAnyColor )'); + CL.AddTypeS('TColorDialogOptions', 'set of TColorDialogOption'); + SIRegister_TColorDialog(CL); + CL.AddTypeS('TFontDialogOption', '( fdAnsiOnly, fdTrueTypeOnly, fdEffects, fd' + +'FixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts, fdNoSimulatio' + +'ns, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts, fdShowHelp, fdWysiwyg, fdL' + +'imitSize, fdScalableOnly, fdApplyButton )'); + CL.AddTypeS('TFontDialogOptions', 'set of TFontDialogOption'); + CL.AddTypeS('TFontDialogDevice', '( fdScreen, fdPrinter, fdBoth )'); + CL.AddTypeS('TFDApplyEvent', 'Procedure ( Sender : TObject; Wnd : HWND)'); + SIRegister_TFontDialog(CL); + SIRegister_TPrinterSetupDialog(CL); + CL.AddTypeS('TPrintRange', '( prAllPages, prSelection, prPageNums )'); + CL.AddTypeS('TPrintDialogOption', '( poPrintToFile, poPageNums, poSelection, ' + +'poWarning, poHelp, poDisablePrintToFile )'); + CL.AddTypeS('TPrintDialogOptions', 'set of TPrintDialogOption'); + SIRegister_TPrintDialog(CL); + CL.AddTypeS('TPageSetupDialogOption', '( psoDefaultMinMargins, psoDisableMarg' + +'ins, psoDisableOrientation, psoDisablePagePainting, psoDisablePaper, psoDi' + +'sablePrinter, psoMargins, psoMinMargins, psoShowHelp, psoWarning, psoNoNet' + +'workButton )'); + CL.AddTypeS('TPageSetupDialogOptions', 'set of TPageSetupDialogOption'); + CL.AddTypeS('TPrinterKind', '( pkDotMatrix, pkHPPCL )'); + CL.AddTypeS('TPageType', '( ptEnvelope, ptPaper )'); + CL.AddTypeS('TPrinterOrientation', '(poPortrait, poLandscape)'); + CL.AddTypeS('TPageSetupBeforePaintEvent', 'Procedure ( Sender : TObject; cons' + +'t PaperSize : SmallInt; const Orientation : TPrinterOrientation; const Pag' + +'eType : TPageType; var DoneDrawing : Boolean)'); + CL.AddTypeS('TPageMeasureUnits', '( pmDefault, pmMillimeters, pmInches )'); + CL.AddTypeS('TPaintPageEvent', 'Procedure ( Sender : TObject; Canvas : TCanva' + +'s; PageRect : TRect; var DoneDrawing : Boolean)'); + SIRegister_TPageSetupDialog(CL); + CL.AddTypeS('TFindOption', '( frDown, frFindNext, frHideMatchCase, frHideWhol' + +'eWord, frHideUpDown, frMatchCase, frDisableMatchCase, frDisableUpDown, frD' + +'isableWholeWord, frReplace, frReplaceAll, frWholeWord, frShowHelp )'); + CL.AddTypeS('TFindOptions', 'set of TFindOption'); + SIRegister_TFindDialog(CL); + SIRegister_TReplaceDialog(CL); + CL.AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmati' + +'on, mtCustom )'); + CL.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m' + +'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )'); + CL.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn'); + CL.AddConstantN('mbYesNoCancel','LongInt').Value.ts32 := ord(mbYes) or ord(mbNo) or ord(mbCancel); + CL.AddConstantN('mbYesAllNoAllCancel','LongInt').Value.ts32 := ord(mbYes) or ord(mbYesToAll) or ord(mbNo) or ord(mbNoToAll) or ord(mbCancel); + CL.AddConstantN('mbOKCancel','LongInt').Value.ts32 := ord(mbOK) or ord(mbCancel); + CL.AddConstantN('mbAbortRetryIgnore','LongInt').Value.ts32 := ord(mbAbort) or ord(mbRetry) or ord(mbIgnore); + CL.AddConstantN('mbAbortIgnore','LongInt').Value.ts32 := ord(mbAbort) or ord(mbIgnore); + CL.AddDelphiFunction('Function CreateMessageDialog( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons) : TForm'); + CL.AddDelphiFunction('Function MessageDlg( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint) : Integer'); + CL.AddDelphiFunction('Function MessageDlgPos( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint; X, Y : Integer) : Integer'); + CL.AddDelphiFunction('Function MessageDlgPosHelp( const Msg : string; DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; HelpCtx : Longint; X, Y : Integer; const HelpFileName : string) : Integer'); + CL.AddDelphiFunction('Procedure ShowMessage( const Msg : string)'); + CL.AddDelphiFunction('Procedure ShowMessageFmt( const Msg : string; Params : array of const)'); + CL.AddDelphiFunction('Procedure ShowMessagePos( const Msg : string; X, Y : Integer)'); + CL.AddDelphiFunction('Function InputBox( const ACaption, APrompt, ADefault : string) : string'); + CL.AddDelphiFunction('Function InputQuery( const ACaption, APrompt : string; var Value : string) : Boolean'); + {$IF CompilerVersion >= 28} +// CL.AddTypeS('TArrayOfString', 'array of string'); +// CL.AddTypeS('TInputCloseQueryEvent', 'procedure(Sender: TObject; const Values: TArrayOfString; var CanClose: Boolean) of object;'); +// CL.AddTypeS('TInputCloseQueryFunc', 'function (const Values: TArrayOfString): Boolean'); +// CL.AddDelphiFunction('function InputQuery2(const ACaption: string; const APrompts: array of string; var AValues: array of string; CloseQueryFunc: TInputCloseQueryFunc{ = nil}): Boolean;'); +// CL.AddDelphiFunction('function InputQuery3(const ACaption: string; const APrompts: array of string; var AValues: array of string; CloseQueryEvent: TInputCloseQueryEvent; Context: TObject{ = nil}): Boolean;'); + {$IFEND} + CL.AddDelphiFunction('Function PromptForFileName( var AFileName : string; const AFilter : string; const ADefaultExt : string; const ATitle : string; const AInitialDir : string; SaveDialog : Boolean) : Boolean'); +end; + +(* === run-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure TFindDialogOnFind_W(Self: TFindDialog; const T: TNotifyEvent); +begin Self.OnFind := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogOnFind_R(Self: TFindDialog; var T: TNotifyEvent); +begin T := Self.OnFind; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogOptions_W(Self: TFindDialog; const T: TFindOptions); +begin Self.Options := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogOptions_R(Self: TFindDialog; var T: TFindOptions); +begin T := Self.Options; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogFindText_W(Self: TFindDialog; const T: string); +begin Self.FindText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogFindText_R(Self: TFindDialog; var T: string); +begin T := Self.FindText; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogTop_W(Self: TFindDialog; const T: Integer); +begin Self.Top := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogTop_R(Self: TFindDialog; var T: Integer); +begin T := Self.Top; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogPosition_W(Self: TFindDialog; const T: TPoint); +begin Self.Position := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogPosition_R(Self: TFindDialog; var T: TPoint); +begin T := Self.Position; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogLeft_W(Self: TFindDialog; const T: Integer); +begin Self.Left := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFindDialogLeft_R(Self: TFindDialog; var T: Integer); +begin T := Self.Left; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawRetAddress_W(Self: TPageSetupDialog; const T: TPaintPageEvent); +begin Self.OnDrawRetAddress := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawRetAddress_R(Self: TPageSetupDialog; var T: TPaintPageEvent); +begin T := Self.OnDrawRetAddress; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawEnvStamp_W(Self: TPageSetupDialog; const T: TPaintPageEvent); +begin Self.OnDrawEnvStamp := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawEnvStamp_R(Self: TPageSetupDialog; var T: TPaintPageEvent); +begin T := Self.OnDrawEnvStamp; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawGreekText_W(Self: TPageSetupDialog; const T: TPaintPageEvent); +begin Self.OnDrawGreekText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawGreekText_R(Self: TPageSetupDialog; var T: TPaintPageEvent); +begin T := Self.OnDrawGreekText; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawMargin_W(Self: TPageSetupDialog; const T: TPaintPageEvent); +begin Self.OnDrawMargin := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawMargin_R(Self: TPageSetupDialog; var T: TPaintPageEvent); +begin T := Self.OnDrawMargin; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawMinMargin_W(Self: TPageSetupDialog; const T: TPaintPageEvent); +begin Self.OnDrawMinMargin := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawMinMargin_R(Self: TPageSetupDialog; var T: TPaintPageEvent); +begin T := Self.OnDrawMinMargin; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawFullPage_W(Self: TPageSetupDialog; const T: TPaintPageEvent); +begin Self.OnDrawFullPage := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOnDrawFullPage_R(Self: TPageSetupDialog; var T: TPaintPageEvent); +begin T := Self.OnDrawFullPage; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogBeforePaint_W(Self: TPageSetupDialog; const T: TPageSetupBeforePaintEvent); +begin Self.BeforePaint := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogBeforePaint_R(Self: TPageSetupDialog; var T: TPageSetupBeforePaintEvent); +begin T := Self.BeforePaint; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogUnits_W(Self: TPageSetupDialog; const T: TPageMeasureUnits); +begin Self.Units := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogUnits_R(Self: TPageSetupDialog; var T: TPageMeasureUnits); +begin T := Self.Units; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogPageHeight_W(Self: TPageSetupDialog; const T: Integer); +begin Self.PageHeight := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogPageHeight_R(Self: TPageSetupDialog; var T: Integer); +begin T := Self.PageHeight; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogPageWidth_W(Self: TPageSetupDialog; const T: Integer); +begin Self.PageWidth := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogPageWidth_R(Self: TPageSetupDialog; var T: Integer); +begin T := Self.PageWidth; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOptions_W(Self: TPageSetupDialog; const T: TPageSetupDialogOptions); +begin Self.Options := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogOptions_R(Self: TPageSetupDialog; var T: TPageSetupDialogOptions); +begin T := Self.Options; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMarginBottom_W(Self: TPageSetupDialog; const T: Integer); +begin Self.MarginBottom := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMarginBottom_R(Self: TPageSetupDialog; var T: Integer); +begin T := Self.MarginBottom; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMarginRight_W(Self: TPageSetupDialog; const T: Integer); +begin Self.MarginRight := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMarginRight_R(Self: TPageSetupDialog; var T: Integer); +begin T := Self.MarginRight; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMarginTop_W(Self: TPageSetupDialog; const T: Integer); +begin Self.MarginTop := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMarginTop_R(Self: TPageSetupDialog; var T: Integer); +begin T := Self.MarginTop; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMarginLeft_W(Self: TPageSetupDialog; const T: Integer); +begin Self.MarginLeft := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMarginLeft_R(Self: TPageSetupDialog; var T: Integer); +begin T := Self.MarginLeft; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMinMarginBottom_W(Self: TPageSetupDialog; const T: Integer); +begin Self.MinMarginBottom := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMinMarginBottom_R(Self: TPageSetupDialog; var T: Integer); +begin T := Self.MinMarginBottom; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMinMarginRight_W(Self: TPageSetupDialog; const T: Integer); +begin Self.MinMarginRight := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMinMarginRight_R(Self: TPageSetupDialog; var T: Integer); +begin T := Self.MinMarginRight; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMinMarginTop_W(Self: TPageSetupDialog; const T: Integer); +begin Self.MinMarginTop := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMinMarginTop_R(Self: TPageSetupDialog; var T: Integer); +begin T := Self.MinMarginTop; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMinMarginLeft_W(Self: TPageSetupDialog; const T: Integer); +begin Self.MinMarginLeft := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogMinMarginLeft_R(Self: TPageSetupDialog; var T: Integer); +begin T := Self.MinMarginLeft; end; + +(*----------------------------------------------------------------------------*) +procedure TPageSetupDialogPageSetupDlgRec_R(Self: TPageSetupDialog; var T: TPageSetupDlg); +begin T := Self.PageSetupDlgRec; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogToPage_W(Self: TPrintDialog; const T: Integer); +begin Self.ToPage := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogToPage_R(Self: TPrintDialog; var T: Integer); +begin T := Self.ToPage; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogPrintRange_W(Self: TPrintDialog; const T: TPrintRange); +begin Self.PrintRange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogPrintRange_R(Self: TPrintDialog; var T: TPrintRange); +begin T := Self.PrintRange; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogPrintToFile_W(Self: TPrintDialog; const T: Boolean); +begin Self.PrintToFile := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogPrintToFile_R(Self: TPrintDialog; var T: Boolean); +begin T := Self.PrintToFile; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogOptions_W(Self: TPrintDialog; const T: TPrintDialogOptions); +begin Self.Options := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogOptions_R(Self: TPrintDialog; var T: TPrintDialogOptions); +begin T := Self.Options; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogMaxPage_W(Self: TPrintDialog; const T: Integer); +begin Self.MaxPage := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogMaxPage_R(Self: TPrintDialog; var T: Integer); +begin T := Self.MaxPage; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogMinPage_W(Self: TPrintDialog; const T: Integer); +begin Self.MinPage := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogMinPage_R(Self: TPrintDialog; var T: Integer); +begin T := Self.MinPage; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogFromPage_W(Self: TPrintDialog; const T: Integer); +begin Self.FromPage := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogFromPage_R(Self: TPrintDialog; var T: Integer); +begin T := Self.FromPage; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogCopies_W(Self: TPrintDialog; const T: Integer); +begin Self.Copies := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogCopies_R(Self: TPrintDialog; var T: Integer); +begin T := Self.Copies; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogCollate_W(Self: TPrintDialog; const T: Boolean); +begin Self.Collate := T; end; + +(*----------------------------------------------------------------------------*) +procedure TPrintDialogCollate_R(Self: TPrintDialog; var T: Boolean); +begin T := Self.Collate; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogOnApply_W(Self: TFontDialog; const T: TFDApplyEvent); +begin Self.OnApply := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogOnApply_R(Self: TFontDialog; var T: TFDApplyEvent); +begin T := Self.OnApply; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogOptions_W(Self: TFontDialog; const T: TFontDialogOptions); +begin Self.Options := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogOptions_R(Self: TFontDialog; var T: TFontDialogOptions); +begin T := Self.Options; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogMaxFontSize_W(Self: TFontDialog; const T: Integer); +begin Self.MaxFontSize := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogMaxFontSize_R(Self: TFontDialog; var T: Integer); +begin T := Self.MaxFontSize; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogMinFontSize_W(Self: TFontDialog; const T: Integer); +begin Self.MinFontSize := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogMinFontSize_R(Self: TFontDialog; var T: Integer); +begin T := Self.MinFontSize; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogDevice_W(Self: TFontDialog; const T: TFontDialogDevice); +begin Self.Device := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogDevice_R(Self: TFontDialog; var T: TFontDialogDevice); +begin T := Self.Device; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogFont_W(Self: TFontDialog; const T: TFont); +begin Self.Font := T; end; + +(*----------------------------------------------------------------------------*) +procedure TFontDialogFont_R(Self: TFontDialog; var T: TFont); +begin T := Self.Font; end; + +(*----------------------------------------------------------------------------*) +procedure TColorDialogOptions_W(Self: TColorDialog; const T: TColorDialogOptions); +begin Self.Options := T; end; + +(*----------------------------------------------------------------------------*) +procedure TColorDialogOptions_R(Self: TColorDialog; var T: TColorDialogOptions); +begin T := Self.Options; end; + +(*----------------------------------------------------------------------------*) +procedure TColorDialogCustomColors_W(Self: TColorDialog; const T: TStrings); +begin Self.CustomColors := T; end; + +(*----------------------------------------------------------------------------*) +procedure TColorDialogCustomColors_R(Self: TColorDialog; var T: TStrings); +begin T := Self.CustomColors; end; + +(*----------------------------------------------------------------------------*) +procedure TColorDialogColor_W(Self: TColorDialog; const T: TColor); +begin Self.Color := T; end; + +(*----------------------------------------------------------------------------*) +procedure TColorDialogColor_R(Self: TColorDialog; var T: TColor); +begin T := Self.Color; end; + +(*----------------------------------------------------------------------------*) +//procedure TOpenDialogOnIncludeItem_W(Self: TOpenDialog; const T: TIncludeItemEvent); +//begin Self.OnIncludeItem := T; end; + +(*----------------------------------------------------------------------------*) +//procedure TOpenDialogOnIncludeItem_R(Self: TOpenDialog; var T: TIncludeItemEvent); +//begin T := Self.OnIncludeItem; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOnTypeChange_W(Self: TOpenDialog; const T: TNotifyEvent); +begin Self.OnTypeChange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOnTypeChange_R(Self: TOpenDialog; var T: TNotifyEvent); +begin T := Self.OnTypeChange; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOnSelectionChange_W(Self: TOpenDialog; const T: TNotifyEvent); +begin Self.OnSelectionChange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOnSelectionChange_R(Self: TOpenDialog; var T: TNotifyEvent); +begin T := Self.OnSelectionChange; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOnFolderChange_W(Self: TOpenDialog; const T: TNotifyEvent); +begin Self.OnFolderChange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOnFolderChange_R(Self: TOpenDialog; var T: TNotifyEvent); +begin T := Self.OnFolderChange; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOnCanClose_W(Self: TOpenDialog; const T: TCloseQueryEvent); +begin Self.OnCanClose := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOnCanClose_R(Self: TOpenDialog; var T: TCloseQueryEvent); +begin T := Self.OnCanClose; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogTitle_W(Self: TOpenDialog; const T: string); +begin Self.Title := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogTitle_R(Self: TOpenDialog; var T: string); +begin T := Self.Title; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOptionsEx_W(Self: TOpenDialog; const T: TOpenOptionsEx); +begin Self.OptionsEx := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOptionsEx_R(Self: TOpenDialog; var T: TOpenOptionsEx); +begin T := Self.OptionsEx; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOptions_W(Self: TOpenDialog; const T: TOpenOptions); +begin Self.Options := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogOptions_R(Self: TOpenDialog; var T: TOpenOptions); +begin T := Self.Options; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogInitialDir_W(Self: TOpenDialog; const T: string); +begin Self.InitialDir := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogInitialDir_R(Self: TOpenDialog; var T: string); +begin T := Self.InitialDir; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogFilterIndex_W(Self: TOpenDialog; const T: Integer); +begin Self.FilterIndex := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogFilterIndex_R(Self: TOpenDialog; var T: Integer); +begin T := Self.FilterIndex; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogFilter_W(Self: TOpenDialog; const T: string); +begin Self.Filter := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogFilter_R(Self: TOpenDialog; var T: string); +begin T := Self.Filter; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogFileName_W(Self: TOpenDialog; const T: TFileName); +begin Self.FileName := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogFileName_R(Self: TOpenDialog; var T: TFileName); +begin T := Self.FileName; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogDefaultExt_W(Self: TOpenDialog; const T: string); +begin Self.DefaultExt := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogDefaultExt_R(Self: TOpenDialog; var T: string); +begin T := Self.DefaultExt; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogHistoryList_W(Self: TOpenDialog; const T: TStrings); +begin Self.HistoryList := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogHistoryList_R(Self: TOpenDialog; var T: TStrings); +begin T := Self.HistoryList; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogFiles_R(Self: TOpenDialog; var T: TStrings); +begin T := Self.Files; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogFileEditStyle_W(Self: TOpenDialog; const T: TFileEditStyle); +begin Self.FileEditStyle := T; end; + +(*----------------------------------------------------------------------------*) +procedure TOpenDialogFileEditStyle_R(Self: TOpenDialog; var T: TFileEditStyle); +begin T := Self.FileEditStyle; end; + +(*----------------------------------------------------------------------------*) +procedure TCommonDialogOnShow_W(Self: TCommonDialog; const T: TNotifyEvent); +begin Self.OnShow := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCommonDialogOnShow_R(Self: TCommonDialog; var T: TNotifyEvent); +begin T := Self.OnShow; end; + +(*----------------------------------------------------------------------------*) +procedure TCommonDialogOnClose_W(Self: TCommonDialog; const T: TNotifyEvent); +begin Self.OnClose := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCommonDialogOnClose_R(Self: TCommonDialog; var T: TNotifyEvent); +begin T := Self.OnClose; end; + +(*----------------------------------------------------------------------------*) +procedure TCommonDialogHelpContext_W(Self: TCommonDialog; const T: THelpContext); +begin Self.HelpContext := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCommonDialogHelpContext_R(Self: TCommonDialog; var T: THelpContext); +begin T := Self.HelpContext; end; + +(*----------------------------------------------------------------------------*) +procedure TCommonDialogCtl3D_W(Self: TCommonDialog; const T: Boolean); +begin Self.Ctl3D := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCommonDialogCtl3D_R(Self: TCommonDialog; var T: Boolean); +begin T := Self.Ctl3D; end; + +(*----------------------------------------------------------------------------*) +procedure TCommonDialogHandle_R(Self: TCommonDialog; var T: HWnd); +begin T := Self.Handle; end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_Dialogs_Routines(S: TPSExec); +begin + S.RegisterDelphiFunction(@CreateMessageDialog, 'CreateMessageDialog', cdRegister); + S.RegisterDelphiFunction(@MessageDlg, 'MessageDlg', cdRegister); + S.RegisterDelphiFunction(@MessageDlgPos, 'MessageDlgPos', cdRegister); + S.RegisterDelphiFunction(@MessageDlgPosHelp, 'MessageDlgPosHelp', cdRegister); + S.RegisterDelphiFunction(@ShowMessage, 'ShowMessage', cdRegister); + S.RegisterDelphiFunction(@ShowMessageFmt, 'ShowMessageFmt', cdRegister); + S.RegisterDelphiFunction(@ShowMessagePos, 'ShowMessagePos', cdRegister); + S.RegisterDelphiFunction(@InputBox, 'InputBox', cdRegister); + S.RegisterDelphiFunction(@InputQuery, 'InputQuery', cdRegister); + {$IF CompilerVersion >= 28} +// S.RegisterDelphiFunction(@InputQuery, 'InputQuery2', cdRegister); +// S.RegisterDelphiFunction(@InputQuery, 'InputQuery3', cdRegister); + {$IFEND} + S.RegisterDelphiFunction(@PromptForFileName, 'PromptForFileName', cdRegister); +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TReplaceDialog(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TReplaceDialog) do + begin + RegisterMethod(@TReplaceDialog.Execute, 'Execute' ); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TFindDialog(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TFindDialog) do + begin + RegisterMethod(@TFindDialog.Execute, 'Execute' ); + RegisterMethod(@TFindDialog.CloseDialog, 'CloseDialog'); + RegisterPropertyHelper(@TFindDialogLeft_R,@TFindDialogLeft_W,'Left'); + RegisterPropertyHelper(@TFindDialogPosition_R,@TFindDialogPosition_W,'Position'); + RegisterPropertyHelper(@TFindDialogTop_R,@TFindDialogTop_W,'Top'); + RegisterPropertyHelper(@TFindDialogFindText_R,@TFindDialogFindText_W,'FindText'); + RegisterPropertyHelper(@TFindDialogOptions_R,@TFindDialogOptions_W,'Options'); + RegisterPropertyHelper(@TFindDialogOnFind_R,@TFindDialogOnFind_W,'OnFind'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TPageSetupDialog(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TPageSetupDialog) do + begin + RegisterMethod(@TPageSetupDialog.Execute, 'Execute' ); + RegisterMethod(@TPageSetupDialog.GetDefaults, 'GetDefaults'); + RegisterPropertyHelper(@TPageSetupDialogPageSetupDlgRec_R,nil,'PageSetupDlgRec'); + RegisterPropertyHelper(@TPageSetupDialogMinMarginLeft_R,@TPageSetupDialogMinMarginLeft_W,'MinMarginLeft'); + RegisterPropertyHelper(@TPageSetupDialogMinMarginTop_R,@TPageSetupDialogMinMarginTop_W,'MinMarginTop'); + RegisterPropertyHelper(@TPageSetupDialogMinMarginRight_R,@TPageSetupDialogMinMarginRight_W,'MinMarginRight'); + RegisterPropertyHelper(@TPageSetupDialogMinMarginBottom_R,@TPageSetupDialogMinMarginBottom_W,'MinMarginBottom'); + RegisterPropertyHelper(@TPageSetupDialogMarginLeft_R,@TPageSetupDialogMarginLeft_W,'MarginLeft'); + RegisterPropertyHelper(@TPageSetupDialogMarginTop_R,@TPageSetupDialogMarginTop_W,'MarginTop'); + RegisterPropertyHelper(@TPageSetupDialogMarginRight_R,@TPageSetupDialogMarginRight_W,'MarginRight'); + RegisterPropertyHelper(@TPageSetupDialogMarginBottom_R,@TPageSetupDialogMarginBottom_W,'MarginBottom'); + RegisterPropertyHelper(@TPageSetupDialogOptions_R,@TPageSetupDialogOptions_W,'Options'); + RegisterPropertyHelper(@TPageSetupDialogPageWidth_R,@TPageSetupDialogPageWidth_W,'PageWidth'); + RegisterPropertyHelper(@TPageSetupDialogPageHeight_R,@TPageSetupDialogPageHeight_W,'PageHeight'); + RegisterPropertyHelper(@TPageSetupDialogUnits_R,@TPageSetupDialogUnits_W,'Units'); + RegisterPropertyHelper(@TPageSetupDialogBeforePaint_R,@TPageSetupDialogBeforePaint_W,'BeforePaint'); + RegisterPropertyHelper(@TPageSetupDialogOnDrawFullPage_R,@TPageSetupDialogOnDrawFullPage_W,'OnDrawFullPage'); + RegisterPropertyHelper(@TPageSetupDialogOnDrawMinMargin_R,@TPageSetupDialogOnDrawMinMargin_W,'OnDrawMinMargin'); + RegisterPropertyHelper(@TPageSetupDialogOnDrawMargin_R,@TPageSetupDialogOnDrawMargin_W,'OnDrawMargin'); + RegisterPropertyHelper(@TPageSetupDialogOnDrawGreekText_R,@TPageSetupDialogOnDrawGreekText_W,'OnDrawGreekText'); + RegisterPropertyHelper(@TPageSetupDialogOnDrawEnvStamp_R,@TPageSetupDialogOnDrawEnvStamp_W,'OnDrawEnvStamp'); + RegisterPropertyHelper(@TPageSetupDialogOnDrawRetAddress_R,@TPageSetupDialogOnDrawRetAddress_W,'OnDrawRetAddress'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TPrintDialog(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TPrintDialog) do + begin + RegisterMethod(@TPrintDialog.Execute, 'Execute' ); + RegisterPropertyHelper(@TPrintDialogCollate_R,@TPrintDialogCollate_W,'Collate'); + RegisterPropertyHelper(@TPrintDialogCopies_R,@TPrintDialogCopies_W,'Copies'); + RegisterPropertyHelper(@TPrintDialogFromPage_R,@TPrintDialogFromPage_W,'FromPage'); + RegisterPropertyHelper(@TPrintDialogMinPage_R,@TPrintDialogMinPage_W,'MinPage'); + RegisterPropertyHelper(@TPrintDialogMaxPage_R,@TPrintDialogMaxPage_W,'MaxPage'); + RegisterPropertyHelper(@TPrintDialogOptions_R,@TPrintDialogOptions_W,'Options'); + RegisterPropertyHelper(@TPrintDialogPrintToFile_R,@TPrintDialogPrintToFile_W,'PrintToFile'); + RegisterPropertyHelper(@TPrintDialogPrintRange_R,@TPrintDialogPrintRange_W,'PrintRange'); + RegisterPropertyHelper(@TPrintDialogToPage_R,@TPrintDialogToPage_W,'ToPage'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TPrinterSetupDialog(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TPrinterSetupDialog) do + begin + RegisterMethod(@TPrinterSetupDialog.Execute, 'Execute' ); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TFontDialog(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TFontDialog) do + begin + RegisterMethod(@TFontDialog.Execute, 'Execute' ); + RegisterPropertyHelper(@TFontDialogFont_R,@TFontDialogFont_W,'Font'); + RegisterPropertyHelper(@TFontDialogDevice_R,@TFontDialogDevice_W,'Device'); + RegisterPropertyHelper(@TFontDialogMinFontSize_R,@TFontDialogMinFontSize_W,'MinFontSize'); + RegisterPropertyHelper(@TFontDialogMaxFontSize_R,@TFontDialogMaxFontSize_W,'MaxFontSize'); + RegisterPropertyHelper(@TFontDialogOptions_R,@TFontDialogOptions_W,'Options'); + RegisterPropertyHelper(@TFontDialogOnApply_R,@TFontDialogOnApply_W,'OnApply'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TColorDialog(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TColorDialog) do + begin + RegisterMethod(@TColorDialog.Execute, 'Execute' ); + RegisterPropertyHelper(@TColorDialogColor_R,@TColorDialogColor_W,'Color'); + RegisterPropertyHelper(@TColorDialogCustomColors_R,@TColorDialogCustomColors_W,'CustomColors'); + RegisterPropertyHelper(@TColorDialogOptions_R,@TColorDialogOptions_W,'Options'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TSaveDialog(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TSaveDialog) do + begin + RegisterMethod(@TSaveDialog.Execute, 'Execute' ); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TOpenDialog(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TOpenDialog) do + begin + RegisterMethod(@TOpenDialog.Execute, 'Execute' ); + + RegisterPropertyHelper(@TOpenDialogFileEditStyle_R,@TOpenDialogFileEditStyle_W,'FileEditStyle'); + RegisterPropertyHelper(@TOpenDialogFiles_R,nil,'Files'); + RegisterPropertyHelper(@TOpenDialogHistoryList_R,@TOpenDialogHistoryList_W,'HistoryList'); + RegisterPropertyHelper(@TOpenDialogDefaultExt_R,@TOpenDialogDefaultExt_W,'DefaultExt'); + RegisterPropertyHelper(@TOpenDialogFileName_R,@TOpenDialogFileName_W,'FileName'); + RegisterPropertyHelper(@TOpenDialogFilter_R,@TOpenDialogFilter_W,'Filter'); + RegisterPropertyHelper(@TOpenDialogFilterIndex_R,@TOpenDialogFilterIndex_W,'FilterIndex'); + RegisterPropertyHelper(@TOpenDialogInitialDir_R,@TOpenDialogInitialDir_W,'InitialDir'); + RegisterPropertyHelper(@TOpenDialogOptions_R,@TOpenDialogOptions_W,'Options'); + RegisterPropertyHelper(@TOpenDialogOptionsEx_R,@TOpenDialogOptionsEx_W,'OptionsEx'); + RegisterPropertyHelper(@TOpenDialogTitle_R,@TOpenDialogTitle_W,'Title'); + RegisterPropertyHelper(@TOpenDialogOnCanClose_R,@TOpenDialogOnCanClose_W,'OnCanClose'); + RegisterPropertyHelper(@TOpenDialogOnFolderChange_R,@TOpenDialogOnFolderChange_W,'OnFolderChange'); + RegisterPropertyHelper(@TOpenDialogOnSelectionChange_R,@TOpenDialogOnSelectionChange_W,'OnSelectionChange'); + RegisterPropertyHelper(@TOpenDialogOnTypeChange_R,@TOpenDialogOnTypeChange_W,'OnTypeChange'); +// RegisterPropertyHelper(@TOpenDialogOnIncludeItem_R,@TOpenDialogOnIncludeItem_W,'OnIncludeItem'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TCommonDialog(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TCommonDialog) do + begin +// RegisterVirtualAbstractMethod(@TCommonDialog, @TCommonDialog.Execute, 'Execute'); + RegisterPropertyHelper(@TCommonDialogHandle_R,nil,'Handle'); + RegisterPropertyHelper(@TCommonDialogCtl3D_R,@TCommonDialogCtl3D_W,'Ctl3D'); + RegisterPropertyHelper(@TCommonDialogHelpContext_R,@TCommonDialogHelpContext_W,'HelpContext'); + RegisterPropertyHelper(@TCommonDialogOnClose_R,@TCommonDialogOnClose_W,'OnClose'); + RegisterPropertyHelper(@TCommonDialogOnShow_R,@TCommonDialogOnShow_W,'OnShow'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_Dialogs(CL: TPSRuntimeClassImporter); +begin + RIRegister_TCommonDialog(CL); + RIRegister_TOpenDialog(CL); + RIRegister_TSaveDialog(CL); + RIRegister_TColorDialog(CL); + RIRegister_TFontDialog(CL); + RIRegister_TPrinterSetupDialog(CL); + RIRegister_TPrintDialog(CL); + RIRegister_TPageSetupDialog(CL); + RIRegister_TFindDialog(CL); + RIRegister_TReplaceDialog(CL); +end; + + + +{ TPSImport_Dialogs } +(*----------------------------------------------------------------------------*) +procedure TPSImport_Dialogs.CompileImport1(CompExec: TPSScript); +begin + SIRegister_Dialogs(CompExec.Comp); +end; +(*----------------------------------------------------------------------------*) +procedure TPSImport_Dialogs.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); +begin + RIRegister_Dialogs(ri); + RIRegister_Dialogs_Routines(CompExec.Exec); // comment it if no routines +end; +(*----------------------------------------------------------------------------*) + + +end. diff --git a/Source/uPSI_IniFiles.pas b/Source/uPSI_IniFiles.pas new file mode 100644 index 00000000..7f9c0288 --- /dev/null +++ b/Source/uPSI_IniFiles.pas @@ -0,0 +1,297 @@ +unit uPSI_IniFiles; +{ +This file has been generated by UnitParser v0.7, written by M. Knight +and updated by NP. v/d Spek and George Birbilis. +Source Code from Carlo Kok has been used to implement various sections of +UnitParser. Components of ROPS are used in the construction of UnitParser, +code implementing the class wrapper is taken from Carlo Kok's conv utility + +} +interface + +{$WARN UNSAFE_CODE OFF} + +uses + SysUtils + ,Classes + ,uPSComponent + ,uPSRuntime + ,uPSCompiler + ; + +type +(*----------------------------------------------------------------------------*) + TPSImport_IniFiles = class(TPSPlugin) + public + procedure CompileImport1(CompExec: TPSScript); override; + procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override; + end; + + +{ compile-time registration functions } +procedure SIRegister_TIniFile(CL: TPSPascalCompiler); +procedure SIRegister_TMemIniFile(CL: TPSPascalCompiler); +procedure SIRegister_THashedStringList(CL: TPSPascalCompiler); +procedure SIRegister_TStringHash(CL: TPSPascalCompiler); +procedure SIRegister_TCustomIniFile(CL: TPSPascalCompiler); +procedure SIRegister_IniFiles(CL: TPSPascalCompiler); + +{ run-time registration functions } +procedure RIRegister_TIniFile(CL: TPSRuntimeClassImporter); +procedure RIRegister_TMemIniFile(CL: TPSRuntimeClassImporter); +procedure RIRegister_THashedStringList(CL: TPSRuntimeClassImporter); +procedure RIRegister_TStringHash(CL: TPSRuntimeClassImporter); +procedure RIRegister_TCustomIniFile(CL: TPSRuntimeClassImporter); +procedure RIRegister_IniFiles(CL: TPSRuntimeClassImporter); + +procedure Register; + +implementation + + +uses + IniFiles + ; + + +procedure Register; +begin + RegisterComponents('Pascal Script', [TPSImport_IniFiles]); +end; + +(* === compile-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure SIRegister_TIniFile(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomIniFile', 'TIniFile') do + with CL.AddClassN(CL.FindClass('TCustomIniFile'),'TIniFile') do + begin + RegisterMethod('Constructor Create( const FileName : string)'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TMemIniFile(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomIniFile', 'TMemIniFile') do + with CL.AddClassN(CL.FindClass('TCustomIniFile'),'TMemIniFile') do + begin + RegisterMethod('Constructor Create( const FileName : string)'); + RegisterMethod('Procedure Clear'); + RegisterMethod('Procedure GetStrings( List : TStrings)'); + RegisterMethod('Procedure Rename( const FileName : string; Reload : Boolean)'); + RegisterMethod('Procedure SetStrings( List : TStrings)'); + RegisterProperty('CaseSensitive', 'Boolean', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_THashedStringList(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TStringList', 'THashedStringList') do + with CL.AddClassN(CL.FindClass('TStringList'),'THashedStringList') do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TStringHash(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TOBJECT', 'TStringHash') do + with CL.AddClassN(CL.FindClass('TOBJECT'),'TStringHash') do + begin + RegisterMethod('Constructor Create( Size : Cardinal)'); + RegisterMethod('Procedure Add( const Key : string; Value : Integer)'); + RegisterMethod('Procedure Clear'); + RegisterMethod('Procedure Remove( const Key : string)'); + RegisterMethod('Function Modify( const Key : string; Value : Integer) : Boolean'); + RegisterMethod('Function ValueOf( const Key : string) : Integer'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TCustomIniFile(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TObject', 'TCustomIniFile') do + with CL.AddClassN(CL.FindClass('TObject'),'TCustomIniFile') do + begin + RegisterMethod('Constructor Create( const FileName : string)'); + RegisterMethod('Function SectionExists( const Section : string) : Boolean'); + RegisterMethod('Function ReadString( const Section, Ident, Default : string) : string'); + RegisterMethod('Procedure WriteString( const Section, Ident, Value : String)'); + RegisterMethod('Function ReadInteger( const Section, Ident : string; Default : Longint) : Longint'); + RegisterMethod('Procedure WriteInteger( const Section, Ident : string; Value : Longint)'); + RegisterMethod('Function ReadBool( const Section, Ident : string; Default : Boolean) : Boolean'); + RegisterMethod('Procedure WriteBool( const Section, Ident : string; Value : Boolean)'); + RegisterMethod('Function ReadBinaryStream( const Section, Name : string; Value : TStream) : Integer'); + RegisterMethod('Function ReadDate( const Section, Name : string; Default : TDateTime) : TDateTime'); + RegisterMethod('Function ReadDateTime( const Section, Name : string; Default : TDateTime) : TDateTime'); + RegisterMethod('Function ReadFloat( const Section, Name : string; Default : Double) : Double'); + RegisterMethod('Function ReadTime( const Section, Name : string; Default : TDateTime) : TDateTime'); + RegisterMethod('Procedure WriteBinaryStream( const Section, Name : string; Value : TStream)'); + RegisterMethod('Procedure WriteDate( const Section, Name : string; Value : TDateTime)'); + RegisterMethod('Procedure WriteDateTime( const Section, Name : string; Value : TDateTime)'); + RegisterMethod('Procedure WriteFloat( const Section, Name : string; Value : Double)'); + RegisterMethod('Procedure WriteTime( const Section, Name : string; Value : TDateTime)'); + RegisterMethod('Procedure ReadSection( const Section : string; Strings : TStrings)'); + RegisterMethod('Procedure ReadSections( Strings : TStrings)'); + RegisterMethod('Procedure ReadSectionValues( const Section : string; Strings : TStrings)'); + RegisterMethod('Procedure EraseSection( const Section : string)'); + RegisterMethod('Procedure DeleteKey( const Section, Ident : String)'); + RegisterMethod('Procedure UpdateFile'); + RegisterMethod('Function ValueExists( const Section, Ident : string) : Boolean'); + RegisterProperty('FileName', 'string', iptr); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_IniFiles(CL: TPSPascalCompiler); +begin + CL.AddClassN(CL.FindClass('TOBJECT'),'EIniFileException'); + SIRegister_TCustomIniFile(CL); +// CL.AddTypeS('PPHashItem', '^PHashItem'); +// CL.AddTypeS('PHashItem', '^THashItem'); +// CL.AddTypeS('THashItem', 'record Next : PHashItem; Key : string; Value : Inte' +// +'ger; end'); + SIRegister_TStringHash(CL); + SIRegister_THashedStringList(CL); + SIRegister_TMemIniFile(CL); + SIRegister_TIniFile(CL); + SIRegister_TIniFile(CL); +end; + +(* === run-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure TMemIniFileCaseSensitive_W(Self: TMemIniFile; const T: Boolean); +begin Self.CaseSensitive := T; end; + +(*----------------------------------------------------------------------------*) +procedure TMemIniFileCaseSensitive_R(Self: TMemIniFile; var T: Boolean); +begin T := Self.CaseSensitive; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomIniFileFileName_R(Self: TCustomIniFile; var T: string); +begin T := Self.FileName; end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TIniFile(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TIniFile) do + begin + RegisterConstructor(@TIniFile.Create, 'Create'); + RegisterMethod(@TIniFile.ReadInteger, 'ReadInteger'); + RegisterMethod(@TIniFile.WriteInteger, 'WriteInteger'); + RegisterMethod(@TIniFile.ReadBool, 'ReadBool'); + RegisterMethod(@TIniFile.WriteBool, 'WriteBool'); + RegisterMethod(@TIniFile.ReadBinaryStream, 'ReadBinaryStream'); + RegisterMethod(@TIniFile.ReadDate, 'ReadDate'); + RegisterMethod(@TIniFile.ReadDateTime, 'ReadDateTime'); + RegisterMethod(@TIniFile.ReadFloat, 'ReadFloat'); + RegisterMethod(@TIniFile.ReadTime, 'ReadTime'); + RegisterMethod(@TIniFile.WriteBinaryStream, 'WriteBinaryStream'); + RegisterMethod(@TIniFile.WriteDate, 'WriteDate'); + RegisterMethod(@TIniFile.WriteDateTime, 'WriteDateTime'); + RegisterMethod(@TIniFile.WriteFloat, 'WriteFloat'); + RegisterMethod(@TIniFile.WriteTime, 'WriteTime'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TMemIniFile(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TMemIniFile) do + begin + RegisterConstructor(@TMemIniFile.Create, 'Create'); + RegisterMethod(@TMemIniFile.Clear, 'Clear'); + RegisterMethod(@TMemIniFile.GetStrings, 'GetStrings'); + RegisterMethod(@TMemIniFile.Rename, 'Rename'); + RegisterMethod(@TMemIniFile.SetStrings, 'SetStrings'); + RegisterPropertyHelper(@TMemIniFileCaseSensitive_R,@TMemIniFileCaseSensitive_W,'CaseSensitive'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_THashedStringList(CL: TPSRuntimeClassImporter); +begin + with CL.Add(THashedStringList) do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TStringHash(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TStringHash) do + begin + RegisterConstructor(@TStringHash.Create, 'Create'); + RegisterMethod(@TStringHash.Add, 'Add'); + RegisterMethod(@TStringHash.Clear, 'Clear'); + RegisterMethod(@TStringHash.Remove, 'Remove'); + RegisterMethod(@TStringHash.Modify, 'Modify'); + RegisterMethod(@TStringHash.ValueOf, 'ValueOf'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TCustomIniFile(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TCustomIniFile) do + begin + RegisterConstructor(@TCustomIniFile.Create, 'Create'); + RegisterMethod(@TCustomIniFile.SectionExists, 'SectionExists'); +// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.ReadString, 'ReadString'); +// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.WriteString, 'WriteString'); + RegisterVirtualMethod(@TCustomIniFile.ReadInteger, 'ReadInteger'); + RegisterVirtualMethod(@TCustomIniFile.WriteInteger, 'WriteInteger'); + RegisterVirtualMethod(@TCustomIniFile.ReadBool, 'ReadBool'); + RegisterVirtualMethod(@TCustomIniFile.WriteBool, 'WriteBool'); + RegisterVirtualMethod(@TCustomIniFile.ReadBinaryStream, 'ReadBinaryStream'); + RegisterVirtualMethod(@TCustomIniFile.ReadDate, 'ReadDate'); + RegisterVirtualMethod(@TCustomIniFile.ReadDateTime, 'ReadDateTime'); + RegisterVirtualMethod(@TCustomIniFile.ReadFloat, 'ReadFloat'); + RegisterVirtualMethod(@TCustomIniFile.ReadTime, 'ReadTime'); + RegisterVirtualMethod(@TCustomIniFile.WriteBinaryStream, 'WriteBinaryStream'); + RegisterVirtualMethod(@TCustomIniFile.WriteDate, 'WriteDate'); + RegisterVirtualMethod(@TCustomIniFile.WriteDateTime, 'WriteDateTime'); + RegisterVirtualMethod(@TCustomIniFile.WriteFloat, 'WriteFloat'); + RegisterVirtualMethod(@TCustomIniFile.WriteTime, 'WriteTime'); +// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.ReadSection, 'ReadSection'); +// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.ReadSections, 'ReadSections'); +// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.ReadSectionValues, 'ReadSectionValues'); +// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.EraseSection, 'EraseSection'); +// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.DeleteKey, 'DeleteKey'); +// RegisterVirtualAbstractMethod(@TCustomIniFile, @!.UpdateFile, 'UpdateFile'); + RegisterMethod(@TCustomIniFile.ValueExists, 'ValueExists'); + RegisterPropertyHelper(@TCustomIniFileFileName_R,nil,'FileName'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_IniFiles(CL: TPSRuntimeClassImporter); +begin + with CL.Add(EIniFileException) do + RIRegister_TCustomIniFile(CL); + RIRegister_TStringHash(CL); + RIRegister_THashedStringList(CL); + RIRegister_TMemIniFile(CL); + RIRegister_TIniFile(CL); + RIRegister_TIniFile(CL); +end; + + + +{ TPSImport_IniFiles } +(*----------------------------------------------------------------------------*) +procedure TPSImport_IniFiles.CompileImport1(CompExec: TPSScript); +begin + SIRegister_IniFiles(CompExec.Comp); +end; +(*----------------------------------------------------------------------------*) +procedure TPSImport_IniFiles.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); +begin + RIRegister_IniFiles(ri); +end; +(*----------------------------------------------------------------------------*) + + +end. diff --git a/Source/uPSI_Registry.pas b/Source/uPSI_Registry.pas new file mode 100644 index 00000000..ce2723ce --- /dev/null +++ b/Source/uPSI_Registry.pas @@ -0,0 +1,359 @@ +unit uPSI_Registry; +{ +This file has been generated by UnitParser v0.7, written by M. Knight +and updated by NP. v/d Spek and George Birbilis. +Source Code from Carlo Kok has been used to implement various sections of +UnitParser. Components of ROPS are used in the construction of UnitParser, +code implementing the class wrapper is taken from Carlo Kok's conv utility + +} +interface + +{$WARN UNSAFE_CODE OFF} + +uses + SysUtils + ,Classes + ,uPSComponent + ,uPSRuntime + ,uPSCompiler + ; + +type +(*----------------------------------------------------------------------------*) + TPSImport_Registry = class(TPSPlugin) + public + procedure CompileImport1(CompExec: TPSScript); override; + procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override; + end; + + +{ compile-time registration functions } +procedure SIRegister_TRegistryIniFile(CL: TPSPascalCompiler); +procedure SIRegister_TRegIniFile(CL: TPSPascalCompiler); +procedure SIRegister_TRegistry(CL: TPSPascalCompiler); +procedure SIRegister_Registry(CL: TPSPascalCompiler); + +{ run-time registration functions } +procedure RIRegister_TRegistryIniFile(CL: TPSRuntimeClassImporter); +procedure RIRegister_TRegIniFile(CL: TPSRuntimeClassImporter); +procedure RIRegister_TRegistry(CL: TPSRuntimeClassImporter); +procedure RIRegister_Registry(CL: TPSRuntimeClassImporter); + +procedure Register; + +implementation + + +uses + Windows + ,Registry + ; + + +procedure Register; +begin + RegisterComponents('Pascal Script', [TPSImport_Registry]); +end; + +(* === compile-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure SIRegister_TRegistryIniFile(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomIniFile', 'TRegistryIniFile') do + with CL.AddClassN(CL.FindClass('TCustomIniFile'),'TRegistryIniFile') do + begin + RegisterMethod('Constructor Create( const FileName : string);'); + RegisterMethod('Constructor Create1( const FileName : string; AAccess : LongWord);'); + RegisterProperty('RegIniFile', 'TRegIniFile', iptr); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TRegIniFile(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TRegistry', 'TRegIniFile') do + with CL.AddClassN(CL.FindClass('TRegistry'),'TRegIniFile') do + begin + RegisterMethod('Constructor Create( const FileName : string);'); + RegisterMethod('Constructor Create1( const FileName : string; AAccess : LongWord);'); + RegisterMethod('Function ReadString( const Section, Ident, Default : string) : string'); + RegisterMethod('Function ReadInteger( const Section, Ident : string; Default : Longint) : Longint'); + RegisterMethod('Procedure WriteInteger( const Section, Ident : string; Value : Longint)'); + RegisterMethod('Procedure WriteString( const Section, Ident, Value : String)'); + RegisterMethod('Function ReadBool( const Section, Ident : string; Default : Boolean) : Boolean'); + RegisterMethod('Procedure WriteBool( const Section, Ident : string; Value : Boolean)'); + RegisterMethod('Procedure ReadSection( const Section : string; Strings : TStrings)'); + RegisterMethod('Procedure ReadSections( Strings : TStrings)'); + RegisterMethod('Procedure ReadSectionValues( const Section : string; Strings : TStrings)'); + RegisterMethod('Procedure EraseSection( const Section : string)'); + RegisterMethod('Procedure DeleteKey( const Section, Ident : String)'); + RegisterProperty('FileName', 'string', iptr); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TRegistry(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TObject', 'TRegistry') do + with CL.AddClassN(CL.FindClass('TObject'),'TRegistry') do + begin + RegisterMethod('Constructor Create;'); + RegisterMethod('Constructor Create1( AAccess : LongWord);'); + RegisterMethod('Procedure CloseKey'); + RegisterMethod('Function CreateKey( const Key : string) : Boolean'); + RegisterMethod('Function DeleteKey( const Key : string) : Boolean'); + RegisterMethod('Function DeleteValue( const Name : string) : Boolean'); + RegisterMethod('Function GetDataInfo( const ValueName : string; var Value : TRegDataInfo) : Boolean'); + RegisterMethod('Function GetDataSize( const ValueName : string) : Integer'); + RegisterMethod('Function GetDataType( const ValueName : string) : TRegDataType'); + RegisterMethod('Function GetKeyInfo( var Value : TRegKeyInfo) : Boolean'); + RegisterMethod('Procedure GetKeyNames( Strings : TStrings)'); + RegisterMethod('Procedure GetValueNames( Strings : TStrings)'); + RegisterMethod('Function HasSubKeys : Boolean'); + RegisterMethod('Function KeyExists( const Key : string) : Boolean'); + RegisterMethod('Function LoadKey( const Key, FileName : string) : Boolean'); + RegisterMethod('Procedure MoveKey( const OldName, NewName : string; Delete : Boolean)'); + RegisterMethod('Function OpenKey( const Key : string; CanCreate : Boolean) : Boolean'); + RegisterMethod('Function OpenKeyReadOnly( const Key : String) : Boolean'); + RegisterMethod('Function ReadCurrency( const Name : string) : Currency'); + RegisterMethod('Function ReadBinaryData( const Name : string; var Buffer, BufSize : Integer) : Integer'); + RegisterMethod('Function ReadBool( const Name : string) : Boolean'); + RegisterMethod('Function ReadDate( const Name : string) : TDateTime'); + RegisterMethod('Function ReadDateTime( const Name : string) : TDateTime'); + RegisterMethod('Function ReadFloat( const Name : string) : Double'); + RegisterMethod('Function ReadInteger( const Name : string) : Integer'); + RegisterMethod('Function ReadString( const Name : string) : string'); + RegisterMethod('Function ReadTime( const Name : string) : TDateTime'); + RegisterMethod('Function RegistryConnect( const UNCName : string) : Boolean'); + RegisterMethod('Procedure RenameValue( const OldName, NewName : string)'); + RegisterMethod('Function ReplaceKey( const Key, FileName, BackUpFileName : string) : Boolean'); + RegisterMethod('Function RestoreKey( const Key, FileName : string) : Boolean'); + RegisterMethod('Function SaveKey( const Key, FileName : string) : Boolean'); + RegisterMethod('Function UnLoadKey( const Key : string) : Boolean'); + RegisterMethod('Function ValueExists( const Name : string) : Boolean'); + RegisterMethod('Procedure WriteCurrency( const Name : string; Value : Currency)'); + RegisterMethod('Procedure WriteBinaryData( const Name : string; var Buffer, BufSize : Integer)'); + RegisterMethod('Procedure WriteBool( const Name : string; Value : Boolean)'); + RegisterMethod('Procedure WriteDate( const Name : string; Value : TDateTime)'); + RegisterMethod('Procedure WriteDateTime( const Name : string; Value : TDateTime)'); + RegisterMethod('Procedure WriteFloat( const Name : string; Value : Double)'); + RegisterMethod('Procedure WriteInteger( const Name : string; Value : Integer)'); + RegisterMethod('Procedure WriteString( const Name, Value : string)'); + RegisterMethod('Procedure WriteExpandString( const Name, Value : string)'); + RegisterMethod('Procedure WriteTime( const Name : string; Value : TDateTime)'); + RegisterProperty('CurrentKey', 'HKEY', iptr); + RegisterProperty('CurrentPath', 'string', iptr); + RegisterProperty('LazyWrite', 'Boolean', iptrw); + RegisterProperty('RootKey', 'HKEY', iptrw); + RegisterProperty('Access', 'LongWord', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_Registry(CL: TPSPascalCompiler); +begin + CL.AddConstant( 'HKEY_CLASSES_ROOT', HKEY_CLASSES_ROOT ); + CL.AddConstant( 'HKEY_CURRENT_USER', HKEY_CURRENT_USER ); + CL.AddConstant( 'HKEY_LOCAL_MACHINE', HKEY_LOCAL_MACHINE ); + CL.AddConstant( 'HKEY_USERS', HKEY_USERS ); + CL.AddConstant( 'HKEY_PERFORMANCE_DATA', HKEY_PERFORMANCE_DATA ); + CL.AddConstant( 'HKEY_CURRENT_CONFIG', HKEY_CURRENT_CONFIG ); + CL.AddConstant( 'HKEY_DYN_DATA', HKEY_DYN_DATA ); + CL.AddTypeS( 'HKEY', 'longword' ); + + CL.AddClassN(CL.FindClass('TOBJECT'),'ERegistryException'); + CL.AddTypeS('TFileTime', 'record dwLowDateTime: LongWord; dwHighDateTime: LongWord; end;' ); + CL.AddTypeS('TRegKeyInfo', 'record NumSubKeys : Integer; MaxSubKeyLen : Integ' + +'er; NumValues : Integer; MaxValueLen : Integer; MaxDataLen : Integer; File' + +'Time : TFileTime; end'); + CL.AddTypeS('TRegDataType', '( rdUnknown, rdString, rdExpandString, rdInteger' + +', rdBinary )'); + CL.AddTypeS('TRegDataInfo', 'record RegData : TRegDataType; DataSize : Intege' + +'r; end'); + SIRegister_TRegistry(CL); + SIRegister_TRegIniFile(CL); + SIRegister_TRegistryIniFile(CL); +end; + +(* === run-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure TRegistryIniFileRegIniFile_R(Self: TRegistryIniFile; var T: TRegIniFile); +begin T := Self.RegIniFile; end; + +(*----------------------------------------------------------------------------*) +Function TRegistryIniFileCreate5_P(Self: TClass; CreateNewInstance: Boolean; const FileName : string; AAccess : LongWord):TObject; +Begin Result := TRegistryIniFile.Create(FileName, AAccess); END; + +(*----------------------------------------------------------------------------*) +Function TRegistryIniFileCreate4_P(Self: TClass; CreateNewInstance: Boolean; const FileName : string):TObject; +Begin Result := TRegistryIniFile.Create(FileName); END; + +(*----------------------------------------------------------------------------*) +procedure TRegIniFileFileName_R(Self: TRegIniFile; var T: string); +begin T := Self.FileName; end; + +(*----------------------------------------------------------------------------*) +Function TRegIniFileCreate3_P(Self: TClass; CreateNewInstance: Boolean; const FileName : string; AAccess : LongWord):TObject; +Begin Result := TRegIniFile.Create(FileName, AAccess); END; + +(*----------------------------------------------------------------------------*) +Function TRegIniFileCreate2_P(Self: TClass; CreateNewInstance: Boolean; const FileName : string):TObject; +Begin Result := TRegIniFile.Create(FileName); END; + +(*----------------------------------------------------------------------------*) +procedure TRegistryAccess_W(Self: TRegistry; const T: LongWord); +begin Self.Access := T; end; + +(*----------------------------------------------------------------------------*) +procedure TRegistryAccess_R(Self: TRegistry; var T: LongWord); +begin T := Self.Access; end; + +(*----------------------------------------------------------------------------*) +procedure TRegistryRootKey_W(Self: TRegistry; const T: HKEY); +begin Self.RootKey := T; end; + +(*----------------------------------------------------------------------------*) +procedure TRegistryRootKey_R(Self: TRegistry; var T: HKEY); +begin T := Self.RootKey; end; + +(*----------------------------------------------------------------------------*) +procedure TRegistryLazyWrite_W(Self: TRegistry; const T: Boolean); +begin Self.LazyWrite := T; end; + +(*----------------------------------------------------------------------------*) +procedure TRegistryLazyWrite_R(Self: TRegistry; var T: Boolean); +begin T := Self.LazyWrite; end; + +(*----------------------------------------------------------------------------*) +procedure TRegistryCurrentPath_R(Self: TRegistry; var T: string); +begin T := Self.CurrentPath; end; + +(*----------------------------------------------------------------------------*) +procedure TRegistryCurrentKey_R(Self: TRegistry; var T: HKEY); +begin T := Self.CurrentKey; end; + +(*----------------------------------------------------------------------------*) +Function TRegistryCreate1_P(Self: TClass; CreateNewInstance: Boolean; AAccess : LongWord):TObject; +Begin Result := TRegistry.Create(AAccess); END; + +(*----------------------------------------------------------------------------*) +Function TRegistryCreate0_P(Self: TClass; CreateNewInstance: Boolean):TObject; +Begin Result := TRegistry.Create; END; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TRegistryIniFile(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TRegistryIniFile) do + begin + RegisterConstructor(@TRegistryIniFileCreate4_P, 'Create'); + RegisterConstructor(@TRegistryIniFileCreate5_P, 'Create1'); + RegisterPropertyHelper(@TRegistryIniFileRegIniFile_R,nil,'RegIniFile'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TRegIniFile(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TRegIniFile) do + begin + RegisterConstructor(@TRegIniFileCreate2_P, 'Create'); + RegisterConstructor(@TRegIniFileCreate3_P, 'Create1'); + RegisterMethod(@TRegIniFile.ReadString, 'ReadString'); + RegisterMethod(@TRegIniFile.ReadInteger, 'ReadInteger'); + RegisterMethod(@TRegIniFile.WriteInteger, 'WriteInteger'); + RegisterMethod(@TRegIniFile.WriteString, 'WriteString'); + RegisterMethod(@TRegIniFile.ReadBool, 'ReadBool'); + RegisterMethod(@TRegIniFile.WriteBool, 'WriteBool'); + RegisterMethod(@TRegIniFile.ReadSection, 'ReadSection'); + RegisterMethod(@TRegIniFile.ReadSections, 'ReadSections'); + RegisterMethod(@TRegIniFile.ReadSectionValues, 'ReadSectionValues'); + RegisterMethod(@TRegIniFile.EraseSection, 'EraseSection'); + RegisterMethod(@TRegIniFile.DeleteKey, 'DeleteKey'); + RegisterPropertyHelper(@TRegIniFileFileName_R,nil,'FileName'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TRegistry(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TRegistry) do + begin + RegisterConstructor(@TRegistryCreate0_P, 'Create'); + RegisterConstructor(@TRegistryCreate1_P, 'Create1'); + RegisterMethod(@TRegistry.CloseKey, 'CloseKey'); + RegisterMethod(@TRegistry.CreateKey, 'CreateKey'); + RegisterMethod(@TRegistry.DeleteKey, 'DeleteKey'); + RegisterMethod(@TRegistry.DeleteValue, 'DeleteValue'); + RegisterMethod(@TRegistry.GetDataInfo, 'GetDataInfo'); + RegisterMethod(@TRegistry.GetDataSize, 'GetDataSize'); + RegisterMethod(@TRegistry.GetDataType, 'GetDataType'); + RegisterMethod(@TRegistry.GetKeyInfo, 'GetKeyInfo'); + RegisterMethod(@TRegistry.GetKeyNames, 'GetKeyNames'); + RegisterMethod(@TRegistry.GetValueNames, 'GetValueNames'); + RegisterMethod(@TRegistry.HasSubKeys, 'HasSubKeys'); + RegisterMethod(@TRegistry.KeyExists, 'KeyExists'); + RegisterMethod(@TRegistry.LoadKey, 'LoadKey'); + RegisterMethod(@TRegistry.MoveKey, 'MoveKey'); + RegisterMethod(@TRegistry.OpenKey, 'OpenKey'); + RegisterMethod(@TRegistry.OpenKeyReadOnly, 'OpenKeyReadOnly'); + RegisterMethod(@TRegistry.ReadCurrency, 'ReadCurrency'); + RegisterMethod(@TRegistry.ReadBinaryData, 'ReadBinaryData'); + RegisterMethod(@TRegistry.ReadBool, 'ReadBool'); + RegisterMethod(@TRegistry.ReadDate, 'ReadDate'); + RegisterMethod(@TRegistry.ReadDateTime, 'ReadDateTime'); + RegisterMethod(@TRegistry.ReadFloat, 'ReadFloat'); + RegisterMethod(@TRegistry.ReadInteger, 'ReadInteger'); + RegisterMethod(@TRegistry.ReadString, 'ReadString'); + RegisterMethod(@TRegistry.ReadTime, 'ReadTime'); + RegisterMethod(@TRegistry.RegistryConnect, 'RegistryConnect'); + RegisterMethod(@TRegistry.RenameValue, 'RenameValue'); + RegisterMethod(@TRegistry.ReplaceKey, 'ReplaceKey'); + RegisterMethod(@TRegistry.RestoreKey, 'RestoreKey'); + RegisterMethod(@TRegistry.SaveKey, 'SaveKey'); + RegisterMethod(@TRegistry.UnLoadKey, 'UnLoadKey'); + RegisterMethod(@TRegistry.ValueExists, 'ValueExists'); + RegisterMethod(@TRegistry.WriteCurrency, 'WriteCurrency'); + RegisterMethod(@TRegistry.WriteBinaryData, 'WriteBinaryData'); + RegisterMethod(@TRegistry.WriteBool, 'WriteBool'); + RegisterMethod(@TRegistry.WriteDate, 'WriteDate'); + RegisterMethod(@TRegistry.WriteDateTime, 'WriteDateTime'); + RegisterMethod(@TRegistry.WriteFloat, 'WriteFloat'); + RegisterMethod(@TRegistry.WriteInteger, 'WriteInteger'); + RegisterMethod(@TRegistry.WriteString, 'WriteString'); + RegisterMethod(@TRegistry.WriteExpandString, 'WriteExpandString'); + RegisterMethod(@TRegistry.WriteTime, 'WriteTime'); + RegisterPropertyHelper(@TRegistryCurrentKey_R,nil,'CurrentKey'); + RegisterPropertyHelper(@TRegistryCurrentPath_R,nil,'CurrentPath'); + RegisterPropertyHelper(@TRegistryLazyWrite_R,@TRegistryLazyWrite_W,'LazyWrite'); + RegisterPropertyHelper(@TRegistryRootKey_R,@TRegistryRootKey_W,'RootKey'); + RegisterPropertyHelper(@TRegistryAccess_R,@TRegistryAccess_W,'Access'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_Registry(CL: TPSRuntimeClassImporter); +begin + with CL.Add(ERegistryException) do + RIRegister_TRegistry(CL); + RIRegister_TRegIniFile(CL); + RIRegister_TRegistryIniFile(CL); +end; + + + +{ TPSImport_Registry } +(*----------------------------------------------------------------------------*) +procedure TPSImport_Registry.CompileImport1(CompExec: TPSScript); +begin + SIRegister_Registry(CompExec.Comp); +end; +(*----------------------------------------------------------------------------*) +procedure TPSImport_Registry.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); +begin + RIRegister_Registry(ri); +end; +(*----------------------------------------------------------------------------*) + + +end. diff --git a/Source/uPSI_SynEdit.pas b/Source/uPSI_SynEdit.pas new file mode 100644 index 00000000..6b512ea9 --- /dev/null +++ b/Source/uPSI_SynEdit.pas @@ -0,0 +1,1666 @@ +unit uPSI_SynEdit; +{ +This file has been generated by UnitParser v0.7, written by M. Knight +and updated by NP. v/d Spek and George Birbilis. +Source Code from Carlo Kok has been used to implement various sections of +UnitParser. Components of ROPS are used in the construction of UnitParser, +code implementing the class wrapper is taken from Carlo Kok's conv utility + +} +interface + +{$WARN UNSAFE_CODE OFF} + +uses + SysUtils + ,Classes + ,uPSComponent + ,uPSRuntime + ,uPSCompiler + ; + +type +(*----------------------------------------------------------------------------*) + TPSImport_SynEdit = class(TPSPlugin) + public + procedure CompileImport1(CompExec: TPSScript); override; + procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override; + end; + +{ compile-time registration functions } +procedure SIRegister_TSynEdit(CL: TPSPascalCompiler); +procedure SIRegister_TCustomSynEdit(CL: TPSPascalCompiler); +procedure SIRegister_TSynEditPlugin(CL: TPSPascalCompiler); +procedure SIRegister_TSynEditMarkList(CL: TPSPascalCompiler); +procedure SIRegister_TSynEditMark(CL: TPSPascalCompiler); +procedure SIRegister_SynEdit(CL: TPSPascalCompiler); // MS + +{ run-time registration functions } +procedure RIRegister_TSynEdit(CL: TPSRuntimeClassImporter); +procedure RIRegister_TCustomSynEdit(CL: TPSRuntimeClassImporter); +procedure RIRegister_TSynEditPlugin(CL: TPSRuntimeClassImporter); +procedure RIRegister_TSynEditMarkList(CL: TPSRuntimeClassImporter); +procedure RIRegister_TSynEditMark(CL: TPSRuntimeClassImporter); +procedure RIRegister_SynEdit(CL: TPSRuntimeClassImporter); + +procedure Register; + +implementation + + +uses + Controls + ,Contnrs + ,Graphics + ,Forms + ,StdCtrls + ,ExtCtrls + ,Windows + ,Messages + ,StdActns + ,Dialogs + ,Themes + ,Types + {$IF CompilerVersion >= 23} + ,UITypes + {$IFEND} + ,Imm + ,SynUnicode + ,SynTextDrawer + ,SynEditTypes + ,SynEditKeyConst + ,SynEditMiscProcs + ,SynEditMiscClasses + ,SynEditTextBuffer + ,SynEditKeyCmds + ,SynEditHighlighter + ,SynEditKbdHandler + {$IF CompilerVersion >= 23} + ,SynEditCodeFolding + {$IFEND} + ,WideStrUtils + ,Math + ,SynEdit + ; + + +procedure Register; +begin + RegisterComponents('Pascal Script', [TPSImport_SynEdit]); +end; + +procedure SIRegister_TUnicodeStrings(Cl: TPSPascalCompiler; Streams: Boolean); +begin + with Cl.AddClassN(cl.FindClass('TPersistent'), 'TUnicodeStrings') do + begin + IsAbstract := True; +{$IFDEF DELPHI2005UP} + RegisterMethod('constructor Create;'); +{$ENDIF} + RegisterMethod('function Add(S: string): Integer;'); + RegisterMethod('procedure Append(S: string);'); + RegisterMethod('procedure AddStrings(Strings: TStrings);'); + RegisterMethod('procedure Clear;'); + RegisterMethod('procedure Delete(Index: Integer);'); + RegisterMethod('function IndexOf(const S: string): Integer; '); + RegisterMethod('procedure Insert(Index: Integer; S: string); '); + RegisterProperty('Capacity', 'Integer', iptRW); + RegisterProperty('Delimiter', 'Char', iptRW); +{$IFDEF DELPHI2006UP} + RegisterProperty('StrictDelimiter', 'Boolean', iptRW); +{$ENDIF} + RegisterProperty('DelimitedText', 'string', iptrw); + RegisterProperty('NameValueSeparator', 'Char', iptRW); + RegisterProperty('QuoteChar', 'Char', iptRW); + RegisterProperty('Count', 'Integer', iptR); + RegisterProperty('Text', 'string', iptrw); + RegisterProperty('CommaText', 'string', iptrw); + if Streams then + begin + RegisterMethod('procedure LoadFromFile(FileName: string); '); + RegisterMethod('procedure SaveToFile(FileName: string); '); + end; + RegisterProperty('Strings', 'string Integer', iptRW); + SetDefaultPropery('Strings'); + RegisterProperty('Objects', 'TObject Integer', iptRW); + + {$IFNDEF PS_MINIVCL} + RegisterMethod('procedure BeginUpdate;'); + RegisterMethod('procedure EndUpdate;'); + RegisterMethod('function Equals(Strings: TStrings): Boolean;'); + RegisterMethod('procedure Exchange(Index1, Index2: Integer);'); + RegisterMethod('function IndexOfName(Name: string): Integer;'); + if Streams then + RegisterMethod('procedure LoadFromStream(Stream: TStream); '); + RegisterMethod('procedure Move(CurIndex, NewIndex: Integer); '); + if Streams then + RegisterMethod('procedure SaveToStream(Stream: TStream); '); + RegisterMethod('procedure SetText(Text: PChar); '); + RegisterProperty('Names', 'string Integer', iptr); + RegisterProperty('Values', 'string string', iptRW); + RegisterProperty('ValueFromIndex', 'string Integer', iptRW); + RegisterMethod('function AddObject(S: string; AObject: TObject): Integer'); + RegisterMethod('function GetText: PChar'); + RegisterMethod('function IndexOfObject(AObject: TObject): Integer'); + RegisterMethod('procedure InsertObject(Index: Integer; S: string; AObject: TObject)'); + {$ENDIF} + end; + + + + + + + + + + + + + +(* + with Cl.AddClassN(cl.FindClass('TPersistent'), 'TUnicodeStrings') do + begin + IsAbstract := True; +{$IFDEF DELPHI2005UP} + RegisterMethod('constructor Create;'); +{$ENDIF} + RegisterMethod('function Add(S: WideString): Integer;'); + RegisterMethod('procedure Append(S: WideString);'); + RegisterMethod('procedure AddStrings(Strings: TUnicodeStrings);'); + RegisterMethod('procedure Clear;'); + RegisterMethod('procedure Delete(Index: Integer);'); + RegisterMethod('function IndexOf(const S: WideString): Integer; '); + RegisterMethod('procedure Insert(Index: Integer; S: string); '); + RegisterProperty('Capacity', 'Integer', iptRW); + RegisterProperty('Delimiter', 'Char', iptRW); +{$IFDEF DELPHI2006UP} + RegisterProperty('StrictDelimiter', 'Boolean', iptRW); +{$ENDIF} + RegisterProperty('DelimitedText', 'WideString', iptrw); + RegisterProperty('NameValueSeparator', 'WideChar', iptRW); + RegisterProperty('QuoteChar', 'WideChar', iptRW); + RegisterProperty('Count', 'Integer', iptR); + RegisterProperty('Text', 'WideString', iptrw); + RegisterProperty('CommaText', 'WideString', iptrw); + if Streams then + begin + RegisterMethod('procedure LoadFromFile(FileName: string); '); + RegisterMethod('procedure SaveToFile(FileName: string); '); + end; + RegisterProperty('Strings', 'WideString Integer', iptRW); + SetDefaultPropery('Strings'); + RegisterProperty('Objects', 'TObject Integer', iptRW); + + {$IFNDEF PS_MINIVCL} + RegisterMethod('procedure BeginUpdate;'); + RegisterMethod('procedure EndUpdate;'); + RegisterMethod('function Equals(Strings: TUnicodeStrings): Boolean;'); + RegisterMethod('procedure Exchange(Index1, Index2: Integer);'); + RegisterMethod('function IndexOfName(Name: WideString): Integer;'); + if Streams then + RegisterMethod('procedure LoadFromStream(Stream: TStream); '); + RegisterMethod('procedure Move(CurIndex, NewIndex: Integer); '); + if Streams then + RegisterMethod('procedure SaveToStream(Stream: TStream); '); + RegisterMethod('procedure SetText(Text: PWideChar); '); + RegisterProperty('Names', 'WideString Integer', iptr); + RegisterProperty('Values', 'WideString string', iptRW); + RegisterProperty('ValueFromIndex', 'WideString Integer', iptRW); + RegisterMethod('function AddObject(S: WideString; AObject: TObject): Integer'); + RegisterMethod('function GetText: PWideChar'); + RegisterMethod('function IndexOfObject(AObject: TObject): Integer'); + RegisterMethod('procedure InsertObject(Index: Integer; S: WideString; AObject: TObject)'); + {$ENDIF} + end; +*) +end; + +procedure SIRegister_TUnicodeStringList(Cl: TPSPascalCompiler); +begin + with Cl.AddClassN(cl.FindClass('TStrings'), 'TUnicodeStringList') do + begin +{$IFDEF DELPHI2005UP} + RegisterMethod('constructor Create;'); +{$ENDIF} + RegisterMethod('function Find(S: WideString; var Index: Integer): Boolean'); + RegisterMethod('procedure Sort'); + RegisterProperty('CaseSensitive', 'Boolean', iptrw); + RegisterProperty('Duplicates', 'TDuplicates', iptrw); + RegisterProperty('Sorted', 'Boolean', iptrw); + RegisterProperty('OnChange', 'TNotifyEvent', iptrw); + RegisterProperty('OnChanging', 'TNotifyEvent', iptrw); + end; +end; + +(* === compile-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure SIRegister_TSynEdit(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TCustomSynEdit', 'TSynEdit') do + with CL.AddClassN(CL.FindClass('TCustomSynEdit'),'TSynEdit') do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TCustomSynEdit(CL: TPSPascalCompiler); +begin + CL.AddTypeS('TBufferCoord', 'record Char: Integer; Line: Integer; end;'); + + //with RegClassS(CL,'TCustomControl', 'TCustomSynEdit') do + with CL.AddClassN(CL.FindClass('TCustomControl'),'TCustomSynEdit') do + begin + RegisterProperty('SelStart', 'Integer', iptrw); + RegisterProperty('SelEnd', 'Integer', iptrw); + RegisterProperty('AlwaysShowCaret', 'Boolean', iptrw); + RegisterMethod('Procedure UpdateCaret'); + RegisterMethod('Procedure AddKey( Command : TSynEditorCommand; Key1 : Word; SS1 : TShiftState; Key2 : Word; SS2 : TShiftState)'); + RegisterMethod('Procedure AddKey( Command : TSynEditorCommand; Key1 : Word; SS1 : TShiftState; Key2 : Word; SS2 : TShiftState)'); + RegisterMethod('Procedure BeginUndoBlock'); + RegisterMethod('Procedure BeginUpdate'); + RegisterMethod('Function CaretInView : Boolean'); + RegisterMethod('Function CharIndexToRowCol( Index : Integer) : TBufferCoord'); + RegisterMethod('Procedure Clear'); + RegisterMethod('Procedure ClearAll'); + RegisterMethod('Procedure ClearBookMark( BookMark : Integer)'); + RegisterMethod('Procedure ClearSelection'); + RegisterMethod('Procedure CommandProcessor( Command : TSynEditorCommand; AChar : WideChar; Data : Pointer)'); + RegisterMethod('Procedure ClearUndo'); + RegisterMethod('Procedure CopyToClipboard'); + RegisterMethod('Procedure CutToClipboard'); + RegisterMethod('Procedure DoCopyToClipboard( const SText : UnicodeString)'); + RegisterMethod('Procedure EndUndoBlock'); + RegisterMethod('Procedure EndUpdate'); + RegisterMethod('Procedure EnsureCursorPosVisible'); + RegisterMethod('Procedure EnsureCursorPosVisibleEx( ForceToMiddle : Boolean; EvenIfVisible : Boolean)'); + RegisterMethod('Procedure FindMatchingBracket'); + RegisterMethod('Function GetMatchingBracket : TBufferCoord'); + RegisterMethod('Function GetMatchingBracketEx( const APoint : TBufferCoord) : TBufferCoord'); + RegisterMethod('Procedure ExecuteCommand( Command : TSynEditorCommand; AChar : WideChar; Data : Pointer)'); + RegisterMethod('Function ExpandAtWideGlyphs( const S : UnicodeString) : UnicodeString'); + RegisterMethod('Function GetBookMark( BookMark : Integer; var X, Y : Integer) : Boolean'); + RegisterMethod('Function GetHighlighterAttriAtRowCol( const XY : TBufferCoord; var Token : UnicodeString; var Attri : TSynHighlighterAttributes) : Boolean'); + RegisterMethod('Function GetHighlighterAttriAtRowColEx( const XY : TBufferCoord; var Token : UnicodeString; var TokenType, Start : Integer; var Attri : TSynHighlighterAttributes) : Boolean'); + RegisterMethod('Function GetPositionOfMouse( out aPos : TBufferCoord) : Boolean'); + RegisterMethod('Function GetWordAtRowCol( XY : TBufferCoord) : UnicodeString'); + RegisterMethod('Procedure GotoBookMark( BookMark : Integer)'); + RegisterMethod('Procedure GotoLineAndCenter( ALine : Integer)'); + RegisterMethod('Function IsIdentChar( AChar : WideChar) : Boolean'); + RegisterMethod('Function IsWhiteChar( AChar : WideChar) : Boolean'); + RegisterMethod('Function IsWordBreakChar( AChar : WideChar) : Boolean'); + RegisterMethod('Procedure InsertBlock( const BB, BE : TBufferCoord; ChangeStr : PWideChar; AddToUndoList : Boolean)'); + RegisterMethod('Procedure InsertLine( const BB, BE : TBufferCoord; ChangeStr : PWideChar; AddToUndoList : Boolean)'); + RegisterMethod('Function UnifiedSelection : TBufferBlock'); + RegisterMethod('Procedure DoBlockIndent'); + RegisterMethod('Procedure DoBlockUnindent'); + RegisterMethod('Procedure InvalidateGutter'); + RegisterMethod('Procedure InvalidateGutterLine( aLine : Integer)'); + RegisterMethod('Procedure InvalidateGutterLines( FirstLine, LastLine : Integer)'); + RegisterMethod('Procedure InvalidateLine( Line : Integer)'); + RegisterMethod('Procedure InvalidateLines( FirstLine, LastLine : Integer)'); + RegisterMethod('Procedure InvalidateSelection'); + RegisterMethod('Procedure MarkModifiedLinesAsSaved'); + RegisterMethod('Procedure ResetModificationIndicator'); + RegisterMethod('Function IsBookmark( BookMark : Integer) : Boolean'); + RegisterMethod('Function IsPointInSelection( const Value : TBufferCoord) : Boolean'); + RegisterMethod('Procedure LockUndo'); + RegisterMethod('Function BufferToDisplayPos( const p : TBufferCoord) : TDisplayCoord'); + RegisterMethod('Function DisplayToBufferPos( const p : TDisplayCoord) : TBufferCoord'); + RegisterMethod('Function LineToRow( aLine : Integer) : Integer'); + RegisterMethod('Function RowToLine( aRow : Integer) : Integer'); + RegisterMethod('Procedure PasteFromClipboard'); + RegisterMethod('Function NextWordPos : TBufferCoord'); + RegisterMethod('Function NextWordPosEx( const XY : TBufferCoord) : TBufferCoord'); + RegisterMethod('Function WordStart : TBufferCoord'); + RegisterMethod('Function WordStartEx( const XY : TBufferCoord) : TBufferCoord'); + RegisterMethod('Function WordEnd : TBufferCoord'); + RegisterMethod('Function WordEndEx( const XY : TBufferCoord) : TBufferCoord'); + RegisterMethod('Function PrevWordPos : TBufferCoord'); + RegisterMethod('Function PrevWordPosEx( const XY : TBufferCoord) : TBufferCoord'); + RegisterMethod('Function PixelsToRowColumn( aX, aY : Integer) : TDisplayCoord'); + RegisterMethod('Function PixelsToNearestRowColumn( aX, aY : Integer) : TDisplayCoord'); + RegisterMethod('Procedure Redo'); + RegisterMethod('Procedure RegisterCommandHandler( const AHandlerProc : THookedCommandEvent; AHandlerData : Pointer)'); + RegisterMethod('Function RowColumnToPixels( const RowCol : TDisplayCoord) : TPoint'); + RegisterMethod('Function RowColToCharIndex( RowCol : TBufferCoord) : Integer'); + RegisterMethod('Function SearchReplace( const ASearch, AReplace : UnicodeString; AOptions : TSynSearchOptions) : Integer'); + RegisterMethod('Procedure SelectAll'); + RegisterMethod('Procedure SetBookMark( BookMark : Integer; X : Integer; Y : Integer)'); + RegisterMethod('Procedure SetCaretAndSelection( const ptCaret, ptBefore, ptAfter : TBufferCoord)'); + RegisterMethod('Procedure SetDefaultKeystrokes'); + RegisterMethod('Procedure SetSelWord'); + RegisterMethod('Procedure SetWordBlock( Value : TBufferCoord)'); + RegisterMethod('Procedure Undo'); + RegisterMethod('Procedure UnlockUndo'); + RegisterMethod('Procedure UnregisterCommandHandler( AHandlerProc : THookedCommandEvent)'); + RegisterMethod('Procedure AddKeyUpHandler( aHandler : TKeyEvent)'); + RegisterMethod('Procedure RemoveKeyUpHandler( aHandler : TKeyEvent)'); + RegisterMethod('Procedure AddKeyDownHandler( aHandler : TKeyEvent)'); + RegisterMethod('Procedure RemoveKeyDownHandler( aHandler : TKeyEvent)'); + RegisterMethod('Procedure AddKeyPressHandler( aHandler : TKeyPressWEvent)'); + RegisterMethod('Procedure RemoveKeyPressHandler( aHandler : TKeyPressWEvent)'); + RegisterMethod('Procedure AddFocusControl( aControl : TWinControl)'); + RegisterMethod('Procedure RemoveFocusControl( aControl : TWinControl)'); + RegisterMethod('Procedure AddMouseDownHandler( aHandler : TMouseEvent)'); + RegisterMethod('Procedure RemoveMouseDownHandler( aHandler : TMouseEvent)'); + RegisterMethod('Procedure AddMouseUpHandler( aHandler : TMouseEvent)'); + RegisterMethod('Procedure RemoveMouseUpHandler( aHandler : TMouseEvent)'); + RegisterMethod('Procedure AddMouseCursorHandler( aHandler : TMouseCursorEvent)'); + RegisterMethod('Procedure RemoveMouseCursorHandler( aHandler : TMouseCursorEvent)'); + RegisterMethod('Procedure SetLinesPointer( ASynEdit : TCustomSynEdit)'); + RegisterMethod('Procedure RemoveLinesPointer'); + RegisterMethod('Procedure HookTextBuffer( aBuffer : TSynEditStringList; aUndo, aRedo : TSynEditUndoList)'); + RegisterMethod('Procedure UnHookTextBuffer'); + {$IF CompilerVersion >= 23} + RegisterMethod('Procedure CollapseAll'); + RegisterMethod('Procedure UncollapseAll'); + RegisterMethod('Procedure Collapse( FoldRangeIndex : Integer; Invalidate : Boolean)'); + RegisterMethod('Procedure Uncollapse( FoldRangeIndex : Integer; Invalidate : Boolean)'); + RegisterMethod('Procedure UncollapseAroundLine( Line : Integer)'); + RegisterMethod('Procedure CollapseNearest'); + RegisterMethod('Procedure UncollapseNearest'); + RegisterMethod('Procedure CollapseLevel( Level : integer)'); + RegisterMethod('Procedure UnCollapseLevel( Level : integer)'); + RegisterMethod('Procedure CollapseFoldType( FoldType : Integer)'); + RegisterMethod('Procedure UnCollapseFoldType( FoldType : Integer)'); + {$IFEND} + RegisterProperty('AdditionalIdentChars', 'TSysCharSet', iptrw); + RegisterProperty('AdditionalWordBreakChars', 'TSysCharSet', iptrw); + RegisterProperty('BlockBegin', 'TBufferCoord', iptrw); + RegisterProperty('BlockEnd', 'TBufferCoord', iptrw); + RegisterProperty('CanPaste', 'Boolean', iptr); + RegisterProperty('CanRedo', 'Boolean', iptr); + RegisterProperty('CanUndo', 'Boolean', iptr); + RegisterProperty('CaretX', 'Integer', iptrw); + RegisterProperty('CaretY', 'Integer', iptrw); + RegisterProperty('CaretXY', 'TBufferCoord', iptrw); + RegisterProperty('ActiveLineColor', 'TColor', iptrw); + RegisterProperty('DisplayX', 'Integer', iptr); + RegisterProperty('DisplayY', 'Integer', iptr); + RegisterProperty('DisplayXY', 'TDisplayCoord', iptr); + RegisterProperty('DisplayLineCount', 'Integer', iptr); + RegisterProperty('CharsInWindow', 'Integer', iptr); + RegisterProperty('CharWidth', 'Integer', iptr); + RegisterProperty('Font', 'TFont', iptrw); + RegisterProperty('Highlighter', 'TSynCustomHighlighter', iptrw); + RegisterProperty('HintMode', 'TSynHintMode', iptrw); + RegisterProperty('LeftChar', 'Integer', iptrw); + RegisterProperty('LineHeight', 'Integer', iptr); + RegisterProperty('LinesInWindow', 'Integer', iptr); + RegisterProperty('LineText', 'UnicodeString', iptrw); + RegisterProperty('Lines', 'TStrings', iptrw); +// RegisterProperty('Lines', 'TUnicodeStrings', iptrw); + RegisterProperty('Marks', 'TSynEditMarkList', iptr); + RegisterProperty('MaxScrollWidth', 'Integer', iptrw); + RegisterProperty('Modified', 'Boolean', iptrw); + RegisterProperty('PaintLock', 'Integer', iptr); + RegisterProperty('ReadOnly', 'Boolean', iptrw); + RegisterProperty('SearchEngine', 'TSynEditSearchCustom', iptrw); + RegisterProperty('SelAvail', 'Boolean', iptr); + RegisterProperty('SelLength', 'Integer', iptrw); + RegisterProperty('SelTabBlock', 'Boolean', iptr); + RegisterProperty('SelTabLine', 'Boolean', iptr); + RegisterProperty('SelText', 'UnicodeString', iptrw); + RegisterProperty('StateFlags', 'TSynStateFlags', iptr); + RegisterProperty('Text', 'UnicodeString', iptrw); + RegisterProperty('TopLine', 'Integer', iptrw); + RegisterProperty('WordAtCursor', 'UnicodeString', iptr); + RegisterProperty('WordAtMouse', 'UnicodeString', iptr); + RegisterProperty('UndoList', 'TSynEditUndoList', iptr); + RegisterProperty('RedoList', 'TSynEditUndoList', iptr); + RegisterProperty('OnProcessCommand', 'TProcessCommandEvent', iptrw); + RegisterProperty('CodeFolding', 'TSynCodeFolding', iptrw); + RegisterProperty('UseCodeFolding', 'Boolean', iptrw); + RegisterProperty('AllFoldRanges', 'TSynFoldRanges', iptr); + RegisterProperty('BookMarkOptions', 'TSynBookMarkOpt', iptrw); + RegisterProperty('BorderStyle', 'TSynBorderStyle', iptrw); + RegisterProperty('ExtraLineSpacing', 'Integer', iptrw); + RegisterProperty('Gutter', 'TSynGutter', iptrw); + RegisterProperty('HideSelection', 'Boolean', iptrw); + RegisterProperty('InsertCaret', 'TSynEditCaretType', iptrw); + RegisterProperty('InsertMode', 'Boolean', iptrw); + RegisterProperty('IsScrolling', 'Boolean', iptr); + RegisterProperty('Keystrokes', 'TSynEditKeyStrokes', iptrw); + RegisterProperty('MaxUndo', 'Integer', iptrw); + RegisterProperty('Options', 'TSynEditorOptions', iptrw); + RegisterProperty('OverwriteCaret', 'TSynEditCaretType', iptrw); + RegisterProperty('RightEdge', 'Integer', iptrw); + RegisterProperty('RightEdgeColor', 'TColor', iptrw); + RegisterProperty('ScrollHintColor', 'TColor', iptrw); + RegisterProperty('ScrollHintFormat', 'TScrollHintFormat', iptrw); + RegisterProperty('ScrollBars', 'TScrollStyle', iptrw); + RegisterProperty('SelectedColor', 'TSynSelectedColor', iptrw); + RegisterProperty('SelectionMode', 'TSynSelectionMode', iptrw); + RegisterProperty('ActiveSelectionMode', 'TSynSelectionMode', iptrw); + RegisterProperty('TabWidth', 'Integer', iptrw); + RegisterProperty('WantReturns', 'Boolean', iptrw); + RegisterProperty('WantTabs', 'Boolean', iptrw); + RegisterProperty('WordWrap', 'Boolean', iptrw); + RegisterProperty('WordWrapGlyph', 'TSynGlyph', iptrw); + RegisterProperty('OnChange', 'TNotifyEvent', iptrw); + RegisterProperty('OnClearBookmark', 'TPlaceMarkEvent', iptrw); + RegisterProperty('OnCommandProcessed', 'TProcessCommandEvent', iptrw); + RegisterProperty('OnContextHelp', 'TContextHelpEvent', iptrw); +// RegisterProperty('OnDropFiles', 'TDropFilesEvent', iptrw); // MS + RegisterProperty('OnGutterClick', 'TGutterClickEvent', iptrw); + RegisterProperty('OnGutterGetText', 'TGutterGetTextEvent', iptrw); + RegisterProperty('OnGutterPaint', 'TGutterPaintEvent', iptrw); + RegisterProperty('OnMouseCursor', 'TMouseCursorEvent', iptrw); + RegisterProperty('OnKeyPress', 'TKeyPressWEvent', iptrw); + RegisterProperty('OnPaint', 'TPaintEvent', iptrw); + RegisterProperty('OnPlaceBookmark', 'TPlaceMarkEvent', iptrw); + RegisterProperty('OnProcessUserCommand', 'TProcessCommandEvent', iptrw); + RegisterProperty('OnReplaceText', 'TReplaceTextEvent', iptrw); + RegisterProperty('OnSpecialLineColors', 'TSpecialLineColorsEvent', iptrw); + RegisterProperty('OnSpecialTokenAttributes', 'TSpecialTokenAttributesEvent', iptrw); + RegisterProperty('OnStatusChange', 'TStatusChangeEvent', iptrw); + RegisterProperty('OnPaintTransient', 'TPaintTransient', iptrw); + RegisterProperty('OnScroll', 'TScrollEvent', iptrw); + RegisterProperty('OnTokenHint', 'TGetTokenHintEvent', iptrw); + {$IF CompilerVersion >= 23} + RegisterProperty('OnScanForFoldRanges', 'TScanForFoldRangesEvent', iptrw); + {$IFEND} + RegisterProperty('OnSearchNotFound', 'TCustomSynEditSearchNotFoundEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TSynEditPlugin(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TObject', 'TSynEditPlugin') do + with CL.AddClassN(CL.FindClass('TObject'),'TSynEditPlugin') do + begin + RegisterMethod('Constructor Create( AOwner : TCustomSynEdit)'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TSynEditMarkList(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TObjectList', 'TSynEditMarkList') do + with CL.AddClassN(CL.FindClass('TObjectList'),'TSynEditMarkList') do + begin + RegisterMethod('Constructor Create( AOwner : TCustomSynEdit)'); + RegisterMethod('Function First : TSynEditMark'); + RegisterMethod('Function Last : TSynEditMark'); + RegisterMethod('Function Extract( Item : TSynEditMark) : TSynEditMark'); + RegisterMethod('Procedure ClearLine( line : Integer)'); + RegisterMethod('Procedure GetMarksForLine( line : Integer; var Marks : TSynEditMarks)'); + RegisterMethod('Procedure Place( mark : TSynEditMark)'); + RegisterProperty('Items', 'TSynEditMark Integer', iptrw); + SetDefaultPropery('Items'); + RegisterProperty('Edit', 'TCustomSynEdit', iptr); + RegisterProperty('OnChange', 'TNotifyEvent', iptrw); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_TSynEditMark(CL: TPSPascalCompiler); +begin + //with RegClassS(CL,'TOBJECT', 'TSynEditMark') do + with CL.AddClassN(CL.FindClass('TOBJECT'),'TSynEditMark') do + begin + RegisterMethod('Constructor Create( AOwner : TCustomSynEdit)'); + RegisterProperty('Line', 'Integer', iptrw); + RegisterProperty('Char', 'Integer', iptrw); + RegisterProperty('Edit', 'TCustomSynEdit', iptr); + RegisterProperty('ImageIndex', 'Integer', iptrw); + RegisterProperty('BookmarkNumber', 'Integer', iptrw); + RegisterProperty('Visible', 'Boolean', iptrw); + RegisterProperty('InternalImage', 'Boolean', iptrw); + RegisterProperty('IsBookmark', 'Boolean', iptr); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure SIRegister_SynEdit(CL: TPSPascalCompiler); // MS +begin + CL.AddConstantN('WM_MOUSEWHEEL','LongWord').SetUInt( $020A); + CL.AddConstantN('MAX_SCROLL','LongInt').SetInt( 32767); + CL.AddConstantN('MAX_MARKS','LongInt').SetInt( 16); + CL.AddConstantN('SYNEDIT_CLIPBOARD_FORMAT','String').SetString( 'SynEdit Control Block Type'); + CL.AddTypeS('TSynBorderStyle', 'TBorderStyle'); + CL.AddTypeS('TSynReplaceAction', '( raCancel, raSkip, raReplace, raReplaceAll' + +' )'); + CL.AddClassN(CL.FindClass('TOBJECT'),'ESynEditError'); +// CL.AddTypeS('TDropFilesEvent', 'Procedure ( Sender : TObject; X, Y : Integer;' +// +' AFiles : TUnicodeStrings)'); +// CL.AddTypeS('THookedCommandEvent', 'Procedure ( Sender : TObject; AfterProces' +// +'sing : Boolean; var Handled : Boolean; var Command : TSynEditorCommand; va' +// +'r AChar : WideChar; Data, HandlerData : Pointer)'); + CL.AddTypeS('TPaintEvent', 'Procedure ( Sender : TObject; ACanvas : TCanvas)'); +// CL.AddTypeS('TProcessCommandEvent', 'Procedure ( Sender : TObject; var Comman' +// +'d : TSynEditorCommand; var AChar : WideChar; Data : Pointer)'); + CL.AddTypeS('TReplaceTextEvent', 'Procedure ( Sender : TObject; const ASearch' + +', AReplace : UnicodeString; Line, Column : Integer; var Action : TSynRepla' + +'ceAction)'); + CL.AddTypeS('TSpecialLineColorsEvent', 'Procedure ( Sender : TObject; Line : ' + +'Integer; var Special : Boolean; var FG, BG : TColor)'); + CL.AddTypeS('TSpecialTokenAttributesEvent', 'Procedure ( Sender : TObject; AL' + +'ine, APos : Integer; const AToken : string; var ASpecial : Boolean; var FG' + +', BG : TColor; var AStyle : TFontStyles)'); + CL.AddTypeS('TTransientType', '( ttBefore, ttAfter )'); + CL.AddTypeS('TPaintTransient', 'Procedure ( Sender : TObject; Canvas : TCanva' + +'s; TransientType : TTransientType)'); + CL.AddTypeS('TScrollEvent', 'Procedure ( Sender : TObject; ScrollBar : TScrol' + +'lBarKind)'); + CL.AddTypeS('TGutterGetTextEvent', 'Procedure ( Sender : TObject; aLine : Int' + +'eger; var aText : UnicodeString)'); + CL.AddTypeS('TGutterPaintEvent', 'Procedure ( Sender : TObject; aLine : Integ' + +'er; X, Y : Integer)'); + CL.AddTypeS('TSynEditCaretType', '( ctVerticalLine, ctHorizontalLine, ctHalfB' + +'lock, ctBlock, ctVerticalLine2 )'); + CL.AddTypeS('TSynStateFlag', '( sfCaretChanged, sfScrollbarChanged, sfLinesCh' + +'anging, sfIgnoreNextChar, sfCaretVisible, sfDblClicked, sfPossibleGutterCl' + +'ick, sfWaitForDragging, sfInsideRedo, sfGutterDragging, sfMouseCaptured )'); + CL.AddTypeS('TSynStateFlags', 'set of TSynStateFlag'); + CL.AddTypeS('TScrollHintFormat', '( shfTopLineOnly, shfTopToBottom )'); + CL.AddTypeS('TSynHintMode', '( shmDefault, shmToken )'); +// CL.AddTypeS('TGetTokenHintEvent', 'Procedure ( Sender : TObject; Coords : TBu' +// +'fferCoord; const Token : string; TokenType : Integer; Attri : TSynHighligh' +// +'terAttributes; var HintText : string)'); + CL.AddTypeS('TSynEditorOption', '( eoAltSetsColumnMode, eoAutoIndent, eoAutoS' + +'izeMaxScrollWidth, eoDisableScrollArrows, eoDragDropEditing, eoDropFiles, ' + +'eoEnhanceHomeKey, eoEnhanceEndKey, eoGroupUndo, eoHalfPageScroll, eoHideSh' + +'owScrollbars, eoKeepCaretX, eoNoCaret, eoNoSelection, eoRightMouseMovesCur' + +'sor, eoScrollByOneLess, eoScrollHintFollows, eoScrollPastEof, eoScrollPast' + +'Eol, eoShowScrollHint, eoShowSpecialChars, eoSmartTabDelete, eoSmartTabs, ' + +'eoSpecialLineDefaultFg, eoTabIndent, eoTabsToSpaces, eoTrimTrailingSpaces ' + +')'); + CL.AddTypeS('TSynEditorOptions', 'set of TSynEditorOption'); + CL.AddTypeS('TSynFontSmoothMethod', '( fsmNone, fsmAntiAlias, fsmClearType )'); + CL.AddConstantN('SYNEDIT_DEFAULT_OPTIONS','LongInt').Value.ts32 := ord(eoAutoIndent) or ord(eoDragDropEditing) or ord(eoEnhanceEndKey) or ord(eoScrollPastEol) or ord(eoShowScrollHint) or ord(eoSmartTabs) or ord(eoTabsToSpaces) or ord(eoSmartTabDelete) or ord(eoGroupUndo); + CL.AddTypeS('TSynStatusChange', '( scAll, scCaretX, scCaretY, scLeftChar, scT' + +'opLine, scInsertMode, scModified, scSelection, scReadOnly )'); + CL.AddTypeS('TSynStatusChanges', 'set of TSynStatusChange'); + CL.AddTypeS('TContextHelpEvent', 'Procedure ( Sender : TObject; Word : Unicod' + +'eString)'); + CL.AddTypeS('TStatusChangeEvent', 'Procedure ( Sender : TObject; Changes : TS' + +'ynStatusChanges)'); +// CL.AddTypeS('TMouseCursorEvent', 'Procedure ( Sender : TObject; const aLineCh' +// +'arPos : TBufferCoord; var aCursor : TCursor)'); +// CL.AddTypeS('TScanForFoldRangesEvent', 'Procedure ( Sender : TObject; FoldRan' +// +'ges : TSynFoldRanges; LinesToScan : TStrings; FromLine : Integer; ToLine :' +// +' Integer)'); + CL.AddClassN(CL.FindClass('TOBJECT'),'TCustomSynEdit'); + SIRegister_TSynEditMark(CL); + CL.AddTypeS('TPlaceMarkEvent', 'Procedure ( Sender : TObject; var Mark : TSyn' + +'EditMark)'); + SIRegister_TSynEditMarkList(CL); + CL.AddTypeS('TGutterClickEvent', 'Procedure ( Sender : TObject; Button : TMou' + +'seButton; X, Y, Line : Integer; Mark : TSynEditMark)'); + SIRegister_TSynEditPlugin(CL); + CL.AddTypeS('TCustomSynEditSearchNotFoundEvent', 'Procedure ( Sender : TObjec' + +'t; FindText : UnicodeString)'); + SIRegister_TCustomSynEdit(CL); + SIRegister_TSynEdit(CL); +end; + +(* === run-time registration functions === *) +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSearchNotFound_W(Self: TCustomSynEdit; const T: TCustomSynEditSearchNotFoundEvent); +begin Self.OnSearchNotFound := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSearchNotFound_R(Self: TCustomSynEdit; var T: TCustomSynEditSearchNotFoundEvent); +begin T := Self.OnSearchNotFound; end; + +(*----------------------------------------------------------------------------*) +{$IF CompilerVersion >= 23} +procedure TCustomSynEditOnScanForFoldRanges_W(Self: TCustomSynEdit; const T: TScanForFoldRangesEvent); +begin Self.OnScanForFoldRanges := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnScanForFoldRanges_R(Self: TCustomSynEdit; var T: TScanForFoldRangesEvent); +begin T := Self.OnScanForFoldRanges; end; +{$IFEND} + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnTokenHint_W(Self: TCustomSynEdit; const T: TGetTokenHintEvent); +begin Self.OnTokenHint := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnTokenHint_R(Self: TCustomSynEdit; var T: TGetTokenHintEvent); +begin T := Self.OnTokenHint; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnScroll_W(Self: TCustomSynEdit; const T: TScrollEvent); +begin Self.OnScroll := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnScroll_R(Self: TCustomSynEdit; var T: TScrollEvent); +begin T := Self.OnScroll; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPaintTransient_W(Self: TCustomSynEdit; const T: TPaintTransient); +begin Self.OnPaintTransient := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPaintTransient_R(Self: TCustomSynEdit; var T: TPaintTransient); +begin T := Self.OnPaintTransient; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnStatusChange_W(Self: TCustomSynEdit; const T: TStatusChangeEvent); +begin Self.OnStatusChange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnStatusChange_R(Self: TCustomSynEdit; var T: TStatusChangeEvent); +begin T := Self.OnStatusChange; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSpecialTokenAttributes_W(Self: TCustomSynEdit; const T: TSpecialTokenAttributesEvent); +begin Self.OnSpecialTokenAttributes := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSpecialTokenAttributes_R(Self: TCustomSynEdit; var T: TSpecialTokenAttributesEvent); +begin T := Self.OnSpecialTokenAttributes; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSpecialLineColors_W(Self: TCustomSynEdit; const T: TSpecialLineColorsEvent); +begin Self.OnSpecialLineColors := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnSpecialLineColors_R(Self: TCustomSynEdit; var T: TSpecialLineColorsEvent); +begin T := Self.OnSpecialLineColors; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnReplaceText_W(Self: TCustomSynEdit; const T: TReplaceTextEvent); +begin Self.OnReplaceText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnReplaceText_R(Self: TCustomSynEdit; var T: TReplaceTextEvent); +begin T := Self.OnReplaceText; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnProcessUserCommand_W(Self: TCustomSynEdit; const T: TProcessCommandEvent); +begin Self.OnProcessUserCommand := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnProcessUserCommand_R(Self: TCustomSynEdit; var T: TProcessCommandEvent); +begin T := Self.OnProcessUserCommand; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPlaceBookmark_W(Self: TCustomSynEdit; const T: TPlaceMarkEvent); +begin Self.OnPlaceBookmark := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPlaceBookmark_R(Self: TCustomSynEdit; var T: TPlaceMarkEvent); +begin T := Self.OnPlaceBookmark; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPaint_W(Self: TCustomSynEdit; const T: TPaintEvent); +begin Self.OnPaint := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnPaint_R(Self: TCustomSynEdit; var T: TPaintEvent); +begin T := Self.OnPaint; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnKeyPress_W(Self: TCustomSynEdit; const T: TKeyPressWEvent); +begin Self.OnKeyPress := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnKeyPress_R(Self: TCustomSynEdit; var T: TKeyPressWEvent); +begin T := Self.OnKeyPress; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnMouseCursor_W(Self: TCustomSynEdit; const T: TMouseCursorEvent); +begin Self.OnMouseCursor := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnMouseCursor_R(Self: TCustomSynEdit; var T: TMouseCursorEvent); +begin T := Self.OnMouseCursor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterPaint_W(Self: TCustomSynEdit; const T: TGutterPaintEvent); +begin Self.OnGutterPaint := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterPaint_R(Self: TCustomSynEdit; var T: TGutterPaintEvent); +begin T := Self.OnGutterPaint; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterGetText_W(Self: TCustomSynEdit; const T: TGutterGetTextEvent); +begin Self.OnGutterGetText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterGetText_R(Self: TCustomSynEdit; var T: TGutterGetTextEvent); +begin T := Self.OnGutterGetText; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterClick_W(Self: TCustomSynEdit; const T: TGutterClickEvent); +begin Self.OnGutterClick := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnGutterClick_R(Self: TCustomSynEdit; var T: TGutterClickEvent); +begin T := Self.OnGutterClick; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnDropFiles_W(Self: TCustomSynEdit; const T: TDropFilesEvent); +begin Self.OnDropFiles := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnDropFiles_R(Self: TCustomSynEdit; var T: TDropFilesEvent); +begin T := Self.OnDropFiles; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnContextHelp_W(Self: TCustomSynEdit; const T: TContextHelpEvent); +begin Self.OnContextHelp := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnContextHelp_R(Self: TCustomSynEdit; var T: TContextHelpEvent); +begin T := Self.OnContextHelp; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnCommandProcessed_W(Self: TCustomSynEdit; const T: TProcessCommandEvent); +begin Self.OnCommandProcessed := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnCommandProcessed_R(Self: TCustomSynEdit; var T: TProcessCommandEvent); +begin T := Self.OnCommandProcessed; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnClearBookmark_W(Self: TCustomSynEdit; const T: TPlaceMarkEvent); +begin Self.OnClearBookmark := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnClearBookmark_R(Self: TCustomSynEdit; var T: TPlaceMarkEvent); +begin T := Self.OnClearBookmark; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnChange_W(Self: TCustomSynEdit; const T: TNotifyEvent); +begin Self.OnChange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnChange_R(Self: TCustomSynEdit; var T: TNotifyEvent); +begin T := Self.OnChange; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordWrapGlyph_W(Self: TCustomSynEdit; const T: TSynGlyph); +begin Self.WordWrapGlyph := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordWrapGlyph_R(Self: TCustomSynEdit; var T: TSynGlyph); +begin T := Self.WordWrapGlyph; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordWrap_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.WordWrap := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordWrap_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.WordWrap; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWantTabs_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.WantTabs := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWantTabs_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.WantTabs; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWantReturns_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.WantReturns := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWantReturns_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.WantReturns; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditTabWidth_W(Self: TCustomSynEdit; const T: Integer); +begin Self.TabWidth := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditTabWidth_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.TabWidth; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditActiveSelectionMode_W(Self: TCustomSynEdit; const T: TSynSelectionMode); +begin Self.ActiveSelectionMode := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditActiveSelectionMode_R(Self: TCustomSynEdit; var T: TSynSelectionMode); +begin T := Self.ActiveSelectionMode; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelectionMode_W(Self: TCustomSynEdit; const T: TSynSelectionMode); +begin Self.SelectionMode := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelectionMode_R(Self: TCustomSynEdit; var T: TSynSelectionMode); +begin T := Self.SelectionMode; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelectedColor_W(Self: TCustomSynEdit; const T: TSynSelectedColor); +begin Self.SelectedColor := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelectedColor_R(Self: TCustomSynEdit; var T: TSynSelectedColor); +begin T := Self.SelectedColor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollBars_W(Self: TCustomSynEdit; const T: TScrollStyle); +begin Self.ScrollBars := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollBars_R(Self: TCustomSynEdit; var T: TScrollStyle); +begin T := Self.ScrollBars; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollHintFormat_W(Self: TCustomSynEdit; const T: TScrollHintFormat); +begin Self.ScrollHintFormat := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollHintFormat_R(Self: TCustomSynEdit; var T: TScrollHintFormat); +begin T := Self.ScrollHintFormat; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollHintColor_W(Self: TCustomSynEdit; const T: TColor); +begin Self.ScrollHintColor := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditScrollHintColor_R(Self: TCustomSynEdit; var T: TColor); +begin T := Self.ScrollHintColor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditRightEdgeColor_W(Self: TCustomSynEdit; const T: TColor); +begin Self.RightEdgeColor := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditRightEdgeColor_R(Self: TCustomSynEdit; var T: TColor); +begin T := Self.RightEdgeColor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditRightEdge_W(Self: TCustomSynEdit; const T: Integer); +begin Self.RightEdge := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditRightEdge_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.RightEdge; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOverwriteCaret_W(Self: TCustomSynEdit; const T: TSynEditCaretType); +begin Self.OverwriteCaret := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOverwriteCaret_R(Self: TCustomSynEdit; var T: TSynEditCaretType); +begin T := Self.OverwriteCaret; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOptions_W(Self: TCustomSynEdit; const T: TSynEditorOptions); +begin Self.Options := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOptions_R(Self: TCustomSynEdit; var T: TSynEditorOptions); +begin T := Self.Options; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditMaxUndo_W(Self: TCustomSynEdit; const T: Integer); +begin Self.MaxUndo := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditMaxUndo_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.MaxUndo; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditKeystrokes_W(Self: TCustomSynEdit; const T: TSynEditKeyStrokes); +begin Self.Keystrokes := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditKeystrokes_R(Self: TCustomSynEdit; var T: TSynEditKeyStrokes); +begin T := Self.Keystrokes; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditIsScrolling_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.IsScrolling; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditInsertMode_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.InsertMode := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditInsertMode_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.InsertMode; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditInsertCaret_W(Self: TCustomSynEdit; const T: TSynEditCaretType); +begin Self.InsertCaret := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditInsertCaret_R(Self: TCustomSynEdit; var T: TSynEditCaretType); +begin T := Self.InsertCaret; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHideSelection_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.HideSelection := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHideSelection_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.HideSelection; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditGutter_W(Self: TCustomSynEdit; const T: TSynGutter); +begin Self.Gutter := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditGutter_R(Self: TCustomSynEdit; var T: TSynGutter); +begin T := Self.Gutter; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditExtraLineSpacing_W(Self: TCustomSynEdit; const T: Integer); +begin Self.ExtraLineSpacing := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditExtraLineSpacing_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.ExtraLineSpacing; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBorderStyle_W(Self: TCustomSynEdit; const T: TSynBorderStyle); +begin Self.BorderStyle := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBorderStyle_R(Self: TCustomSynEdit; var T: TSynBorderStyle); +begin T := Self.BorderStyle; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBookMarkOptions_W(Self: TCustomSynEdit; const T: TSynBookMarkOpt); +begin Self.BookMarkOptions := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBookMarkOptions_R(Self: TCustomSynEdit; var T: TSynBookMarkOpt); +begin T := Self.BookMarkOptions; end; + +(*----------------------------------------------------------------------------*) +{$IF CompilerVersion >= 23} +procedure TCustomSynEditAllFoldRanges_R(Self: TCustomSynEdit; var T: TSynFoldRanges); +begin T := Self.AllFoldRanges; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditUseCodeFolding_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.UseCodeFolding := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditUseCodeFolding_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.UseCodeFolding; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCodeFolding_W(Self: TCustomSynEdit; const T: TSynCodeFolding); +begin Self.CodeFolding := T; end; + + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCodeFolding_R(Self: TCustomSynEdit; var T: TSynCodeFolding); +begin T := Self.CodeFolding; end; +{$IFEND} + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnProcessCommand_W(Self: TCustomSynEdit; const T: TProcessCommandEvent); +begin Self.OnProcessCommand := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditOnProcessCommand_R(Self: TCustomSynEdit; var T: TProcessCommandEvent); +begin T := Self.OnProcessCommand; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditRedoList_R(Self: TCustomSynEdit; var T: TSynEditUndoList); +begin T := Self.RedoList; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditUndoList_R(Self: TCustomSynEdit; var T: TSynEditUndoList); +begin T := Self.UndoList; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordAtMouse_R(Self: TCustomSynEdit; var T: UnicodeString); +begin T := Self.WordAtMouse; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditWordAtCursor_R(Self: TCustomSynEdit; var T: UnicodeString); +begin T := Self.WordAtCursor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditTopLine_W(Self: TCustomSynEdit; const T: Integer); +begin Self.TopLine := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditTopLine_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.TopLine; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditText_W(Self: TCustomSynEdit; const T: UnicodeString); +begin Self.Text := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditText_R(Self: TCustomSynEdit; var T: UnicodeString); +begin T := Self.Text; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditStateFlags_R(Self: TCustomSynEdit; var T: TSynStateFlags); +begin T := Self.StateFlags; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelText_W(Self: TCustomSynEdit; const T: UnicodeString); +begin Self.SelText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelText_R(Self: TCustomSynEdit; var T: UnicodeString); +begin T := Self.SelText; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelTabLine_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.SelTabLine; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelTabBlock_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.SelTabBlock; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelLength_W(Self: TCustomSynEdit; const T: Integer); +begin Self.SelLength := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelLength_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.SelLength; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelAvail_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.SelAvail; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSearchEngine_W(Self: TCustomSynEdit; const T: TSynEditSearchCustom); +begin Self.SearchEngine := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSearchEngine_R(Self: TCustomSynEdit; var T: TSynEditSearchCustom); +begin T := Self.SearchEngine; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditReadOnly_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.ReadOnly := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditReadOnly_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.ReadOnly; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditPaintLock_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.PaintLock; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditModified_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.Modified := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditModified_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.Modified; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditMaxScrollWidth_W(Self: TCustomSynEdit; const T: Integer); +begin Self.MaxScrollWidth := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditMaxScrollWidth_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.MaxScrollWidth; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditMarks_R(Self: TCustomSynEdit; var T: TSynEditMarkList); +begin T := Self.Marks; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLines_W(Self: TCustomSynEdit; const T: TUnicodeStrings); +begin Self.Lines := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLines_R(Self: TCustomSynEdit; var T: TUnicodeStrings); +begin T := Self.Lines; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLineText_W(Self: TCustomSynEdit; const T: UnicodeString); +begin Self.LineText := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLineText_R(Self: TCustomSynEdit; var T: UnicodeString); +begin T := Self.LineText; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLinesInWindow_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.LinesInWindow; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLineHeight_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.LineHeight; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLeftChar_W(Self: TCustomSynEdit; const T: Integer); +begin Self.LeftChar := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditLeftChar_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.LeftChar; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHintMode_W(Self: TCustomSynEdit; const T: TSynHintMode); +begin Self.HintMode := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHintMode_R(Self: TCustomSynEdit; var T: TSynHintMode); +begin T := Self.HintMode; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHighlighter_W(Self: TCustomSynEdit; const T: TSynCustomHighlighter); +begin Self.Highlighter := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditHighlighter_R(Self: TCustomSynEdit; var T: TSynCustomHighlighter); +begin T := Self.Highlighter; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditFont_W(Self: TCustomSynEdit; const T: TFont); +begin Self.Font := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditFont_R(Self: TCustomSynEdit; var T: TFont); +begin T := Self.Font; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCharWidth_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.CharWidth; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCharsInWindow_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.CharsInWindow; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditDisplayLineCount_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.DisplayLineCount; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditDisplayXY_R(Self: TCustomSynEdit; var T: TDisplayCoord); +begin T := Self.DisplayXY; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditDisplayY_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.DisplayY; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditDisplayX_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.DisplayX; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditActiveLineColor_W(Self: TCustomSynEdit; const T: TColor); +begin Self.ActiveLineColor := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditActiveLineColor_R(Self: TCustomSynEdit; var T: TColor); +begin T := Self.ActiveLineColor; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretXY_W(Self: TCustomSynEdit; const T: TBufferCoord); +begin Self.CaretXY := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretXY_R(Self: TCustomSynEdit; var T: TBufferCoord); +begin T := Self.CaretXY; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretY_W(Self: TCustomSynEdit; const T: Integer); +begin Self.CaretY := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretY_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.CaretY; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretX_W(Self: TCustomSynEdit; const T: Integer); +begin Self.CaretX := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCaretX_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.CaretX; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCanUndo_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.CanUndo; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCanRedo_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.CanRedo; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditCanPaste_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.CanPaste; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBlockEnd_W(Self: TCustomSynEdit; const T: TBufferCoord); +begin Self.BlockEnd := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBlockEnd_R(Self: TCustomSynEdit; var T: TBufferCoord); +begin T := Self.BlockEnd; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBlockBegin_W(Self: TCustomSynEdit; const T: TBufferCoord); +begin Self.BlockBegin := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditBlockBegin_R(Self: TCustomSynEdit; var T: TBufferCoord); +begin T := Self.BlockBegin; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAdditionalWordBreakChars_W(Self: TCustomSynEdit; const T: TSysCharSet); +begin Self.AdditionalWordBreakChars := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAdditionalWordBreakChars_R(Self: TCustomSynEdit; var T: TSysCharSet); +begin T := Self.AdditionalWordBreakChars; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAdditionalIdentChars_W(Self: TCustomSynEdit; const T: TSysCharSet); +begin Self.AdditionalIdentChars := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAdditionalIdentChars_R(Self: TCustomSynEdit; var T: TSysCharSet); +begin T := Self.AdditionalIdentChars; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAlwaysShowCaret_W(Self: TCustomSynEdit; const T: Boolean); +begin Self.AlwaysShowCaret := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditAlwaysShowCaret_R(Self: TCustomSynEdit; var T: Boolean); +begin T := Self.AlwaysShowCaret; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelEnd_W(Self: TCustomSynEdit; const T: Integer); +begin Self.SelEnd := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelEnd_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.SelEnd; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelStart_W(Self: TCustomSynEdit; const T: Integer); +begin Self.SelStart := T; end; + +(*----------------------------------------------------------------------------*) +procedure TCustomSynEditSelStart_R(Self: TCustomSynEdit; var T: Integer); +begin T := Self.SelStart; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkListOnChange_W(Self: TSynEditMarkList; const T: TNotifyEvent); +begin Self.OnChange := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkListOnChange_R(Self: TSynEditMarkList; var T: TNotifyEvent); +begin T := Self.OnChange; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkListEdit_R(Self: TSynEditMarkList; var T: TCustomSynEdit); +begin T := Self.Edit; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkListItems_W(Self: TSynEditMarkList; const T: TSynEditMark; const t1: Integer); +begin Self.Items[t1] := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkListItems_R(Self: TSynEditMarkList; var T: TSynEditMark; const t1: Integer); +begin T := Self.Items[t1]; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkIsBookmark_R(Self: TSynEditMark; var T: Boolean); +begin T := Self.IsBookmark; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkInternalImage_W(Self: TSynEditMark; const T: Boolean); +begin Self.InternalImage := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkInternalImage_R(Self: TSynEditMark; var T: Boolean); +begin T := Self.InternalImage; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkVisible_W(Self: TSynEditMark; const T: Boolean); +begin Self.Visible := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkVisible_R(Self: TSynEditMark; var T: Boolean); +begin T := Self.Visible; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkBookmarkNumber_W(Self: TSynEditMark; const T: Integer); +begin Self.BookmarkNumber := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkBookmarkNumber_R(Self: TSynEditMark; var T: Integer); +begin T := Self.BookmarkNumber; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkImageIndex_W(Self: TSynEditMark; const T: Integer); +begin Self.ImageIndex := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkImageIndex_R(Self: TSynEditMark; var T: Integer); +begin T := Self.ImageIndex; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkEdit_R(Self: TSynEditMark; var T: TCustomSynEdit); +begin T := Self.Edit; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkChar_W(Self: TSynEditMark; const T: Integer); +begin Self.Char := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkChar_R(Self: TSynEditMark; var T: Integer); +begin T := Self.Char; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkLine_W(Self: TSynEditMark; const T: Integer); +begin Self.Line := T; end; + +(*----------------------------------------------------------------------------*) +procedure TSynEditMarkLine_R(Self: TSynEditMark; var T: Integer); +begin T := Self.Line; end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TSynEdit(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TSynEdit) do + begin + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TCustomSynEdit(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TCustomSynEdit) do + begin + RegisterPropertyHelper(@TCustomSynEditSelStart_R,@TCustomSynEditSelStart_W,'SelStart'); + RegisterPropertyHelper(@TCustomSynEditSelEnd_R,@TCustomSynEditSelEnd_W,'SelEnd'); + RegisterPropertyHelper(@TCustomSynEditAlwaysShowCaret_R,@TCustomSynEditAlwaysShowCaret_W,'AlwaysShowCaret'); + RegisterMethod(@TCustomSynEdit.UpdateCaret, 'UpdateCaret'); + RegisterMethod(@TCustomSynEdit.AddKey, 'AddKey'); + RegisterMethod(@TCustomSynEdit.AddKey, 'AddKey'); + RegisterMethod(@TCustomSynEdit.BeginUndoBlock, 'BeginUndoBlock'); + RegisterMethod(@TCustomSynEdit.BeginUpdate, 'BeginUpdate'); + RegisterMethod(@TCustomSynEdit.CaretInView, 'CaretInView'); + RegisterMethod(@TCustomSynEdit.CharIndexToRowCol, 'CharIndexToRowCol'); + RegisterMethod(@TCustomSynEdit.Clear, 'Clear'); + RegisterMethod(@TCustomSynEdit.ClearAll, 'ClearAll'); + RegisterMethod(@TCustomSynEdit.ClearBookMark, 'ClearBookMark'); + RegisterMethod(@TCustomSynEdit.ClearSelection, 'ClearSelection'); + RegisterVirtualMethod(@TCustomSynEdit.CommandProcessor, 'CommandProcessor'); + RegisterMethod(@TCustomSynEdit.ClearUndo, 'ClearUndo'); + RegisterMethod(@TCustomSynEdit.CopyToClipboard, 'CopyToClipboard'); + RegisterMethod(@TCustomSynEdit.CutToClipboard, 'CutToClipboard'); + RegisterMethod(@TCustomSynEdit.DoCopyToClipboard, 'DoCopyToClipboard'); + RegisterMethod(@TCustomSynEdit.EndUndoBlock, 'EndUndoBlock'); + RegisterMethod(@TCustomSynEdit.EndUpdate, 'EndUpdate'); + RegisterMethod(@TCustomSynEdit.EnsureCursorPosVisible, 'EnsureCursorPosVisible'); + RegisterMethod(@TCustomSynEdit.EnsureCursorPosVisibleEx, 'EnsureCursorPosVisibleEx'); + RegisterVirtualMethod(@TCustomSynEdit.FindMatchingBracket, 'FindMatchingBracket'); + RegisterVirtualMethod(@TCustomSynEdit.GetMatchingBracket, 'GetMatchingBracket'); + RegisterVirtualMethod(@TCustomSynEdit.GetMatchingBracketEx, 'GetMatchingBracketEx'); + RegisterVirtualMethod(@TCustomSynEdit.ExecuteCommand, 'ExecuteCommand'); + RegisterMethod(@TCustomSynEdit.ExpandAtWideGlyphs, 'ExpandAtWideGlyphs'); + RegisterMethod(@TCustomSynEdit.GetBookMark, 'GetBookMark'); + RegisterMethod(@TCustomSynEdit.GetHighlighterAttriAtRowCol, 'GetHighlighterAttriAtRowCol'); + RegisterMethod(@TCustomSynEdit.GetHighlighterAttriAtRowColEx, 'GetHighlighterAttriAtRowColEx'); + RegisterMethod(@TCustomSynEdit.GetPositionOfMouse, 'GetPositionOfMouse'); + RegisterMethod(@TCustomSynEdit.GetWordAtRowCol, 'GetWordAtRowCol'); + RegisterVirtualMethod(@TCustomSynEdit.GotoBookMark, 'GotoBookMark'); + RegisterVirtualMethod(@TCustomSynEdit.GotoLineAndCenter, 'GotoLineAndCenter'); + RegisterVirtualMethod(@TCustomSynEdit.IsIdentChar, 'IsIdentChar'); + RegisterVirtualMethod(@TCustomSynEdit.IsWhiteChar, 'IsWhiteChar'); + RegisterVirtualMethod(@TCustomSynEdit.IsWordBreakChar, 'IsWordBreakChar'); + RegisterMethod(@TCustomSynEdit.InsertBlock, 'InsertBlock'); + RegisterMethod(@TCustomSynEdit.InsertLine, 'InsertLine'); + RegisterMethod(@TCustomSynEdit.UnifiedSelection, 'UnifiedSelection'); + RegisterMethod(@TCustomSynEdit.DoBlockIndent, 'DoBlockIndent'); + RegisterMethod(@TCustomSynEdit.DoBlockUnindent, 'DoBlockUnindent'); + RegisterMethod(@TCustomSynEdit.InvalidateGutter, 'InvalidateGutter'); + RegisterMethod(@TCustomSynEdit.InvalidateGutterLine, 'InvalidateGutterLine'); + RegisterMethod(@TCustomSynEdit.InvalidateGutterLines, 'InvalidateGutterLines'); + RegisterMethod(@TCustomSynEdit.InvalidateLine, 'InvalidateLine'); + RegisterMethod(@TCustomSynEdit.InvalidateLines, 'InvalidateLines'); + RegisterMethod(@TCustomSynEdit.InvalidateSelection, 'InvalidateSelection'); + RegisterMethod(@TCustomSynEdit.MarkModifiedLinesAsSaved, 'MarkModifiedLinesAsSaved'); + RegisterMethod(@TCustomSynEdit.ResetModificationIndicator, 'ResetModificationIndicator'); + RegisterMethod(@TCustomSynEdit.IsBookmark, 'IsBookmark'); + RegisterMethod(@TCustomSynEdit.IsPointInSelection, 'IsPointInSelection'); + RegisterMethod(@TCustomSynEdit.LockUndo, 'LockUndo'); + RegisterMethod(@TCustomSynEdit.BufferToDisplayPos, 'BufferToDisplayPos'); + RegisterMethod(@TCustomSynEdit.DisplayToBufferPos, 'DisplayToBufferPos'); + RegisterMethod(@TCustomSynEdit.LineToRow, 'LineToRow'); + RegisterMethod(@TCustomSynEdit.RowToLine, 'RowToLine'); + RegisterMethod(@TCustomSynEdit.PasteFromClipboard, 'PasteFromClipboard'); + RegisterVirtualMethod(@TCustomSynEdit.NextWordPos, 'NextWordPos'); + RegisterVirtualMethod(@TCustomSynEdit.NextWordPosEx, 'NextWordPosEx'); + RegisterVirtualMethod(@TCustomSynEdit.WordStart, 'WordStart'); + RegisterVirtualMethod(@TCustomSynEdit.WordStartEx, 'WordStartEx'); + RegisterVirtualMethod(@TCustomSynEdit.WordEnd, 'WordEnd'); + RegisterVirtualMethod(@TCustomSynEdit.WordEndEx, 'WordEndEx'); + RegisterVirtualMethod(@TCustomSynEdit.PrevWordPos, 'PrevWordPos'); + RegisterVirtualMethod(@TCustomSynEdit.PrevWordPosEx, 'PrevWordPosEx'); + RegisterMethod(@TCustomSynEdit.PixelsToRowColumn, 'PixelsToRowColumn'); + RegisterMethod(@TCustomSynEdit.PixelsToNearestRowColumn, 'PixelsToNearestRowColumn'); + RegisterMethod(@TCustomSynEdit.Redo, 'Redo'); + RegisterMethod(@TCustomSynEdit.RegisterCommandHandler, 'RegisterCommandHandler'); + RegisterMethod(@TCustomSynEdit.RowColumnToPixels, 'RowColumnToPixels'); + RegisterMethod(@TCustomSynEdit.RowColToCharIndex, 'RowColToCharIndex'); + RegisterMethod(@TCustomSynEdit.SearchReplace, 'SearchReplace'); + RegisterMethod(@TCustomSynEdit.SelectAll, 'SelectAll'); + RegisterMethod(@TCustomSynEdit.SetBookMark, 'SetBookMark'); + RegisterMethod(@TCustomSynEdit.SetCaretAndSelection, 'SetCaretAndSelection'); + RegisterVirtualMethod(@TCustomSynEdit.SetDefaultKeystrokes, 'SetDefaultKeystrokes'); + RegisterMethod(@TCustomSynEdit.SetSelWord, 'SetSelWord'); + RegisterMethod(@TCustomSynEdit.SetWordBlock, 'SetWordBlock'); + RegisterMethod(@TCustomSynEdit.Undo, 'Undo'); + RegisterMethod(@TCustomSynEdit.UnlockUndo, 'UnlockUndo'); + RegisterMethod(@TCustomSynEdit.UnregisterCommandHandler, 'UnregisterCommandHandler'); + RegisterMethod(@TCustomSynEdit.AddKeyUpHandler, 'AddKeyUpHandler'); + RegisterMethod(@TCustomSynEdit.RemoveKeyUpHandler, 'RemoveKeyUpHandler'); + RegisterMethod(@TCustomSynEdit.AddKeyDownHandler, 'AddKeyDownHandler'); + RegisterMethod(@TCustomSynEdit.RemoveKeyDownHandler, 'RemoveKeyDownHandler'); + RegisterMethod(@TCustomSynEdit.AddKeyPressHandler, 'AddKeyPressHandler'); + RegisterMethod(@TCustomSynEdit.RemoveKeyPressHandler, 'RemoveKeyPressHandler'); + RegisterMethod(@TCustomSynEdit.AddFocusControl, 'AddFocusControl'); + RegisterMethod(@TCustomSynEdit.RemoveFocusControl, 'RemoveFocusControl'); + RegisterMethod(@TCustomSynEdit.AddMouseDownHandler, 'AddMouseDownHandler'); + RegisterMethod(@TCustomSynEdit.RemoveMouseDownHandler, 'RemoveMouseDownHandler'); + RegisterMethod(@TCustomSynEdit.AddMouseUpHandler, 'AddMouseUpHandler'); + RegisterMethod(@TCustomSynEdit.RemoveMouseUpHandler, 'RemoveMouseUpHandler'); + RegisterMethod(@TCustomSynEdit.AddMouseCursorHandler, 'AddMouseCursorHandler'); + RegisterMethod(@TCustomSynEdit.RemoveMouseCursorHandler, 'RemoveMouseCursorHandler'); + RegisterMethod(@TCustomSynEdit.SetLinesPointer, 'SetLinesPointer'); + RegisterMethod(@TCustomSynEdit.RemoveLinesPointer, 'RemoveLinesPointer'); + RegisterMethod(@TCustomSynEdit.HookTextBuffer, 'HookTextBuffer'); + RegisterMethod(@TCustomSynEdit.UnHookTextBuffer, 'UnHookTextBuffer'); + {$IF CompilerVersion >= 23} + RegisterMethod(@TCustomSynEdit.CollapseAll, 'CollapseAll'); + RegisterMethod(@TCustomSynEdit.UncollapseAll, 'UncollapseAll'); + RegisterMethod(@TCustomSynEdit.Collapse, 'Collapse'); + RegisterMethod(@TCustomSynEdit.Uncollapse, 'Uncollapse'); + RegisterMethod(@TCustomSynEdit.UncollapseAroundLine, 'UncollapseAroundLine'); + RegisterMethod(@TCustomSynEdit.CollapseNearest, 'CollapseNearest'); + RegisterMethod(@TCustomSynEdit.UncollapseNearest, 'UncollapseNearest'); + RegisterMethod(@TCustomSynEdit.CollapseLevel, 'CollapseLevel'); + RegisterMethod(@TCustomSynEdit.UnCollapseLevel, 'UnCollapseLevel'); + RegisterMethod(@TCustomSynEdit.CollapseFoldType, 'CollapseFoldType'); + RegisterMethod(@TCustomSynEdit.UnCollapseFoldType, 'UnCollapseFoldType'); + {$IFEND} + RegisterPropertyHelper(@TCustomSynEditAdditionalIdentChars_R,@TCustomSynEditAdditionalIdentChars_W,'AdditionalIdentChars'); + RegisterPropertyHelper(@TCustomSynEditAdditionalWordBreakChars_R,@TCustomSynEditAdditionalWordBreakChars_W,'AdditionalWordBreakChars'); + RegisterPropertyHelper(@TCustomSynEditBlockBegin_R,@TCustomSynEditBlockBegin_W,'BlockBegin'); + RegisterPropertyHelper(@TCustomSynEditBlockEnd_R,@TCustomSynEditBlockEnd_W,'BlockEnd'); + RegisterPropertyHelper(@TCustomSynEditCanPaste_R,nil,'CanPaste'); + RegisterPropertyHelper(@TCustomSynEditCanRedo_R,nil,'CanRedo'); + RegisterPropertyHelper(@TCustomSynEditCanUndo_R,nil,'CanUndo'); + RegisterPropertyHelper(@TCustomSynEditCaretX_R,@TCustomSynEditCaretX_W,'CaretX'); + RegisterPropertyHelper(@TCustomSynEditCaretY_R,@TCustomSynEditCaretY_W,'CaretY'); + RegisterPropertyHelper(@TCustomSynEditCaretXY_R,@TCustomSynEditCaretXY_W,'CaretXY'); + RegisterPropertyHelper(@TCustomSynEditActiveLineColor_R,@TCustomSynEditActiveLineColor_W,'ActiveLineColor'); + RegisterPropertyHelper(@TCustomSynEditDisplayX_R,nil,'DisplayX'); + RegisterPropertyHelper(@TCustomSynEditDisplayY_R,nil,'DisplayY'); + RegisterPropertyHelper(@TCustomSynEditDisplayXY_R,nil,'DisplayXY'); + RegisterPropertyHelper(@TCustomSynEditDisplayLineCount_R,nil,'DisplayLineCount'); + RegisterPropertyHelper(@TCustomSynEditCharsInWindow_R,nil,'CharsInWindow'); + RegisterPropertyHelper(@TCustomSynEditCharWidth_R,nil,'CharWidth'); + RegisterPropertyHelper(@TCustomSynEditFont_R,@TCustomSynEditFont_W,'Font'); + RegisterPropertyHelper(@TCustomSynEditHighlighter_R,@TCustomSynEditHighlighter_W,'Highlighter'); + RegisterPropertyHelper(@TCustomSynEditHintMode_R,@TCustomSynEditHintMode_W,'HintMode'); + RegisterPropertyHelper(@TCustomSynEditLeftChar_R,@TCustomSynEditLeftChar_W,'LeftChar'); + RegisterPropertyHelper(@TCustomSynEditLineHeight_R,nil,'LineHeight'); + RegisterPropertyHelper(@TCustomSynEditLinesInWindow_R,nil,'LinesInWindow'); + RegisterPropertyHelper(@TCustomSynEditLineText_R,@TCustomSynEditLineText_W,'LineText'); + RegisterPropertyHelper(@TCustomSynEditLines_R,@TCustomSynEditLines_W,'Lines'); + RegisterPropertyHelper(@TCustomSynEditMarks_R,nil,'Marks'); + RegisterPropertyHelper(@TCustomSynEditMaxScrollWidth_R,@TCustomSynEditMaxScrollWidth_W,'MaxScrollWidth'); + RegisterPropertyHelper(@TCustomSynEditModified_R,@TCustomSynEditModified_W,'Modified'); + RegisterPropertyHelper(@TCustomSynEditPaintLock_R,nil,'PaintLock'); + RegisterPropertyHelper(@TCustomSynEditReadOnly_R,@TCustomSynEditReadOnly_W,'ReadOnly'); + RegisterPropertyHelper(@TCustomSynEditSearchEngine_R,@TCustomSynEditSearchEngine_W,'SearchEngine'); + RegisterPropertyHelper(@TCustomSynEditSelAvail_R,nil,'SelAvail'); + RegisterPropertyHelper(@TCustomSynEditSelLength_R,@TCustomSynEditSelLength_W,'SelLength'); + RegisterPropertyHelper(@TCustomSynEditSelTabBlock_R,nil,'SelTabBlock'); + RegisterPropertyHelper(@TCustomSynEditSelTabLine_R,nil,'SelTabLine'); + RegisterPropertyHelper(@TCustomSynEditSelText_R,@TCustomSynEditSelText_W,'SelText'); + RegisterPropertyHelper(@TCustomSynEditStateFlags_R,nil,'StateFlags'); + RegisterPropertyHelper(@TCustomSynEditText_R,@TCustomSynEditText_W,'Text'); + RegisterPropertyHelper(@TCustomSynEditTopLine_R,@TCustomSynEditTopLine_W,'TopLine'); + RegisterPropertyHelper(@TCustomSynEditWordAtCursor_R,nil,'WordAtCursor'); + RegisterPropertyHelper(@TCustomSynEditWordAtMouse_R,nil,'WordAtMouse'); + RegisterPropertyHelper(@TCustomSynEditUndoList_R,nil,'UndoList'); + RegisterPropertyHelper(@TCustomSynEditRedoList_R,nil,'RedoList'); + RegisterPropertyHelper(@TCustomSynEditOnProcessCommand_R,@TCustomSynEditOnProcessCommand_W,'OnProcessCommand'); + {$IF CompilerVersion >= 23} + RegisterPropertyHelper(@TCustomSynEditCodeFolding_R,@TCustomSynEditCodeFolding_W,'CodeFolding'); + RegisterPropertyHelper(@TCustomSynEditUseCodeFolding_R,@TCustomSynEditUseCodeFolding_W,'UseCodeFolding'); + RegisterPropertyHelper(@TCustomSynEditAllFoldRanges_R,nil,'AllFoldRanges'); + {$IFEND} + RegisterPropertyHelper(@TCustomSynEditBookMarkOptions_R,@TCustomSynEditBookMarkOptions_W,'BookMarkOptions'); + RegisterPropertyHelper(@TCustomSynEditBorderStyle_R,@TCustomSynEditBorderStyle_W,'BorderStyle'); + RegisterPropertyHelper(@TCustomSynEditExtraLineSpacing_R,@TCustomSynEditExtraLineSpacing_W,'ExtraLineSpacing'); + RegisterPropertyHelper(@TCustomSynEditGutter_R,@TCustomSynEditGutter_W,'Gutter'); + RegisterPropertyHelper(@TCustomSynEditHideSelection_R,@TCustomSynEditHideSelection_W,'HideSelection'); + RegisterPropertyHelper(@TCustomSynEditInsertCaret_R,@TCustomSynEditInsertCaret_W,'InsertCaret'); + RegisterPropertyHelper(@TCustomSynEditInsertMode_R,@TCustomSynEditInsertMode_W,'InsertMode'); + RegisterPropertyHelper(@TCustomSynEditIsScrolling_R,nil,'IsScrolling'); + RegisterPropertyHelper(@TCustomSynEditKeystrokes_R,@TCustomSynEditKeystrokes_W,'Keystrokes'); + RegisterPropertyHelper(@TCustomSynEditMaxUndo_R,@TCustomSynEditMaxUndo_W,'MaxUndo'); + RegisterPropertyHelper(@TCustomSynEditOptions_R,@TCustomSynEditOptions_W,'Options'); + RegisterPropertyHelper(@TCustomSynEditOverwriteCaret_R,@TCustomSynEditOverwriteCaret_W,'OverwriteCaret'); + RegisterPropertyHelper(@TCustomSynEditRightEdge_R,@TCustomSynEditRightEdge_W,'RightEdge'); + RegisterPropertyHelper(@TCustomSynEditRightEdgeColor_R,@TCustomSynEditRightEdgeColor_W,'RightEdgeColor'); + RegisterPropertyHelper(@TCustomSynEditScrollHintColor_R,@TCustomSynEditScrollHintColor_W,'ScrollHintColor'); + RegisterPropertyHelper(@TCustomSynEditScrollHintFormat_R,@TCustomSynEditScrollHintFormat_W,'ScrollHintFormat'); + RegisterPropertyHelper(@TCustomSynEditScrollBars_R,@TCustomSynEditScrollBars_W,'ScrollBars'); + RegisterPropertyHelper(@TCustomSynEditSelectedColor_R,@TCustomSynEditSelectedColor_W,'SelectedColor'); + RegisterPropertyHelper(@TCustomSynEditSelectionMode_R,@TCustomSynEditSelectionMode_W,'SelectionMode'); + RegisterPropertyHelper(@TCustomSynEditActiveSelectionMode_R,@TCustomSynEditActiveSelectionMode_W,'ActiveSelectionMode'); + RegisterPropertyHelper(@TCustomSynEditTabWidth_R,@TCustomSynEditTabWidth_W,'TabWidth'); + RegisterPropertyHelper(@TCustomSynEditWantReturns_R,@TCustomSynEditWantReturns_W,'WantReturns'); + RegisterPropertyHelper(@TCustomSynEditWantTabs_R,@TCustomSynEditWantTabs_W,'WantTabs'); + RegisterPropertyHelper(@TCustomSynEditWordWrap_R,@TCustomSynEditWordWrap_W,'WordWrap'); + RegisterPropertyHelper(@TCustomSynEditWordWrapGlyph_R,@TCustomSynEditWordWrapGlyph_W,'WordWrapGlyph'); + RegisterPropertyHelper(@TCustomSynEditOnChange_R,@TCustomSynEditOnChange_W,'OnChange'); + RegisterPropertyHelper(@TCustomSynEditOnClearBookmark_R,@TCustomSynEditOnClearBookmark_W,'OnClearBookmark'); + RegisterPropertyHelper(@TCustomSynEditOnCommandProcessed_R,@TCustomSynEditOnCommandProcessed_W,'OnCommandProcessed'); + RegisterPropertyHelper(@TCustomSynEditOnContextHelp_R,@TCustomSynEditOnContextHelp_W,'OnContextHelp'); + RegisterPropertyHelper(@TCustomSynEditOnDropFiles_R,@TCustomSynEditOnDropFiles_W,'OnDropFiles'); + RegisterPropertyHelper(@TCustomSynEditOnGutterClick_R,@TCustomSynEditOnGutterClick_W,'OnGutterClick'); + RegisterPropertyHelper(@TCustomSynEditOnGutterGetText_R,@TCustomSynEditOnGutterGetText_W,'OnGutterGetText'); + RegisterPropertyHelper(@TCustomSynEditOnGutterPaint_R,@TCustomSynEditOnGutterPaint_W,'OnGutterPaint'); + RegisterPropertyHelper(@TCustomSynEditOnMouseCursor_R,@TCustomSynEditOnMouseCursor_W,'OnMouseCursor'); + RegisterPropertyHelper(@TCustomSynEditOnKeyPress_R,@TCustomSynEditOnKeyPress_W,'OnKeyPress'); + RegisterPropertyHelper(@TCustomSynEditOnPaint_R,@TCustomSynEditOnPaint_W,'OnPaint'); + RegisterPropertyHelper(@TCustomSynEditOnPlaceBookmark_R,@TCustomSynEditOnPlaceBookmark_W,'OnPlaceBookmark'); + RegisterPropertyHelper(@TCustomSynEditOnProcessUserCommand_R,@TCustomSynEditOnProcessUserCommand_W,'OnProcessUserCommand'); + RegisterPropertyHelper(@TCustomSynEditOnReplaceText_R,@TCustomSynEditOnReplaceText_W,'OnReplaceText'); + RegisterPropertyHelper(@TCustomSynEditOnSpecialLineColors_R,@TCustomSynEditOnSpecialLineColors_W,'OnSpecialLineColors'); + RegisterPropertyHelper(@TCustomSynEditOnSpecialTokenAttributes_R,@TCustomSynEditOnSpecialTokenAttributes_W,'OnSpecialTokenAttributes'); + RegisterPropertyHelper(@TCustomSynEditOnStatusChange_R,@TCustomSynEditOnStatusChange_W,'OnStatusChange'); + RegisterPropertyHelper(@TCustomSynEditOnPaintTransient_R,@TCustomSynEditOnPaintTransient_W,'OnPaintTransient'); + RegisterPropertyHelper(@TCustomSynEditOnScroll_R,@TCustomSynEditOnScroll_W,'OnScroll'); + RegisterPropertyHelper(@TCustomSynEditOnTokenHint_R,@TCustomSynEditOnTokenHint_W,'OnTokenHint'); + {$IF CompilerVersion >= 23} + RegisterPropertyHelper(@TCustomSynEditOnScanForFoldRanges_R,@TCustomSynEditOnScanForFoldRanges_W,'OnScanForFoldRanges'); + {$IFEND} + RegisterPropertyHelper(@TCustomSynEditOnSearchNotFound_R,@TCustomSynEditOnSearchNotFound_W,'OnSearchNotFound'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TSynEditPlugin(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TSynEditPlugin) do + begin + RegisterConstructor(@TSynEditPlugin.Create, 'Create'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TSynEditMarkList(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TSynEditMarkList) do + begin + RegisterConstructor(@TSynEditMarkList.Create, 'Create'); + RegisterMethod(@TSynEditMarkList.First, 'First'); + RegisterMethod(@TSynEditMarkList.Last, 'Last'); + RegisterMethod(@TSynEditMarkList.Extract, 'Extract'); + RegisterMethod(@TSynEditMarkList.ClearLine, 'ClearLine'); + RegisterMethod(@TSynEditMarkList.GetMarksForLine, 'GetMarksForLine'); + RegisterMethod(@TSynEditMarkList.Place, 'Place'); + RegisterPropertyHelper(@TSynEditMarkListItems_R,@TSynEditMarkListItems_W,'Items'); + RegisterPropertyHelper(@TSynEditMarkListEdit_R,nil,'Edit'); + RegisterPropertyHelper(@TSynEditMarkListOnChange_R,@TSynEditMarkListOnChange_W,'OnChange'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_TSynEditMark(CL: TPSRuntimeClassImporter); +begin + with CL.Add(TSynEditMark) do + begin + RegisterConstructor(@TSynEditMark.Create, 'Create'); + RegisterPropertyHelper(@TSynEditMarkLine_R,@TSynEditMarkLine_W,'Line'); + RegisterPropertyHelper(@TSynEditMarkChar_R,@TSynEditMarkChar_W,'Char'); + RegisterPropertyHelper(@TSynEditMarkEdit_R,nil,'Edit'); + RegisterPropertyHelper(@TSynEditMarkImageIndex_R,@TSynEditMarkImageIndex_W,'ImageIndex'); + RegisterPropertyHelper(@TSynEditMarkBookmarkNumber_R,@TSynEditMarkBookmarkNumber_W,'BookmarkNumber'); + RegisterPropertyHelper(@TSynEditMarkVisible_R,@TSynEditMarkVisible_W,'Visible'); + RegisterPropertyHelper(@TSynEditMarkInternalImage_R,@TSynEditMarkInternalImage_W,'InternalImage'); + RegisterPropertyHelper(@TSynEditMarkIsBookmark_R,nil,'IsBookmark'); + end; +end; + +(*----------------------------------------------------------------------------*) +procedure RIRegister_SynEdit(CL: TPSRuntimeClassImporter); +begin +// with CL.Add(ESynEditError) do + with CL.Add(TCustomSynEdit) do + RIRegister_TSynEditMark(CL); + RIRegister_TSynEditMarkList(CL); + RIRegister_TSynEditPlugin(CL); + RIRegister_TCustomSynEdit(CL); + RIRegister_TSynEdit(CL); +end; + + + +{ TPSImport_SynEdit } +(*----------------------------------------------------------------------------*) +procedure TPSImport_SynEdit.CompileImport1(CompExec: TPSScript); +begin + SIRegister_SynEdit(CompExec.Comp); +end; +(*----------------------------------------------------------------------------*) +procedure TPSImport_SynEdit.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); +begin + RIRegister_SynEdit(ri); +end; +(*----------------------------------------------------------------------------*) + + +end. diff --git a/Source/uPSPreProcessor.pas b/Source/uPSPreProcessor.pas index 54230698..6b3c9874 100644 --- a/Source/uPSPreProcessor.pas +++ b/Source/uPSPreProcessor.pas @@ -3,6 +3,11 @@ {$I PascalScript.inc} interface + +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CODE OFF} +{$WARN UNSAFE_CAST OFF} + uses Classes, SysUtils, uPSCompiler, uPSUtils; @@ -98,6 +103,7 @@ TPSPreProcessor = class(TObject) FMainFile: tbtstring; FOnProcessDirective: TPSOnProcessDirective; FOnProcessUnknowDirective: TPSOnProcessDirective; + fCompiler : TPSPascalCompiler; procedure ParserNewLine(Sender: TPSPascalPreProcessorParser; Row, Col, Pos: Cardinal); procedure IntPreProcess(Level: Integer; const OrgFileName: tbtstring; FileName: tbtstring; Dest: TStream); protected @@ -110,6 +116,7 @@ TPSPreProcessor = class(TObject) property OnNeedFile: TPSOnNeedFile read FOnNeedFile write FOnNeedFile; property Defines: TStringList read FDefines write FDefines; + property Compiler : TPSPascalCompiler read fCompiler write fCompiler; property MainFile: tbtstring read FMainFile write FMainFile; @@ -205,6 +212,9 @@ TPSDefineStates = class(TObject) implementation +uses + StrUtils; + {$IFDEF DELPHI3UP } resourceString {$ELSE } @@ -214,6 +224,8 @@ implementation RPS_TooManyNestedInclude = 'Too many nested include files while processing ''%s'' from ''%s'''; RPS_IncludeNotFound = 'Unable to find file ''%s'' used from ''%s'''; RPS_DefineTooManyParameters = 'Too many parameters in ''%s'' at %d:%d'; + RPS_DefineTooLessParameters = 'Too less parameters in ''%s'' at %d:%d'; + RPS_DefineInvalidParameters = 'Invalid parameters in ''%s'' at %d:%d'; RPS_NoIfdefForEndif = 'No IFDEF for ENDIF in ''%s'' at %d:%d'; RPS_NoIfdefForElse = 'No IFDEF for ELSE in ''%s'' at %d:%d'; RPS_ElseTwice = 'Can''t use ELSE twice in ''%s'' at %d:%d'; @@ -449,6 +461,28 @@ procedure TPSPascalPreProcessorParser.Next; end; else begin + //vizit0r - added for correct handling of #10 (without #13) as linebreak + ci := FPos; + if FText[ci] in [#10,#13] then + while (FText[ci] in [#10,#13]) do + begin + if FText[ci] = #13 then + begin + inc(FRow); + if FText[ci+1] = #10 then + inc(ci); + FLastEnterPos := ci - 1; + if @FOnNewLine <> nil then FOnNewLine(Self, FRow, FPos - FLastEnterPos + 1, ci+1); + end else if FText[ci] = #10 then + begin + inc(FRow); + FLastEnterPos := ci -1 ; + if @FOnNewLine <> nil then FOnNewLine(Self, FRow, FPos - FLastEnterPos + 1, ci+1); + end; + Inc(Ci); + end + else + //end_vizit0r ci := FPos + 1; while not (FText[ci] in [#0,'{', '(', '''', '/']) do begin @@ -528,6 +562,7 @@ constructor TPSPreProcessor.Create; FCurrentDefines.Duplicates := dupIgnore; FDefineState := TPSDefineStates.Create; FMaxLevel := 20; + FCompiler := nil; doAddStdPredefines; end; @@ -558,12 +593,21 @@ procedure TPSPreProcessor.doAddStdPredefines; end; procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName: tbtstring; FileName: tbtstring; Dest: TStream); +const + sDEFINED = 'DEFINED('; + sDECLARED= 'DECLARED('; + sNOT = 'NOT'; + sAND = 'AND'; + sOR = 'OR'; + sANDNOT = 'ANDNOT'; + sORNOT = 'ORNOT'; + sCompilerVersion = 'COMPILERVERSION'; var Parser: TPSPascalPreProcessorParser; dta: tbtstring; item: TPSLineInfo; - s, name: tbtstring; - current, i: Longint; + s, ts, name: tbtstring; + current, i, j : Longint; ds: TPSDefineState; AppContinue: Boolean; ADoWrite: Boolean; @@ -654,7 +698,7 @@ procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName: tbtst //JeromeWelsh - nesting fix ADoWrite := (FCurrentDefines.IndexOf(Uppercase(s)) < 0) and FDefineState.DoWrite; FDefineState.Add.DoWrite := ADoWrite; - end else if (Name = 'ENDIF') then + end else if (Name = 'ENDIF') OR (Name = 'IFEND') then begin //- jgv remove - borland use it (sysutils.pas) //- if s <> '' then raise EPSPreProcessor.CreateFmt(RPS_DefineTooManyParameters, [Parser.Row, Parser.Col]); @@ -672,7 +716,217 @@ procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName: tbtst ds.FInElse := True; //JeromeWelsh - nesting fix ds.DoWrite := not ds.DoWrite and FDefineState.DoPrevWrite; - end + end else if (Name = 'IF') then + begin + if pos(' ', s) = 0 then raise EPSPreProcessor.CreateFmt(RPS_DefineTooLessParameters, [FileName, Parser.Row, Parser.Col]); + S := Trim( S ); + S := UpperCase( s ); + S := StringReplace( s, #32#32, #32, [ rfReplaceAll ] ); + S := StringReplace( s, ' (', '(', [ rfReplaceAll ] ); + S := StringReplace( s, '( ', '(', [ rfReplaceAll ] ); + S := StringReplace( s, ' )', ')', [ rfReplaceAll ] ); + S := StringReplace( s, ') ', ')', [ rfReplaceAll ] ); + + if ( Copy( s, 1, Length( sDEFINED ) ) = sDEFINED ) OR + ( Copy( s, 1, Length( sNOT ) + Length( sDEFINED ) ) = sNOT + sDEFINED ) OR + ( Copy( s, 1, Length( sNOT ) + Length( sDEFINED ) + 1 ) = sNOT + ' ' + sDEFINED ) then + begin + S := StringReplace( s, ' NOT', 'NOT', [ rfReplaceAll ] ); + S := StringReplace( s, 'NOT ', 'NOT', [ rfReplaceAll ] ); + + S := StringReplace( s, ' AND', 'AND', [ rfReplaceAll ] ); + S := StringReplace( s, 'AND ', 'AND', [ rfReplaceAll ] ); + S := StringReplace( s, ' OR', 'OR', [ rfReplaceAll ] ); + S := StringReplace( s, 'OR ', 'OR', [ rfReplaceAll ] ); + + ADoWrite := FDefineState.DoWrite; + ts := s; + + if ( Copy( ts, 1, Length( sNOT ) ) = sNOT ) then + begin + j := 2; + ts := Copy( ts, Length( sNOT )+1, Length( ts )-Length( sNOT ) ); + end + else + j := 0; // AND + + while ( ts <> '' ) do + begin + i := PosEx( ')', ts, Length( sDEFINED )+1 ); + if ( i = 0 ) then + begin + raise EPSPreProcessor.CreateFmt(RPS_DefineInvalidParameters, [FileName, Parser.Row, Parser.Col]); + Break; + end; + + if ( j = 0 ) then // AND + ADoWrite := (FCurrentDefines.IndexOf( Copy( ts, Length( sDefined )+1, i-Length( sDefined )-1 ) ) >= 0) and ADoWrite + else if ( j = 1 ) then // OR + ADoWrite := (FCurrentDefines.IndexOf( Copy( ts, Length( sDefined )+1, i-Length( sDefined )-1 ) ) >= 0) OR ADoWrite + else if ( j = 2 ) then // (AND) NOT + ADoWrite := (FCurrentDefines.IndexOf( Copy( ts, Length( sDefined )+1, i-Length( sDefined )-1 ) ) < 0) AND ADoWrite + else if ( j = 3 ) then // OR NOT + ADoWrite := (FCurrentDefines.IndexOf( Copy( ts, Length( sDefined )+1, i-Length( sDefined )-1 ) ) < 0) OR ADoWrite + else + ADoWrite := (FCurrentDefines.IndexOf( Copy( ts, Length( sDefined )+1, i-Length( sDefined )-1 ) ) >= 0) OR ADoWrite; + ts := Copy( ts, i+1, Length( ts )-i ); + + if ( Copy( ts, 1, Length( sANDNOT ) ) = sANDNOT ) then + begin + j := 2; + ts := Copy( ts, Length( sANDNOT )+1, Length( ts )-Length( sANDNOT ) ); + end + else if ( Copy( ts, 1, Length( sORNOT ) ) = sORNOT ) then + begin + j := 3; + ts := Copy( ts, Length( sORNOT )+1, Length( ts )-Length( sORNOT ) ); + end + else if ( Copy( ts, 1, Length( sAND ) ) = sAND ) then + begin + j := 0; + ts := Copy( ts, Length( sAND )+1, Length( ts )-Length( sAND ) ); + end + else if ( Copy( ts, 1, Length( sOR ) ) = sOR ) then + begin + j := 1; + ts := Copy( ts, Length( sOR )+1, Length( ts )-Length( sOR ) ); + end; + end; + + FDefineState.Add.DoWrite := ADoWrite; + end + +(* + else if Assigned( fCompiler ) AND ( Copy( s, 1, Length( sDECLARED ) ) = sDECLARED ) OR + ( Copy( s, 1, Length( sNOT ) + Length( sDECLARED ) ) = sNOT + sDECLARED ) OR + ( Copy( s, 1, Length( sNOT ) + Length( sDECLARED ) + 1 ) = sNOT + ' ' + sDECLARED ) then + begin + S := StringReplace( s, ' NOT', 'NOT', [ rfReplaceAll ] ); + S := StringReplace( s, 'NOT ', 'NOT', [ rfReplaceAll ] ); + + S := StringReplace( s, ' AND', 'AND', [ rfReplaceAll ] ); + S := StringReplace( s, 'AND ', 'AND', [ rfReplaceAll ] ); + S := StringReplace( s, ' OR', 'OR', [ rfReplaceAll ] ); + S := StringReplace( s, 'OR ', 'OR', [ rfReplaceAll ] ); + + ADoWrite := FDefineState.DoWrite; + ts := s; + + if ( Copy( ts, 1, Length( sNOT ) ) = sNOT ) then + begin + j := 2; + ts := Copy( ts, Length( sNOT )+1, Length( ts )-Length( sNOT ) ); + end + else + j := 0; // AND + + while ( ts <> '' ) do + begin + i := PosEx( ')', ts, Length( sDECLARED )+1 ); + if ( i = 0 ) then + begin + raise EPSPreProcessor.CreateFmt(RPS_DefineInvalidParameters, [FileName, Parser.Row, Parser.Col]); + Break; + end; + +// if ( fCompiler.GetConstant( Copy( ts, Length( sDECLARED )+1, i-Length( sDECLARED )-1 ) ) <> nil ) then +// k := 0 +// else + k := -1; + +// if ( k < 0 ) then +// begin +// if ( fCompiler.GetVariable( Copy( ts, Length( sDECLARED )+1, i-Length( sDECLARED )-1 ) ) <> nil ) then +// k := 0 +// end; + +// if ( k < 0 ) then +// k := fCompiler.FindProc( Copy( ts, Length( sDECLARED )+1, i-Length( sDECLARED )-1 ) ); +// if ( k < 0 ) then +// begin +// if ( fCompiler.FindType( Copy( ts, Length( sDECLARED )+1, i-Length( sDECLARED )-1 ) ) <> nil ) then +// k := 0 +// end; +// if ( k < 0 ) then +// begin +// if ( fCompiler.FindClass( Copy( ts, Length( sDECLARED )+1, i-Length( sDECLARED )-1 ) ) <> nil ) then +// k := 0 +// end; + + if ( j = 0 ) then // AND + ADoWrite := (k >= 0) and ADoWrite + else if ( j = 1 ) then // OR + ADoWrite := (k >= 0) OR ADoWrite + else if ( j = 2 ) then // (AND) NOT + ADoWrite := (k < 0) AND ADoWrite + else if ( j = 3 ) then // OR NOT + ADoWrite := (k < 0) OR ADoWrite + else + ADoWrite := (k >= 0) OR ADoWrite; + ts := Copy( ts, i+1, Length( ts )-i ); + + if ( Copy( ts, 1, Length( sANDNOT ) ) = sANDNOT ) then + begin + j := 2; + ts := Copy( ts, Length( sANDNOT )+1, Length( ts )-Length( sANDNOT ) ); + end + else if ( Copy( ts, 1, Length( sORNOT ) ) = sORNOT ) then + begin + j := 3; + ts := Copy( ts, Length( sORNOT )+1, Length( ts )-Length( sORNOT ) ); + end + else if ( Copy( ts, 1, Length( sAND ) ) = sAND ) then + begin + j := 0; + ts := Copy( ts, Length( sAND )+1, Length( ts )-Length( sAND ) ); + end + else if ( Copy( ts, 1, Length( sOR ) ) = sOR ) then + begin + j := 1; + ts := Copy( ts, Length( sOR )+1, Length( ts )-Length( sOR ) ); + end; + end; + + FDefineState.Add.DoWrite := ADoWrite; + end +*) + + else if ( Copy( s, 1, Length( sCompilerVersion ) ) = sCompilerVersion ) then + begin + S := StringReplace( s, #32, '', [ rfReplaceAll ] ); + + if ( Copy( S, 16, 2 ) = '>=' ) then + FDefineState.Add.DoWrite := ( StrToIntDef( Copy( S, 18, Length( S )-17 ), -1 ) >= CompilerVersion ) + else if ( Copy( S, 16, 2 ) = '<=' ) then + FDefineState.Add.DoWrite := ( StrToIntDef( Copy( S, 18, Length( S )-17 ), High( Integer ) ) <= CompilerVersion ) + else if ( Copy( S, 16, 1 ) = '<' ) then + FDefineState.Add.DoWrite := ( StrToIntDef( Copy( S, 17, Length( S )-16 ), High( Integer ) ) < CompilerVersion ) + else if ( Copy( S, 16, 1 ) = '>' ) then + FDefineState.Add.DoWrite := ( StrToIntDef( Copy( S, 17, Length( S )-16 ), -1 ) > CompilerVersion ) + else if ( Copy( S, 16, 1 ) = '=' ) then + FDefineState.Add.DoWrite := ( StrToIntDef( Copy( S, 17, Length( S )-16 ), -1 ) = CompilerVersion ) + else + raise EPSPreProcessor.CreateFmt(RPS_DefineInvalidParameters, [FileName, Parser.Row, Parser.Col]); + end + else + begin + If @OnProcessUnknowDirective <> Nil then begin + OnProcessUnknowDirective (Self, Parser, FDefineState.DoWrite, name, s, AppContinue); + end; + If AppContinue then + //-- end jgv + raise EPSPreProcessor.CreateFmt(RPS_UnknownCompilerDirective, [FileName, Parser.Row, Parser.Col]); + end; + + // Compatibility Dummys + end else if (Name = 'UNSAFE_TYPE') OR (Name = 'UNSAFE_CODE') OR (Name = 'UNSAFE_CAST') OR (Name = 'SYMBOL_PLATFORM') OR + (Name = 'GARBAGE') OR (Name = 'WARN') OR (Name = 'RANGECHECKS') OR (Name = 'WEAKPACKAGEUNIT') OR + (Name = 'EXTERNALSYM') OR (Name = 'NODEFINE') then + begin + SetLength(s, Length(Parser.Token)); + for i := length(s) downto 1 do + s[i] := #32; // space + end //-- 20050710_jgv custom application error process else begin @@ -681,7 +935,6 @@ procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName: tbtst end; If AppContinue then //-- end jgv - raise EPSPreProcessor.CreateFmt(RPS_UnknownCompilerDirective, [FileName, Parser.Row, Parser.Col]); end; end; diff --git a/Source/uPSR_Math.pas b/Source/uPSR_Math.pas new file mode 100644 index 00000000..4e67142d --- /dev/null +++ b/Source/uPSR_Math.pas @@ -0,0 +1,128 @@ +unit uPSR_Math; +{$I PascalScript.inc} +interface + +{$WARN UNSAFE_CODE OFF} + +uses + uPSRuntime; + +procedure RegisterMathLibrary_R(S: TPSExec); + +implementation + +uses + Math; + +procedure RegisterMathLibrary_R(S: TPSExec); +begin + S.RegisterDelphiFunction( @ArcCos, 'ArcCos', cdRegister ); + S.RegisterDelphiFunction( @ArcSin, 'ArcSin', cdRegister ); + S.RegisterDelphiFunction( @ArcTan2, 'ArcTan2', cdRegister ); + S.RegisterDelphiFunction( @SinCos, 'SinCos', cdRegister ); + S.RegisterDelphiFunction( @Tan, 'Tan', cdRegister ); + S.RegisterDelphiFunction( @Cotan, 'Cotan', cdRegister ); + S.RegisterDelphiFunction( @Secant, 'Secant', cdRegister ); + S.RegisterDelphiFunction( @Cosecant, 'Cosecant', cdRegister ); + S.RegisterDelphiFunction( @Hypot, 'Hypot', cdRegister ); + S.RegisterDelphiFunction( @Hypot, 'Hypot_', cdRegister ); + S.RegisterDelphiFunction( @RadToDeg, 'RadToDeg', cdRegister ); + S.RegisterDelphiFunction( @RadToGrad, 'RadToGrad', cdRegister ); + S.RegisterDelphiFunction( @RadToCycle, 'RadToCycle', cdRegister ); + S.RegisterDelphiFunction( @DegToRad, 'DegToRad', cdRegister ); + S.RegisterDelphiFunction( @DegToGrad, 'DegToGrad', cdRegister ); + S.RegisterDelphiFunction( @DegToCycle, 'DegToCycle', cdRegister ); + {$IF CompilerVersion >= 23} + S.RegisterDelphiFunction( @DegNormalize, 'DegNormalize', cdRegister ); + {$IFEND} + S.RegisterDelphiFunction( @GradToRad, 'GradToRad', cdRegister ); + S.RegisterDelphiFunction( @GradToDeg, 'GradToDeg', cdRegister ); + S.RegisterDelphiFunction( @GradToCycle, 'GradToCycle', cdRegister ); + S.RegisterDelphiFunction( @CycleToRad, 'CycleToRad', cdRegister ); + S.RegisterDelphiFunction( @CycleToDeg, 'CycleToDeg', cdRegister ); + S.RegisterDelphiFunction( @CycleToGrad, 'CycleToGrad', cdRegister ); + S.RegisterDelphiFunction( @Cot, 'Cot', cdRegister ); + S.RegisterDelphiFunction( @Sec, 'Sec', cdRegister ); + S.RegisterDelphiFunction( @Csc, 'Csc', cdRegister ); + S.RegisterDelphiFunction( @Cosh, 'Cosh', cdRegister ); + S.RegisterDelphiFunction( @Sinh, 'Sinh', cdRegister ); + S.RegisterDelphiFunction( @Tanh, 'Tanh', cdRegister ); + S.RegisterDelphiFunction( @CotH, 'CotH', cdRegister ); + S.RegisterDelphiFunction( @SecH, 'SecH', cdRegister ); + S.RegisterDelphiFunction( @CscH, 'CscH', cdRegister ); + S.RegisterDelphiFunction( @ArcCot, 'ArcCot', cdRegister ); + S.RegisterDelphiFunction( @ArcSec, 'ArcSec', cdRegister ); + S.RegisterDelphiFunction( @ArcCsc, 'ArcCsc', cdRegister ); + S.RegisterDelphiFunction( @ArcCosh, 'ArcCosh', cdRegister ); + S.RegisterDelphiFunction( @ArcSinh, 'ArcSinh', cdRegister ); + S.RegisterDelphiFunction( @ArcTanh, 'ArcTanh', cdRegister ); + S.RegisterDelphiFunction( @ArcCotH, 'ArcCotH', cdRegister ); + S.RegisterDelphiFunction( @ArcSecH, 'ArcSecH', cdRegister ); + S.RegisterDelphiFunction( @ArcCscH, 'ArcCscH', cdRegister ); + S.RegisterDelphiFunction( @LnXP1, 'LnXP1', cdRegister ); + S.RegisterDelphiFunction( @Log10, 'Log10', cdRegister ); + S.RegisterDelphiFunction( @Log2, 'Log2', cdRegister ); + S.RegisterDelphiFunction( @LogN, 'LogN', cdRegister ); + S.RegisterDelphiFunction( @IntPower, 'IntPower', cdRegister ); + S.RegisterDelphiFunction( @Power, 'Power', cdRegister ); + S.RegisterDelphiFunction( @Frexp, 'Frexp', cdRegister ); + S.RegisterDelphiFunction( @Ldexp, 'Ldexp', cdRegister ); + S.RegisterDelphiFunction( @Ceil, 'Ceil', cdRegister ); + S.RegisterDelphiFunction( @Floor, 'Floor', cdRegister ); + S.RegisterDelphiFunction( @Poly, 'Poly', cdRegister ); + S.RegisterDelphiFunction( @Mean, 'Mean', cdRegister ); + S.RegisterDelphiFunction( @Sum, 'Sum', cdRegister ); + S.RegisterDelphiFunction( @SumInt, 'SumInt', cdRegister ); + S.RegisterDelphiFunction( @SumOfSquares, 'SumOfSquares', cdRegister ); + S.RegisterDelphiFunction( @SumsAndSquares, 'SumsAndSquares', cdRegister ); + S.RegisterDelphiFunction( @MinValue, 'MinValue', cdRegister ); + S.RegisterDelphiFunction( @MinIntValue, 'MinIntValue', cdRegister ); + S.RegisterDelphiFunction( @Min, 'Min', cdRegister ); + S.RegisterDelphiFunction( @Min, 'MinF', cdRegister ); + S.RegisterDelphiFunction( @MaxValue, 'MaxValue', cdRegister ); + S.RegisterDelphiFunction( @MaxIntValue, 'MaxIntValue', cdRegister ); + S.RegisterDelphiFunction( @Max, 'Max', cdRegister ); + S.RegisterDelphiFunction( @Max, 'MaxF', cdRegister ); + S.RegisterDelphiFunction( @StdDev, 'StdDev', cdRegister ); + S.RegisterDelphiFunction( @MeanAndStdDev, 'MeanAndStdDev', cdRegister ); + S.RegisterDelphiFunction( @PopnStdDev, 'PopnStdDev', cdRegister ); + S.RegisterDelphiFunction( @Variance, 'Variance', cdRegister ); + S.RegisterDelphiFunction( @PopnVariance, 'PopnVariance', cdRegister ); + S.RegisterDelphiFunction( @TotalVariance, 'TotalVariance', cdRegister ); + S.RegisterDelphiFunction( @Norm, 'Norm', cdRegister ); + S.RegisterDelphiFunction( @MomentSkewKurtosis, 'MomentSkewKurtosis', cdRegister ); + S.RegisterDelphiFunction( @RandG, 'RandG', cdRegister ); + S.RegisterDelphiFunction( @IsNan, 'IsNan', cdRegister ); + S.RegisterDelphiFunction( @IsInfinite, 'IsInfinite', cdRegister ); + S.RegisterDelphiFunction( @Sign, 'Sign', cdRegister ); + S.RegisterDelphiFunction( @CompareValue, 'CompareValueF', cdRegister ); + S.RegisterDelphiFunction( @CompareValue, 'CompareValue', cdRegister ); + S.RegisterDelphiFunction( @SameValue, 'SameValueF', cdRegister ); + S.RegisterDelphiFunction( @SameValue, 'SameValue', cdRegister ); + S.RegisterDelphiFunction( @IsZero, 'IsZero', cdRegister ); + S.RegisterDelphiFunction( @IfThen, 'IfThen', cdRegister ); + {$IF CompilerVersion > 22} + S.RegisterDelphiFunction( @FMod, 'FMod', cdRegister ); + {$IFEND} + S.RegisterDelphiFunction( @RandomRange, 'RandomRange', cdRegister ); + S.RegisterDelphiFunction( @RandomFrom, 'RandomFrom', cdRegister ); + S.RegisterDelphiFunction( @InRange, 'InRange', cdRegister ); + S.RegisterDelphiFunction( @EnsureRange, 'EnsureRange', cdRegister ); + S.RegisterDelphiFunction( @DivMod, 'DivMod', cdRegister ); + S.RegisterDelphiFunction( @RoundTo, 'RoundTo', cdRegister ); + S.RegisterDelphiFunction( @SimpleRoundTo, 'SimpleRoundTo', cdRegister ); + S.RegisterDelphiFunction( @DoubleDecliningBalance, 'DoubleDecliningBalance', cdRegister ); + S.RegisterDelphiFunction( @FutureValue, 'FutureValue', cdRegister ); + S.RegisterDelphiFunction( @InterestPayment, 'InterestPayment', cdRegister ); + S.RegisterDelphiFunction( @InterestRate, 'InterestRate', cdRegister ); + S.RegisterDelphiFunction( @InternalRateOfReturn, 'InternalRateOfReturn', cdRegister ); + S.RegisterDelphiFunction( @NumberOfPeriods, 'NumberOfPeriods', cdRegister ); + S.RegisterDelphiFunction( @NetPresentValue, 'NetPresentValue', cdRegister ); + S.RegisterDelphiFunction( @Payment, 'Payment', cdRegister ); + S.RegisterDelphiFunction( @PeriodPayment, 'PeriodPayment', cdRegister ); + S.RegisterDelphiFunction( @PresentValue, 'PresentValue', cdRegister ); + S.RegisterDelphiFunction( @SLNDepreciation, 'SLNDepreciation', cdRegister ); + S.RegisterDelphiFunction( @SYDDepreciation, 'SYDDepreciation', cdRegister ); +end; + +end. diff --git a/Source/uPSR_StrUtils.pas b/Source/uPSR_StrUtils.pas new file mode 100644 index 00000000..1f33f371 --- /dev/null +++ b/Source/uPSR_StrUtils.pas @@ -0,0 +1,103 @@ +unit uPSR_StrUtils; +{$I PascalScript.inc} +interface + +{$WARN UNSAFE_CODE OFF} + +uses + uPSRuntime; + +procedure RegisterStrUtilsLibrary_R(S: TPSExec); + +implementation + +uses + StrUtils; + +procedure RegisterStrUtilsLibrary_R(S: TPSExec); +begin + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @ResemblesText, 'ResemblesText', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiResemblesText, 'AnsiResemblesText', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @ContainsText, 'ContainsText', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiContainsText, 'AnsiContainsText', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @StartsText, 'StartsText', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiStartsText, 'AnsiStartsText', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @EndsText, 'EndsText', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiEndsText, 'AnsiEndsText', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @ReplaceText, 'ReplaceText', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiReplaceText, 'AnsiReplaceText', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @MatchText, 'MatchText', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiMatchText, 'AnsiMatchText', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @IndexText, 'IndexText', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiIndexText, 'AnsiIndexText', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @ContainsStr, 'ContainsStr', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiContainsStr, 'AnsiContainsStr', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @StartsStr, 'StartsStr', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiStartsStr, 'AnsiStartsStr', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @EndsStr, 'EndsStr', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiEndsStr, 'AnsiEndsStr', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @ReplaceStr, 'ReplaceStr', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiReplaceStr, 'AnsiReplaceStr', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @MatchStr, 'MatchStr', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiMatchStr, 'AnsiMatchStr', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @IndexStr, 'IndexStr', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiIndexStr, 'AnsiIndexStr', cdRegister ); + S.RegisterDelphiFunction( @DupeString, 'DupeString', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @ReverseString, 'ReverseString', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @AnsiReverseString, 'AnsiReverseString', cdRegister ); + S.RegisterDelphiFunction( @StuffString, 'StuffString', cdRegister ); + S.RegisterDelphiFunction( @RandomFrom, 'RandomFrom', cdRegister ); + S.RegisterDelphiFunction( @IfThen, 'IfThen', cdRegister ); + {$IFDEF UNICODE} + S.RegisterDelphiFunction( @SplitString, 'SplitString', cdRegister ); + {$ENDIF UNICODE} + S.RegisterDelphiFunction( @LeftStr, 'LeftStr', cdRegister ); + S.RegisterDelphiFunction( @RightStr, 'RightStr', cdRegister ); + S.RegisterDelphiFunction( @MidStr, 'MidStr', cdRegister ); + S.RegisterDelphiFunction( @LeftBStr, 'LeftBStr', cdRegister ); + S.RegisterDelphiFunction( @RightBStr, 'RightBStr', cdRegister ); + S.RegisterDelphiFunction( @MidBStr, 'MidBStr', cdRegister ); + S.RegisterDelphiFunction( @AnsiLeftStr, 'AnsiLeftStr', cdRegister ); + S.RegisterDelphiFunction( @AnsiRightStr, 'AnsiRightStr', cdRegister ); + S.RegisterDelphiFunction( @AnsiMidStr, 'AnsiMidStr', cdRegister ); + S.RegisterDelphiFunction( @SearchBuf, 'SearchBuf', cdRegister ); + S.RegisterDelphiFunction( @PosEx, 'PosEx', cdRegister ); +// S.RegisterDelphiFunction( @Soundex, 'Soundex', cdRegister ); +// S.RegisterDelphiFunction( @SoundexInt, 'SoundexInt', cdRegister ); +// S.RegisterDelphiFunction( @DecodeSoundexInt, 'DecodeSoundexInt', cdRegister ); +// S.RegisterDelphiFunction( @SoundexWord, 'SoundexWord', cdRegister ); +// S.RegisterDelphiFunction( @DecodeSoundexWord, 'DecodeSoundexWord', cdRegister ); +// S.RegisterDelphiFunction( @SoundexSimilar, 'SoundexSimilar', cdRegister ); +// S.RegisterDelphiFunction( @SoundexCompare, 'SoundexCompare', cdRegister ); +// S.RegisterDelphiFunction( @SoundexProc, 'SoundexProc', cdRegister ); +end; + +end. diff --git a/Source/uPSR_SysUtils.pas b/Source/uPSR_SysUtils.pas new file mode 100644 index 00000000..e5e6f4e6 --- /dev/null +++ b/Source/uPSR_SysUtils.pas @@ -0,0 +1,284 @@ +unit uPSR_SysUtils; +{$I PascalScript.inc} +interface + +{$WARN UNSAFE_CODE OFF} + +uses + uPSRuntime; + +procedure RegisterSysUtilsLibrary_R(S: TPSExec); + +implementation + +uses + SysUtils; + +procedure RegisterSysUtilsLibrary_R(S: TPSExec); +begin +// s.RegisterDelphiFunction(@UpperCase, 'UpperCase', cdRegister ); + {$IF CompilerVersion >= 28} + s.RegisterDelphiFunction(@UpperCase, 'UpperCaseS', cdRegister ); + {$IFEND} +// s.RegisterDelphiFunction(@LowerCase, 'LowerCase', cdRegister ); + {$IF CompilerVersion >= 28} + s.RegisterDelphiFunction(@LowerCase, 'LowerCaseS', cdRegister ); + {$IFEND} + s.RegisterDelphiFunction(@CompareStr, 'CompareStr', cdRegister ); + {$IF CompilerVersion >= 28} + s.RegisterDelphiFunction(@CompareStr, 'CompareStrS', cdRegister ); + {$IFEND} + {$IF CompilerVersion >= 28} + s.RegisterDelphiFunction(@SameStr, 'SameStr', cdRegister ); + s.RegisterDelphiFunction(@SameStr, 'SameStrS', cdRegister ); + {$IFEND} + s.RegisterDelphiFunction(@CompareMem, 'CompareMem', cdRegister ); + s.RegisterDelphiFunction(@CompareText, 'CompareText', cdRegister ); + {$IF CompilerVersion >= 28} + s.RegisterDelphiFunction(@CompareText, 'CompareTextS', cdRegister ); + {$IFEND} + s.RegisterDelphiFunction(@SameText, 'SameText', cdRegister ); + {$IF CompilerVersion >= 28} + s.RegisterDelphiFunction(@SameText, 'SameTextS', cdRegister ); + {$IFEND} +// s.RegisterDelphiFunction(@AnsiUpperCase, 'AnsiUpperCase', cdRegister ); +// s.RegisterDelphiFunction(@AnsiLowerCase, 'AnsiLowerCase', cdRegister ); + s.RegisterDelphiFunction(@AnsiCompareStr, 'AnsiCompareStr', cdRegister ); + s.RegisterDelphiFunction(@AnsiSameStr, 'AnsiSameStr', cdRegister ); + s.RegisterDelphiFunction(@AnsiCompareText, 'AnsiCompareText', cdRegister ); + s.RegisterDelphiFunction(@AnsiSameText, 'AnsiSameText', cdRegister ); + s.RegisterDelphiFunction(@AnsiStrComp, 'AnsiStrComp', cdRegister ); + s.RegisterDelphiFunction(@AnsiStrIComp, 'AnsiStrIComp', cdRegister ); + s.RegisterDelphiFunction(@AnsiStrLComp, 'AnsiStrLComp', cdRegister ); + s.RegisterDelphiFunction(@AnsiStrLIComp, 'AnsiStrLIComp', cdRegister ); + s.RegisterDelphiFunction(@AnsiStrLower, 'AnsiStrLower', cdRegister ); + s.RegisterDelphiFunction(@AnsiStrUpper, 'AnsiStrUpper', cdRegister ); + s.RegisterDelphiFunction(@AnsiLastChar, 'AnsiLastChar', cdRegister ); + s.RegisterDelphiFunction(@AnsiStrLastChar, 'AnsiStrLastChar', cdRegister ); + s.RegisterDelphiFunction(@WideUpperCase, 'WideUpperCase', cdRegister ); + s.RegisterDelphiFunction(@WideLowerCase, 'WideLowerCase', cdRegister ); + s.RegisterDelphiFunction(@WideCompareStr, 'WideCompareStr', cdRegister ); + s.RegisterDelphiFunction(@WideSameStr, 'WideSameStr', cdRegister ); + s.RegisterDelphiFunction(@WideCompareText, 'WideCompareText', cdRegister ); + s.RegisterDelphiFunction(@WideSameText, 'WideSameText', cdRegister ); +// s.RegisterDelphiFunction(@Trim, 'Trim', cdRegister ); + s.RegisterDelphiFunction(@TrimLeft, 'TrimLeft', cdRegister ); + s.RegisterDelphiFunction(@TrimRight, 'TrimRight', cdRegister ); + s.RegisterDelphiFunction(@QuotedStr, 'QuotedStr', cdRegister ); + s.RegisterDelphiFunction(@AnsiQuotedStr, 'AnsiQuotedStr', cdRegister ); + s.RegisterDelphiFunction(@AnsiExtractQuotedStr, 'AnsiExtractQuotedStr', cdRegister ); + s.RegisterDelphiFunction(@AnsiDequotedStr, 'AnsiDequotedStr', cdRegister ); + + s.RegisterDelphiFunction(@GetCurrentDir, 'GetCurrentDir', cdRegister ); + s.RegisterDelphiFunction(@SetCurrentDir, 'SetCurrentDir', cdRegister ); + s.RegisterDelphiFunction(@CreateDir, 'CreateDir', cdRegister ); + s.RegisterDelphiFunction(@RemoveDir, 'RemoveDir', cdRegister ); + s.RegisterDelphiFunction(@StrLen, 'StrLen', cdRegister ); + s.RegisterDelphiFunction(@StrEnd, 'StrEnd', cdRegister ); + s.RegisterDelphiFunction(@StrMove, 'StrMove', cdRegister ); + s.RegisterDelphiFunction(@StrCopy, 'StrCopy', cdRegister ); + s.RegisterDelphiFunction(@StrECopy, 'StrECopy', cdRegister ); + s.RegisterDelphiFunction(@StrLCopy, 'StrLCopy', cdRegister ); + s.RegisterDelphiFunction(@StrPCopy, 'StrPCopy', cdRegister ); + s.RegisterDelphiFunction(@StrPLCopy, 'StrPLCopy', cdRegister ); + s.RegisterDelphiFunction(@StrCat, 'StrCat', cdRegister ); + s.RegisterDelphiFunction(@StrLCat, 'StrLCat', cdRegister ); + s.RegisterDelphiFunction(@StrComp, 'StrComp', cdRegister ); + s.RegisterDelphiFunction(@StrIComp, 'StrIComp', cdRegister ); + s.RegisterDelphiFunction(@StrLComp, 'StrLComp', cdRegister ); + s.RegisterDelphiFunction(@StrLIComp, 'StrLIComp', cdRegister ); + s.RegisterDelphiFunction(@StrScan, 'StrScan', cdRegister ); + s.RegisterDelphiFunction(@StrRScan, 'StrRScan', cdRegister ); + s.RegisterDelphiFunction(@StrPos, 'StrPos', cdRegister ); + s.RegisterDelphiFunction(@StrUpper, 'StrUpper', cdRegister ); + s.RegisterDelphiFunction(@StrLower, 'StrLower', cdRegister ); + s.RegisterDelphiFunction(@StrPas, 'StrPas', cdRegister ); + s.RegisterDelphiFunction(@StrAlloc, 'StrAlloc', cdRegister ); + s.RegisterDelphiFunction(@StrBufSize, 'StrBufSize', cdRegister ); + s.RegisterDelphiFunction(@StrNew, 'StrNew', cdRegister ); + s.RegisterDelphiFunction(@StrDispose, 'StrDispose', cdRegister ); + s.RegisterDelphiFunction(@Format, 'Format', cdRegister ); + s.RegisterDelphiFunction(@Format, 'FormatS', cdRegister ); + s.RegisterDelphiFunction(@FmtStr, 'FmtStr', cdRegister ); + s.RegisterDelphiFunction(@FmtStr, 'FmtStrS', cdRegister ); + s.RegisterDelphiFunction(@StrFmt, 'StrFmt', cdRegister ); + s.RegisterDelphiFunction(@StrFmt, 'StrFmtS', cdRegister ); + s.RegisterDelphiFunction(@StrLFmt, 'StrLFmt', cdRegister ); + s.RegisterDelphiFunction(@StrLFmt, 'StrLFmtS', cdRegister ); +// s.RegisterDelphiFunction(@FormatBuf, 'FormatBuf', cdRegister ); +// s.RegisterDelphiFunction(@FormatBuf, 'FormatBufS', cdRegister ); + s.RegisterDelphiFunction(@WideFormat, 'WideFormat', cdRegister ); + s.RegisterDelphiFunction(@WideFormat, 'WideFormatS', cdRegister ); + s.RegisterDelphiFunction(@WideFmtStr, 'WideFmtStr', cdRegister ); + s.RegisterDelphiFunction(@WideFmtStr, 'WideFmtStrS', cdRegister ); +// s.RegisterDelphiFunction(@WideFormatBuf, 'WideFormatBuf', cdRegister ); +// s.RegisterDelphiFunction(@WideFormatBuf, 'WideFormatBufS', cdRegister ); + + S.RegisterDelphiFunction( @Sleep, 'Sleep', cdRegister ); + S.RegisterDelphiFunction( @GetModuleName, 'GetModuleName', cdRegister ); + S.RegisterDelphiFunction( @ByteToCharLen, 'ByteToCharLen', cdRegister ); + S.RegisterDelphiFunction( @CharToByteLen, 'CharToByteLen', cdRegister ); + S.RegisterDelphiFunction( @ByteToCharIndex, 'ByteToCharIndex', cdRegister ); + S.RegisterDelphiFunction( @CharToByteIndex, 'CharToByteIndex', cdRegister ); + S.RegisterDelphiFunction( @StrCharLength, 'StrCharLength', cdRegister ); + S.RegisterDelphiFunction( @StrNextChar, 'StrNextChar', cdRegister ); + S.RegisterDelphiFunction( @CharLength, 'CharLength', cdRegister ); + S.RegisterDelphiFunction( @NextCharIndex, 'NextCharIndex', cdRegister ); + S.RegisterDelphiFunction( @IsPathDelimiter, 'IsPathDelimiter', cdRegister ); + S.RegisterDelphiFunction( @IsDelimiter, 'IsDelimiter', cdRegister ); + S.RegisterDelphiFunction( @IncludeTrailingPathDelimiter, 'IncludeTrailingPathDelimiter', cdRegister ); + S.RegisterDelphiFunction( @IncludeTrailingBackslash, 'IncludeTrailingBackslash', cdRegister ); + S.RegisterDelphiFunction( @ExcludeTrailingPathDelimiter, 'ExcludeTrailingPathDelimiter', cdRegister ); + S.RegisterDelphiFunction( @ExcludeTrailingBackslash, 'ExcludeTrailingBackslash', cdRegister ); + S.RegisterDelphiFunction( @LastDelimiter, 'LastDelimiter', cdRegister ); + S.RegisterDelphiFunction( @AnsiCompareFileName, 'AnsiCompareFileName', cdRegister ); + S.RegisterDelphiFunction( @SameFileName, 'SameFileName', cdRegister ); + S.RegisterDelphiFunction( @AnsiLowerCaseFileName, 'AnsiLowerCaseFileName', cdRegister ); + S.RegisterDelphiFunction( @AnsiUpperCaseFileName, 'AnsiUpperCaseFileName', cdRegister ); + S.RegisterDelphiFunction( @AnsiPos, 'AnsiPos', cdRegister ); + S.RegisterDelphiFunction( @AnsiStrPos, 'AnsiStrPos', cdRegister ); +// S.RegisterDelphiFunction( @AnsiStrRScan, 'AnsiStrRScan', cdRegister ); +// S.RegisterDelphiFunction( @AnsiStrScan, 'AnsiStrScan', cdRegister ); + S.RegisterDelphiFunction( @StringReplace, 'StringReplace', cdRegister ); + + S.RegisterDelphiFunction( @CheckWin32Version, 'CheckWin32Version', cdRegister ); + S.RegisterDelphiFunction( @GetFileVersion, 'GetFileVersion', cdRegister ); + {$IF CompilerVersion >= 28} + S.RegisterDelphiFunction( @GetProductVersion, 'GetProductVersion', cdRegister ); + {$IFEND} + S.RegisterDelphiFunction( @GetLocaleFormatSettings, 'GetLocaleFormatSettings', cdRegister ); + + S.RegisterDelphiFunction( @ForceDirectories, 'ForceDirectories', cdRegister ); + S.RegisterDelphiFunction( @FindFirst, 'FindFirst', cdRegister ); + S.RegisterDelphiFunction( @FindNext, 'FindNext', cdRegister ); + S.RegisterDelphiFunction( @FindClose, 'FindClose', cdRegister ); + S.RegisterDelphiFunction( @FileGetDate, 'FileGetDate', cdRegister ); + S.RegisterDelphiFunction( @FileSetDate, 'FileSetDate', cdRegister ); + S.RegisterDelphiFunction( @FileIsReadOnly, 'FileIsReadOnly', cdRegister ); + S.RegisterDelphiFunction( @FileSetReadOnly, 'FileSetReadOnly', cdRegister ); + S.RegisterDelphiFunction( @DeleteFile, 'DeleteFile', cdRegister ); + S.RegisterDelphiFunction( @RenameFile, 'RenameFile', cdRegister ); + S.RegisterDelphiFunction( @ChangeFileExt, 'ChangeFileExt', cdRegister ); + S.RegisterDelphiFunction( @ExtractFilePath, 'ExtractFilePath', cdRegister ); + S.RegisterDelphiFunction( @ExtractFileDir, 'ExtractFileDir', cdRegister ); + S.RegisterDelphiFunction( @ExtractFileDrive, 'ExtractFileDrive', cdRegister ); + S.RegisterDelphiFunction( @ExtractFileName, 'ExtractFileName', cdRegister ); + S.RegisterDelphiFunction( @ExtractFileExt, 'ExtractFileExt', cdRegister ); + S.RegisterDelphiFunction( @ExpandFileName, 'ExpandFileName', cdRegister ); + S.RegisterDelphiFunction( @ExpandFileNameCase, 'ExpandFileNameCase', cdRegister ); + S.RegisterDelphiFunction( @ExpandUNCFileName, 'ExpandUNCFileName', cdRegister ); + S.RegisterDelphiFunction( @ExtractRelativePath, 'ExtractRelativePath', cdRegister ); + + {$IF CompilerVersion >= 28} + S.RegisterDelphiFunction( @ChangeFilePath, 'ChangeFilePath', cdRegister ); + S.RegisterDelphiFunction( @GetHomePath, 'GetHomePath', cdRegister ); + {$IFEND} + S.RegisterDelphiFunction( @FileAge, 'FileAge', cdRegister ); + S.RegisterDelphiFunction( @FileExists, 'FileExists', cdRegister ); + S.RegisterDelphiFunction( @DirectoryExists, 'DirectoryExists', cdRegister ); + S.RegisterDelphiFunction( @IsValidIdent, 'IsValidIdent', cdRegister ); + + S.RegisterDelphiFunction( @StrToBool, 'StrToBool', cdRegister ); + S.RegisterDelphiFunction( @StrToBoolDef, 'StrToBoolDef', cdRegister ); + S.RegisterDelphiFunction( @TryStrToBool, 'TryStrToBool', cdRegister ); + S.RegisterDelphiFunction( @BoolToStr, 'BoolToStr', cdRegister ); + + S.RegisterDelphiFunction( @ExtractShortPathName, 'ExtractShortPathName', cdRegister ); + S.RegisterDelphiFunction( @FileSearch, 'FileSearch', cdRegister ); + S.RegisterDelphiFunction( @DiskFree, 'DiskFree', cdRegister ); + S.RegisterDelphiFunction( @DiskSize, 'DiskSize', cdRegister ); + S.RegisterDelphiFunction( @GetCurrentDir, 'GetCurrentDir', cdRegister ); +// S.RegisterDelphiFunction( @FloatToStr, 'FloatToStr', cdRegister ); + S.RegisterDelphiFunction( @FloatToStr, 'FloatToStrS', cdRegister ); + S.RegisterDelphiFunction( @CurrToStr, 'CurrToStr', cdRegister ); + S.RegisterDelphiFunction( @CurrToStr, 'CurrToStrS', cdRegister ); + S.RegisterDelphiFunction( @FloatToCurr, 'FloatToCurr', cdRegister ); + S.RegisterDelphiFunction( @TryFloatToCurr, 'TryFloatToCurr', cdRegister ); + S.RegisterDelphiFunction( @FloatToStrF, 'FloatToStrF', cdRegister ); + S.RegisterDelphiFunction( @FloatToStrF, 'FloatToStrFS', cdRegister ); + S.RegisterDelphiFunction( @CurrToStrF, 'CurrToStrF', cdRegister ); + S.RegisterDelphiFunction( @CurrToStrF, 'CurrToStrFS', cdRegister ); +// S.RegisterDelphiFunction( @FloatToText, 'FloatToText', cdRegister ); +// S.RegisterDelphiFunction( @FloatToText, 'FloatToTextS', cdRegister ); + S.RegisterDelphiFunction( @FormatFloat, 'FormatFloat', cdRegister ); + S.RegisterDelphiFunction( @FormatFloat, 'FormatFloatS', cdRegister ); + S.RegisterDelphiFunction( @FormatCurr, 'FormatCurr', cdRegister ); + S.RegisterDelphiFunction( @FormatCurr, 'FormatCurrS', cdRegister ); +// S.RegisterDelphiFunction( @FloatToTextFmt, 'FloatToTextFmt', cdRegister ); +// S.RegisterDelphiFunction( @FloatToTextFmt, 'FloatToTextFmtS', cdRegister ); +// S.RegisterDelphiFunction( @StrToFloat, 'StrToFloat', cdRegister ); + S.RegisterDelphiFunction( @StrToFloat, 'StrToFloatS', cdRegister ); + S.RegisterDelphiFunction( @StrToFloatDef, 'StrToFloatDef', cdRegister ); + S.RegisterDelphiFunction( @StrToFloatDef, 'StrToFloatDefS', cdRegister ); + S.RegisterDelphiFunction( @TryStrToFloat, 'TryStrToFloat', cdRegister ); + S.RegisterDelphiFunction( @TryStrToFloat, 'TryStrToFloatS', cdRegister ); + S.RegisterDelphiFunction( @StrToCurr, 'StrToCurr', cdRegister ); + S.RegisterDelphiFunction( @StrToCurr, 'StrToCurrS', cdRegister ); + S.RegisterDelphiFunction( @StrToCurrDef, 'StrToCurrDef', cdRegister ); + S.RegisterDelphiFunction( @StrToCurrDef, 'StrToCurrDefS', cdRegister ); + S.RegisterDelphiFunction( @TryStrToCurr, 'TryStrToCurr', cdRegister ); + S.RegisterDelphiFunction( @TryStrToCurr, 'TryStrToCurrS', cdRegister ); +// S.RegisterDelphiFunction( @FloatToDecimal, 'FloatToDecimal', cdRegister ); +// S.RegisterDelphiFunction( @TextToFloat, 'TextToFloat', cdRegister ); +// S.RegisterDelphiFunction( @TextToFloat, 'TextToFloatS', cdRegister ); + + {$IF CompilerVersion >= 28} + S.RegisterDelphiFunction( @TextToFloat, 'TextToExtended', cdRegister ); + S.RegisterDelphiFunction( @TextToFloat, 'TextToExtendedS', cdRegister ); + S.RegisterDelphiFunction( @TextToFloat, 'TextToDouble', cdRegister ); + S.RegisterDelphiFunction( @TextToFloat, 'TextToDoubleS', cdRegister ); + S.RegisterDelphiFunction( @TextToFloat, 'TextToCurrency', cdRegister ); + S.RegisterDelphiFunction( @TextToFloat, 'TextToCurrencyS', cdRegister ); +// S.RegisterDelphiFunction( @HashName, 'HashName', cdRegister ); + {$IFEND} + + S.RegisterDelphiFunction( @IntToHex, 'IntToHexD', cdRegister ); + S.RegisterDelphiFunction( @IntToHex, 'Int64ToHexD', cdRegister ); + S.RegisterDelphiFunction( @TryStrToInt, 'TryStrToInt', cdRegister ); + S.RegisterDelphiFunction( @TryStrToInt64, 'TryStrToInt64', cdRegister ); + + S.RegisterDelphiFunction( @LoadStr, 'LoadStr', cdRegister ); + S.RegisterDelphiFunction( @FmtLoadStr, 'FmtLoadStr', cdRegister ); + S.RegisterDelphiFunction( @FileOpen, 'FileOpen', cdRegister ); + S.RegisterDelphiFunction( @FileCreate, 'FileCreate', cdRegister ); + S.RegisterDelphiFunction( @FileCreate, 'FileCreateA', cdRegister ); +// S.RegisterDelphiFunction( @FileRead, 'FileRead', cdRegister ); +// S.RegisterDelphiFunction( @FileWrite, 'FileWrite', cdRegister ); + + {$IF CompilerVersion >= 28} + S.RegisterDelphiFunction( @FileRead, 'FileReadB', cdRegister ); + S.RegisterDelphiFunction( @FileWrite, 'FileWriteB', cdRegister ); + {$IFEND} + + S.RegisterDelphiFunction( @FileSeek, 'FileSeek', cdRegister ); + S.RegisterDelphiFunction( @FileClose, 'FileClose', cdRegister ); + S.RegisterDelphiFunction( @FileSetDate, 'FileSetDate', cdRegister ); + S.RegisterDelphiFunction( @FileGetAttr, 'FileGetAttr', cdRegister ); + S.RegisterDelphiFunction( @FileSetAttr, 'FileSetAttr', cdRegister ); + + {$IF CompilerVersion >= 28} + S.RegisterDelphiFunction( @IntToHex, 'ShortIntToHex', cdRegister ); + S.RegisterDelphiFunction( @IntToHex, 'ByteToHex', cdRegister ); + S.RegisterDelphiFunction( @IntToHex, 'SmallIntToHex', cdRegister ); + S.RegisterDelphiFunction( @IntToHex, 'WordToHex', cdRegister ); + S.RegisterDelphiFunction( @IntToHex, 'IntToHex', cdRegister ); + S.RegisterDelphiFunction( @IntToHex, 'CardinalToHex', cdRegister ); + S.RegisterDelphiFunction( @IntToHex, 'Int64ToHex', cdRegister ); + S.RegisterDelphiFunction( @IntToHex, 'UInt64ToHex', cdRegister ); + S.RegisterDelphiFunction( @IntToHex, 'UInt64ToHexD', cdRegister ); + S.RegisterDelphiFunction( @StrToUInt, 'StrToUInt', cdRegister ); + S.RegisterDelphiFunction( @StrToUIntDef, 'StrToUIntDef', cdRegister ); + S.RegisterDelphiFunction( @TryStrToUInt, 'TryStrToUInt', cdRegister ); + S.RegisterDelphiFunction( @StrToUInt64Def, 'StrToUInt64Def', cdRegister ); + S.RegisterDelphiFunction( @TryStrToUInt64, 'TryStrToUInt64', cdRegister ); + S.RegisterDelphiFunction( @IsRelativePath, 'IsRelativePath', cdRegister ); + S.RegisterDelphiFunction( @IsAssembly, 'IsAssembly', cdRegister ); + S.RegisterDelphiFunction( @FileCreate, 'FileCreate', cdRegister ); + S.RegisterDelphiFunction( @FileCreateSymLink, 'FileCreateSymLink', cdRegister ); + S.RegisterDelphiFunction( @FileGetSymLinkTarget, 'FileGetSymLinkTarget', cdRegister ); + S.RegisterDelphiFunction( @FileSystemAttributes, 'FileSystemAttributes', cdRegister ); + S.RegisterDelphiFunction( @FileGetDateTimeInfo, 'FileGetDateTimeInfo', cdRegister ); + {$IFEND} +end; + +end. diff --git a/Source/uPSR_comobj.pas b/Source/uPSR_comobj.pas index 0e7856f3..a9670fd3 100644 --- a/Source/uPSR_comobj.pas +++ b/Source/uPSR_comobj.pas @@ -4,6 +4,9 @@ {$I PascalScript.inc} interface + +{$WARN UNSAFE_CODE OFF} + uses uPSRuntime, uPSUtils; diff --git a/Source/uPSR_controls.pas b/Source/uPSR_controls.pas index 1d03d1a6..20a62480 100644 --- a/Source/uPSR_controls.pas +++ b/Source/uPSR_controls.pas @@ -1,4 +1,3 @@ - unit uPSR_controls; {$I PascalScript.inc} @@ -51,7 +50,7 @@ TControl_PSHelper = class helper for TControl procedure StyleElementsR( var T: TStyleElements); procedure StyleElementsW( T: TStyleElements); {$ENDIF} - {$IFDEF DELPHI26UP} + {$IFDEF DELPHI27UP} procedure StyleNameR( var T: string); procedure StyleNameW( T: string); {$ENDIF} @@ -86,7 +85,7 @@ procedure TControl_PSHelper.StyleElementsR( var T: TStyleElements); begin T := S procedure TControl_PSHelper.StyleElementsW( T: TStyleElements); begin Self.StyleElements:= T; end; {$ENDIF} -{$IFDEF DELPHI26UP} +{$IFDEF DELPHI27UP} procedure TControl_PSHelper.StyleNameR( var T: string); begin T := Self.StyleName; end; procedure TControl_PSHelper.StyleNameW( T: string); begin Self.StyleName:= T; end; {$ENDIF} @@ -116,7 +115,7 @@ procedure RIRegisterTControl(Cl: TPSRuntimeClassImporter); {$IFDEF DELPHI23UP} RegisterPropertyHelper(@TControl.StyleElementsR, @TControl.StyleElementsW, 'StyleElements'); {$ENDIF} - {$IFDEF DELPHI26UP} + {$IFDEF DELPHI27UP} RegisterPropertyHelper(@TControl.StyleNameR, @TControl.StyleNameW, 'StyleName'); {$ENDIF} @@ -172,7 +171,7 @@ procedure TControlStyleElementsR(Self: TControl; var T: TStyleElements); begin T procedure TControlStyleElementsW(Self: TControl; T: TStyleElements); begin Self.StyleElements:= T; end; {$ENDIF} -{$IFDEF DELPHI26UP} +{$IFDEF DELPHI27UP} procedure TControlStyleNameR(Self: TControl; var T: string); begin T := Self.StyleName; end; procedure TControlStyleNameW(Self: TControl; T: string); begin Self.StyleName:= T; end; {$ENDIF} @@ -202,7 +201,7 @@ procedure RIRegisterTControl(Cl: TPSRuntimeClassImporter); {$IFDEF DELPHI23UP} RegisterPropertyHelper(@TControlStyleElementsR, @TControlStyleElementsW, 'StyleElements'); {$ENDIF} - {$IFDEF DELPHI26UP} + {$IFDEF DELPHI27UP} RegisterPropertyHelper(@TControlStyleNameR, @TControlStyleNameW, 'StyleName'); {$ENDIF} diff --git a/Source/uPSR_dateutils.pas b/Source/uPSR_dateutils.pas index ce33f03a..b08d647f 100644 --- a/Source/uPSR_dateutils.pas +++ b/Source/uPSR_dateutils.pas @@ -1,16 +1,19 @@ - -unit uPSR_dateutils; +unit uPSR_DateUtils; {$I PascalScript.inc} interface -uses - SysUtils, uPSRuntime; +{$WARN UNSAFE_CODE OFF} +uses + SysUtils, uPSRuntime; procedure RegisterDateTimeLibrary_R(S: TPSExec); implementation +uses + DateUtils; + function TryEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean; begin try @@ -43,21 +46,237 @@ function UnixToDateTime(U: Int64): TDateTime; procedure RegisterDateTimeLibrary_R(S: TPSExec); begin + // SysUtils + S.RegisterDelphiFunction(@DateTimeToTimeStamp, 'DateTimeToTimeStamp', cdRegister); + S.RegisterDelphiFunction(@TimeStampToDateTime, 'TimeStampToDateTime', cdRegister); + S.RegisterDelphiFunction(@MSecsToTimeStamp, 'MSecsToTimeStamp', cdRegister); + S.RegisterDelphiFunction(@TimeStampToMSecs, 'TimeStampToMSecs', cdRegister); S.RegisterDelphiFunction(@EncodeDate, 'EncodeDate', cdRegister); S.RegisterDelphiFunction(@EncodeTime, 'EncodeTime', cdRegister); S.RegisterDelphiFunction(@TryEncodeDate, 'TryEncodeDate', cdRegister); S.RegisterDelphiFunction(@TryEncodeTime, 'TryEncodeTime', cdRegister); S.RegisterDelphiFunction(@DecodeDate, 'DecodeDate', cdRegister); + S.RegisterDelphiFunction(@DecodeDateFully, 'DecodeDateFully', cdRegister); S.RegisterDelphiFunction(@DecodeTime, 'DecodeTime', cdRegister); + + {$IFDEF MSWINDOWS} + S.RegisterDelphiFunction(@DateTimeToSystemTime, 'DateTimeToSystemTime', cdRegister); + S.RegisterDelphiFunction(@SystemTimeToDateTime, 'SystemTimeToDateTime', cdRegister); + {$IF CompilerVersion >= 28} + S.RegisterDelphiFunction(@TrySystemTimeToDateTime, 'TrySystemTimeToDateTime', cdRegister); + {$IFEND} + {$ENDIF MSWINDOWS} + S.RegisterDelphiFunction(@DayOfWeek, 'DayOfWeek', cdRegister); S.RegisterDelphiFunction(@Date, 'Date', cdRegister); S.RegisterDelphiFunction(@Time, 'Time', cdRegister); S.RegisterDelphiFunction(@Now, 'Now', cdRegister); - S.RegisterDelphiFunction(@DateTimeToUnix, 'DateTimeToUnix', cdRegister); - S.RegisterDelphiFunction(@UnixToDateTime, 'UnixToDateTime', cdRegister); + S.RegisterDelphiFunction(@CurrentYear, 'CurrentYear', cdRegister); + S.RegisterDelphiFunction(@IncMonth, 'IncMonth', cdRegister); + S.RegisterDelphiFunction(@IncAMonth, 'IncAMonth', cdRegister); + S.RegisterDelphiFunction(@ReplaceTime, 'ReplaceTime', cdRegister); + S.RegisterDelphiFunction(@ReplaceDate, 'ReplaceDate', cdRegister); + S.RegisterDelphiFunction(@IsLeapYear, 'IsLeapYear', cdRegister); S.RegisterDelphiFunction(@DateToStr, 'DateToStr', cdRegister); - S.RegisterDelphiFunction(@FormatDateTime, 'FormatDateTime', cdRegister); + S.RegisterDelphiFunction(@DateToStr, 'DateToStrS', cdRegister); + S.RegisterDelphiFunction(@TimeToStr, 'TimeToStr', cdRegister); + S.RegisterDelphiFunction(@TimeToStr, 'TimeToStrS', cdRegister); + S.RegisterDelphiFunction(@DateTimeToStr, 'DateTimeToStr', cdRegister); + S.RegisterDelphiFunction(@DateTimeToStr, 'DateTimeToStrS', cdRegister); S.RegisterDelphiFunction(@StrToDate, 'StrToDate', cdRegister); + S.RegisterDelphiFunction(@StrToDate, 'StrToDateS', cdRegister); + S.RegisterDelphiFunction(@StrToDateDef, 'StrToDateDef', cdRegister); + S.RegisterDelphiFunction(@StrToDateDef, 'StrToDateDefS', cdRegister); + S.RegisterDelphiFunction(@TryStrToDate, 'TryStrToDate', cdRegister); + S.RegisterDelphiFunction(@TryStrToDate, 'TryStrToDateS', cdRegister); + S.RegisterDelphiFunction(@StrToTime, 'StrToTime', cdRegister); + S.RegisterDelphiFunction(@StrToTime, 'StrToTimeS', cdRegister); + S.RegisterDelphiFunction(@StrToTimeDef, 'StrToTimeDef', cdRegister); + S.RegisterDelphiFunction(@StrToTimeDef, 'StrToTimeDefS', cdRegister); + S.RegisterDelphiFunction(@TryStrToTime, 'TryStrToTime', cdRegister); + S.RegisterDelphiFunction(@TryStrToTime, 'TryStrToTimeS', cdRegister); + S.RegisterDelphiFunction(@StrToDateTime, 'StrToDateTime', cdRegister); + S.RegisterDelphiFunction(@StrToDateTime, 'StrToDateTimeS', cdRegister); + S.RegisterDelphiFunction(@StrToDateTimeDef, 'StrToDateTimeDef', cdRegister); + S.RegisterDelphiFunction(@StrToDateTimeDef, 'StrToDateTimeDefS', cdRegister); + S.RegisterDelphiFunction(@TryStrToDateTime, 'TryStrToDateTime', cdRegister); + S.RegisterDelphiFunction(@TryStrToDateTime, 'TryStrToDateTimeS', cdRegister); + S.RegisterDelphiFunction(@FormatDateTime, 'FormatDateTime', cdRegister); + S.RegisterDelphiFunction(@FormatDateTime, 'FormatDateTimeS', cdRegister); + S.RegisterDelphiFunction(@DateTimeToString, 'DateTimeToString', cdRegister); + S.RegisterDelphiFunction(@DateTimeToString, 'DateTimeToStringS', cdRegister); + S.RegisterDelphiFunction(@FloatToDateTime, 'FloatToDateTime', cdRegister); + S.RegisterDelphiFunction(@TryFloatToDateTime, 'TryFloatToDateTime', cdRegister); + S.RegisterDelphiFunction(@FileDateToDateTime, 'FileDateToDateTime', cdRegister); + S.RegisterDelphiFunction(@DateTimeToFileDate, 'DateTimeToFileDate', cdRegister); + + // DateUtils + S.RegisterDelphiFunction(@DateOf, 'DateOf', cdRegister); + S.RegisterDelphiFunction(@TimeOf, 'TimeOf', cdRegister); + S.RegisterDelphiFunction(@IsInLeapYear, 'IsInLeapYear', cdRegister); + S.RegisterDelphiFunction(@IsPM, 'IsPM', cdRegister); + {$IF CompilerVersion >= 28} + S.RegisterDelphiFunction(@IsAM, 'IsAM', cdRegister); + {$IFEND} + S.RegisterDelphiFunction(@IsValidDate, 'IsValidDate', cdRegister); + S.RegisterDelphiFunction(@IsValidTime, 'IsValidTime', cdRegister); + S.RegisterDelphiFunction(@IsValidDateTime, 'IsValidDateTime', cdRegister); + S.RegisterDelphiFunction(@IsValidDateDay, 'IsValidDateDay', cdRegister); + S.RegisterDelphiFunction(@IsValidDateWeek, 'IsValidDateWeek', cdRegister); + S.RegisterDelphiFunction(@IsValidDateMonthWeek, 'IsValidDateMonthWeek', cdRegister); + S.RegisterDelphiFunction(@WeeksInYear, 'WeeksInYear', cdRegister); + S.RegisterDelphiFunction(@WeeksInAYear, 'WeeksInAYear', cdRegister); + S.RegisterDelphiFunction(@DaysInYear, 'DaysInYear', cdRegister); + S.RegisterDelphiFunction(@DaysInAYear, 'DaysInAYear', cdRegister); + S.RegisterDelphiFunction(@DaysInMonth, 'DaysInMonth', cdRegister); + S.RegisterDelphiFunction(@DaysInAMonth, 'DaysInAMonth', cdRegister); + S.RegisterDelphiFunction(@Today, 'Today', cdRegister); + S.RegisterDelphiFunction(@Yesterday, 'Yesterday', cdRegister); + S.RegisterDelphiFunction(@Tomorrow, 'Tomorrow', cdRegister); + S.RegisterDelphiFunction(@IsToday, 'IsToday', cdRegister); + S.RegisterDelphiFunction(@IsSameDay, 'IsSameDay', cdRegister); + S.RegisterDelphiFunction(@YearOf, 'YearOf', cdRegister); + S.RegisterDelphiFunction(@MonthOf, 'MonthOf', cdRegister); + S.RegisterDelphiFunction(@WeekOf, 'WeekOf', cdRegister); + S.RegisterDelphiFunction(@DayOf, 'DayOf', cdRegister); + S.RegisterDelphiFunction(@HourOf, 'HourOf', cdRegister); + S.RegisterDelphiFunction(@MinuteOf, 'MinuteOf', cdRegister); + S.RegisterDelphiFunction(@SecondOf, 'SecondOf', cdRegister); + S.RegisterDelphiFunction(@MilliSecondOf, 'MilliSecondOf', cdRegister); + S.RegisterDelphiFunction(@StartOfTheYear, 'StartOfTheYear', cdRegister); + S.RegisterDelphiFunction(@EndOfTheYear, 'EndOfTheYear', cdRegister); + S.RegisterDelphiFunction(@StartOfAYear, 'StartOfAYear', cdRegister); + S.RegisterDelphiFunction(@EndOfAYear, 'EndOfAYear', cdRegister); + S.RegisterDelphiFunction(@StartOfTheMonth, 'StartOfTheMonth', cdRegister); + S.RegisterDelphiFunction(@EndOfTheMonth, 'EndOfTheMonth', cdRegister); + S.RegisterDelphiFunction(@StartOfAMonth, 'StartOfAMonth', cdRegister); + S.RegisterDelphiFunction(@EndOfAMonth, 'EndOfAMonth', cdRegister); + S.RegisterDelphiFunction(@StartOfTheWeek, 'StartOfTheWeek', cdRegister); + S.RegisterDelphiFunction(@EndOfTheWeek, 'EndOfTheWeek', cdRegister); + S.RegisterDelphiFunction(@StartOfAWeek, 'StartOfAWeek', cdRegister); + S.RegisterDelphiFunction(@EndOfAWeek, 'EndOfAWeek', cdRegister); + S.RegisterDelphiFunction(@StartOfTheDay, 'StartOfTheDay', cdRegister); + S.RegisterDelphiFunction(@EndOfTheDay, 'EndOfTheDay', cdRegister); + S.RegisterDelphiFunction(@StartOfADay, 'StartOfADay', cdRegister); + S.RegisterDelphiFunction(@EndOfADay, 'EndOfADay', cdRegister); + S.RegisterDelphiFunction(@MonthOfTheYear, 'MonthOfTheYear', cdRegister); + S.RegisterDelphiFunction(@WeekOfTheYear, 'WeekOfTheYear', cdRegister); + S.RegisterDelphiFunction(@DayOfTheYear, 'DayOfTheYear', cdRegister); + S.RegisterDelphiFunction(@HourOfTheYear, 'HourOfTheYear', cdRegister); + S.RegisterDelphiFunction(@MinuteOfTheYear, 'MinuteOfTheYear', cdRegister); + S.RegisterDelphiFunction(@SecondOfTheYear, 'SecondOfTheYear', cdRegister); + S.RegisterDelphiFunction(@MilliSecondOfTheYear, 'MilliSecondOfTheYear', cdRegister); + S.RegisterDelphiFunction(@WeekOfTheMonth, 'WeekOfTheMonth', cdRegister); + S.RegisterDelphiFunction(@DayOfTheMonth, 'DayOfTheMonth', cdRegister); + S.RegisterDelphiFunction(@HourOfTheMonth, 'HourOfTheMonth', cdRegister); + S.RegisterDelphiFunction(@MinuteOfTheMonth, 'MinuteOfTheMonth', cdRegister); + S.RegisterDelphiFunction(@SecondOfTheMonth, 'SecondOfTheMonth', cdRegister); + S.RegisterDelphiFunction(@MilliSecondOfTheMonth, 'MilliSecondOfTheMonth', cdRegister); + S.RegisterDelphiFunction(@DayOfTheWeek, 'DayOfTheWeek', cdRegister); + S.RegisterDelphiFunction(@HourOfTheWeek, 'HourOfTheWeek', cdRegister); + S.RegisterDelphiFunction(@MinuteOfTheWeek, 'MinuteOfTheWeek', cdRegister); + S.RegisterDelphiFunction(@SecondOfTheWeek, 'SecondOfTheWeek', cdRegister); + S.RegisterDelphiFunction(@MilliSecondOfTheWeek, 'MilliSecondOfTheWeek', cdRegister); + S.RegisterDelphiFunction(@HourOfTheDay, 'HourOfTheDay', cdRegister); + S.RegisterDelphiFunction(@MinuteOfTheDay, 'MinuteOfTheDay', cdRegister); + S.RegisterDelphiFunction(@SecondOfTheDay, 'SecondOfTheDay', cdRegister); + S.RegisterDelphiFunction(@MilliSecondOfTheDay, 'MilliSecondOfTheDay', cdRegister); + S.RegisterDelphiFunction(@MinuteOfTheHour, 'MinuteOfTheHour', cdRegister); + S.RegisterDelphiFunction(@SecondOfTheHour, 'SecondOfTheHour', cdRegister); + S.RegisterDelphiFunction(@MilliSecondOfTheHour, 'MilliSecondOfTheHour', cdRegister); + S.RegisterDelphiFunction(@SecondOfTheMinute, 'SecondOfTheMinute', cdRegister); + S.RegisterDelphiFunction(@MilliSecondOfTheMinute, 'MilliSecondOfTheMinute', cdRegister); + S.RegisterDelphiFunction(@MilliSecondOfTheSecond, 'MilliSecondOfTheSecond', cdRegister); + S.RegisterDelphiFunction(@WithinPastYears, 'WithinPastYears', cdRegister); + S.RegisterDelphiFunction(@WithinPastMonths, 'WithinPastMonths', cdRegister); + S.RegisterDelphiFunction(@WithinPastWeeks, 'WithinPastWeeks', cdRegister); + S.RegisterDelphiFunction(@WithinPastDays, 'WithinPastDays', cdRegister); + S.RegisterDelphiFunction(@WithinPastHours, 'WithinPastHours', cdRegister); + S.RegisterDelphiFunction(@WithinPastMinutes, 'WithinPastMinutes', cdRegister); + S.RegisterDelphiFunction(@WithinPastSeconds, 'WithinPastSeconds', cdRegister); + S.RegisterDelphiFunction(@WithinPastMilliSeconds, 'WithinPastMilliSeconds', cdRegister); + S.RegisterDelphiFunction(@YearsBetween, 'YearsBetween', cdRegister); + S.RegisterDelphiFunction(@MonthsBetween, 'MonthsBetween', cdRegister); + S.RegisterDelphiFunction(@WeeksBetween, 'WeeksBetween', cdRegister); + S.RegisterDelphiFunction(@DaysBetween, 'DaysBetween', cdRegister); + S.RegisterDelphiFunction(@HoursBetween, 'HoursBetween', cdRegister); + S.RegisterDelphiFunction(@MinutesBetween, 'MinutesBetween', cdRegister); + S.RegisterDelphiFunction(@SecondsBetween, 'SecondsBetween', cdRegister); + S.RegisterDelphiFunction(@MilliSecondsBetween, 'MilliSecondsBetween', cdRegister); + {$IF CompilerVersion >= 28} + S.RegisterDelphiFunction(@DateTimeInRange, 'DateTimeInRange', cdRegister); + S.RegisterDelphiFunction(@DateInRange, 'DateInRange', cdRegister); + S.RegisterDelphiFunction(@TimeInRange, 'TimeInRange', cdRegister); + {$IFEND} + S.RegisterDelphiFunction(@YearSpan, 'YearSpan', cdRegister); + S.RegisterDelphiFunction(@MonthSpan, 'MonthSpan', cdRegister); + S.RegisterDelphiFunction(@WeekSpan, 'WeekSpan', cdRegister); + S.RegisterDelphiFunction(@DaySpan, 'DaySpan', cdRegister); + S.RegisterDelphiFunction(@HourSpan, 'HourSpan', cdRegister); + S.RegisterDelphiFunction(@MinuteSpan, 'MinuteSpan', cdRegister); + S.RegisterDelphiFunction(@SecondSpan, 'SecondSpan', cdRegister); + S.RegisterDelphiFunction(@MilliSecondSpan, 'MilliSecondSpan', cdRegister); + S.RegisterDelphiFunction(@IncYear, 'IncYear', cdRegister); + S.RegisterDelphiFunction(@IncWeek, 'IncWeek', cdRegister); + S.RegisterDelphiFunction(@IncDay, 'IncDay', cdRegister); + S.RegisterDelphiFunction(@IncHour, 'IncHour', cdRegister); + S.RegisterDelphiFunction(@IncMinute, 'IncMinute', cdRegister); + S.RegisterDelphiFunction(@IncSecond, 'IncSecond', cdRegister); + S.RegisterDelphiFunction(@IncMilliSecond, 'IncMilliSecond', cdRegister); + S.RegisterDelphiFunction(@EncodeDateTime, 'EncodeDateTime', cdRegister); + S.RegisterDelphiFunction(@DecodeDateTime, 'DecodeDateTime', cdRegister); + S.RegisterDelphiFunction(@EncodeDateWeek, 'EncodeDateWeek', cdRegister); + S.RegisterDelphiFunction(@DecodeDateWeek, 'DecodeDateWeek', cdRegister); + S.RegisterDelphiFunction(@EncodeDateDay, 'EncodeDateDay', cdRegister); + S.RegisterDelphiFunction(@DecodeDateDay, 'DecodeDateDay', cdRegister); + S.RegisterDelphiFunction(@EncodeDateMonthWeek, 'EncodeDateMonthWeek', cdRegister); + S.RegisterDelphiFunction(@DecodeDateMonthWeek, 'DecodeDateMonthWeek', cdRegister); + S.RegisterDelphiFunction(@TryEncodeDateTime, 'TryEncodeDateTime', cdRegister); + S.RegisterDelphiFunction(@TryEncodeDateWeek, 'TryEncodeDateWeek', cdRegister); + S.RegisterDelphiFunction(@TryEncodeDateDay, 'TryEncodeDateDay', cdRegister); + S.RegisterDelphiFunction(@TryEncodeDateMonthWeek, 'TryEncodeDateMonthWeek', cdRegister); + S.RegisterDelphiFunction(@RecodeYear, 'RecodeYear', cdRegister); + S.RegisterDelphiFunction(@RecodeMonth, 'RecodeMonth', cdRegister); + S.RegisterDelphiFunction(@RecodeDay, 'RecodeDay', cdRegister); + S.RegisterDelphiFunction(@RecodeHour, 'RecodeHour', cdRegister); + S.RegisterDelphiFunction(@RecodeMinute, 'RecodeMinute', cdRegister); + S.RegisterDelphiFunction(@RecodeSecond, 'RecodeSecond', cdRegister); + S.RegisterDelphiFunction(@RecodeMilliSecond, 'RecodeMilliSecond', cdRegister); + S.RegisterDelphiFunction(@RecodeDate, 'RecodeDate', cdRegister); + S.RegisterDelphiFunction(@RecodeTime, 'RecodeTime', cdRegister); + S.RegisterDelphiFunction(@RecodeDateTime, 'RecodeDateTime', cdRegister); + S.RegisterDelphiFunction(@TryRecodeDateTime, 'TryRecodeDateTime', cdRegister); + S.RegisterDelphiFunction(@CompareDateTime, 'CompareDateTime', cdRegister); + S.RegisterDelphiFunction(@SameDateTime, 'SameDateTime', cdRegister); + S.RegisterDelphiFunction(@CompareDate, 'CompareDate', cdRegister); + S.RegisterDelphiFunction(@SameDate, 'SameDate', cdRegister); + S.RegisterDelphiFunction(@CompareTime, 'CompareTime', cdRegister); + S.RegisterDelphiFunction(@SameTime, 'SameTime', cdRegister); + S.RegisterDelphiFunction(@NthDayOfWeek, 'NthDayOfWeek', cdRegister); + S.RegisterDelphiFunction(@DecodeDayOfWeekInMonth, 'DecodeDayOfWeekInMonth', cdRegister); + S.RegisterDelphiFunction(@EncodeDayOfWeekInMonth, 'EncodeDayOfWeekInMonth', cdRegister); + S.RegisterDelphiFunction(@TryEncodeDayOfWeekInMonth, 'TryEncodeDayOfWeekInMonth', cdRegister); + S.RegisterDelphiFunction(@InvalidDateTimeError, 'InvalidDateTimeError', cdRegister); + S.RegisterDelphiFunction(@InvalidDateWeekError, 'InvalidDateWeekError', cdRegister); + S.RegisterDelphiFunction(@InvalidDateDayError, 'InvalidDateDayError', cdRegister); + S.RegisterDelphiFunction(@InvalidDateMonthWeekError, 'InvalidDateMonthWeekError', cdRegister); + S.RegisterDelphiFunction(@InvalidDayOfWeekInMonthError, 'InvalidDayOfWeekInMonthError', cdRegister); + S.RegisterDelphiFunction(@DateTimeToJulianDate, 'DateTimeToJulianDate', cdRegister); + S.RegisterDelphiFunction(@JulianDateToDateTime, 'JulianDateToDateTime', cdRegister); + S.RegisterDelphiFunction(@TryJulianDateToDateTime, 'TryJulianDateToDateTime', cdRegister); + S.RegisterDelphiFunction(@DateTimeToModifiedJulianDate, 'DateTimeToModifiedJulianDate', cdRegister); + S.RegisterDelphiFunction(@ModifiedJulianDateToDateTime, 'ModifiedJulianDateToDateTime', cdRegister); + S.RegisterDelphiFunction(@TryModifiedJulianDateToDateTime, 'TryModifiedJulianDateToDateTime', cdRegister); + S.RegisterDelphiFunction(@DateTimeToUnix, 'DateTimeToUnix', cdRegister); + S.RegisterDelphiFunction(@UnixToDateTime, 'UnixToDateTime', cdRegister); + + {$IF CompilerVersion > 23} + S.RegisterDelphiFunction(@DateTimeToMilliseconds, 'DateTimeToMilliseconds', cdRegister); + S.RegisterDelphiFunction(@TimeToMilliseconds, 'TimeToMilliseconds', cdRegister); + S.RegisterDelphiFunction(@ISO8601ToDate, 'ISO8601ToDate', cdRegister); + S.RegisterDelphiFunction(@TryISO8601ToDate, 'TryISO8601ToDate', cdRegister); + S.RegisterDelphiFunction(@DateToISO8601, 'DateToISO8601', cdRegister); + {$IFEND} end; end. diff --git a/Source/uPSRuntime.pas b/Source/uPSRuntime.pas index 3f28be64..5e2eb121 100644 --- a/Source/uPSRuntime.pas +++ b/Source/uPSRuntime.pas @@ -8,11 +8,18 @@ } interface + +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CAST OFF} +{$WARN UNSAFE_CODE OFF} + uses - {$IFNDEF FPC} {$IFDEF DELPHI2010UP} System.Rtti,{$ENDIF} {$ENDIF} + {$IFNDEF FPC} {$IFDEF DELPHI2010UP} Types, Rtti, Generics.Collections,{$ENDIF} {$ENDIF} +// {$IFNDEF FPC} {$IFDEF DELPHI2010UP} System.Rtti,{$ENDIF} {$ENDIF} {$IFDEF FPC}{$IFDEF USEINVOKECALL}Rtti,{$ENDIF}{$ENDIF} SysUtils, uPSUtils{$IFDEF DELPHI6UP}, variants{$ENDIF} - {$IFNDEF PS_NOIDISPATCH}{$IFDEF DELPHI3UP}, ActiveX, Windows{$ELSE}, Ole2{$ENDIF}{$ENDIF}; + {$IFNDEF PS_NOIDISPATCH}{$IFDEF DELPHI3UP}, ActiveX, Windows{$ELSE}, Ole2{$ENDIF}{$ENDIF} + ; type @@ -26,7 +33,8 @@ TPSRuntimeAttribute = class; erOutOfGlobalVarsRange, erOutOfProcRange, ErOutOfRange, erOutOfStackRange, ErTypeMismatch, erUnexpectedEof, erVersionError, ErDivideByZero, ErMathError, erCouldNotCallProc, erOutofRecordRange, erOutOfMemory, erException, - erNullPointerException, erNullVariantError, erInterfaceNotSupported, erCustomError); + erNullPointerException, erNullVariantError, erInterfaceNotSupported, erCustomError, + erOutOfArrayRange); TPSStatus = (isNotLoaded, isLoaded, isRunning, isPaused); @@ -300,6 +308,9 @@ TPSTypeRec_Record = class(TPSTypeRec) VI: TPSVariant; Data: tbts64; end; +{$ENDIF} + +{$IFNDEF PS_NOUINT64} PPSVariantU64 = ^TPSVariantU64; @@ -835,6 +846,8 @@ TPSStack = class(TPSList) function GetUInt(ItemNo: Longint): Cardinal; {$IFNDEF PS_NOINT64} function GetInt64(ItemNo: Longint): Int64; +{$ENDIF} +{$IFNDEF PS_NOUINT64} function GetUInt64(ItemNo: Longint): UInt64; {$ENDIF} function GetString(ItemNo: Longint): string; // calls the native method @@ -852,6 +865,8 @@ TPSStack = class(TPSList) procedure SetUInt(ItemNo: Longint; const Data: Cardinal); {$IFNDEF PS_NOINT64} procedure SetInt64(ItemNo: Longint; const Data: Int64); +{$ENDIF} +{$IFNDEF PS_NOUINT64} procedure SetUInt64(ItemNo: Longint; const Data: UInt64); {$ENDIF} procedure SetString(ItemNo: Longint; const Data: string); @@ -907,6 +922,8 @@ function PSGetObject(Src: Pointer; aType: TPSTypeRec): TObject; function PSGetUInt(Src: Pointer; aType: TPSTypeRec): Cardinal; {$IFNDEF PS_NOINT64} function PSGetInt64(Src: Pointer; aType: TPSTypeRec): Int64; +{$ENDIF} +{$IFNDEF PS_NOUINT64} function PSGetUInt64(Src: Pointer; aType: TPSTypeRec): UInt64; {$ENDIF} function PSGetReal(Src: Pointer; aType: TPSTypeRec): Extended; @@ -923,6 +940,8 @@ procedure PSSetObject(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; Const va procedure PSSetUInt(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Cardinal); {$IFNDEF PS_NOINT64} procedure PSSetInt64(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Int64); +{$ENDIF} +{$IFNDEF PS_NOUINT64} procedure PSSetUInt64(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: UInt64); {$ENDIF} procedure PSSetReal(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Extended); @@ -942,6 +961,9 @@ function VNGetUInt(const Src: TPSVariantIFC): Cardinal; {$IFNDEF PS_NOINT64} function VNGetInt64(const Src: TPSVariantIFC): Int64; {$ENDIF} +{$IFNDEF PS_NOUINT64} +function VNGetUInt64(const Src: TPSVariantIFC): UInt64; +{$ENDIF} function VNGetReal(const Src: TPSVariantIFC): Extended; function VNGetCurrency(const Src: TPSVariantIFC): Currency; function VNGetInt(const Src: TPSVariantIFC): Longint; @@ -956,6 +978,8 @@ procedure VNSetObject(const Src: TPSVariantIFC; const Val: TObject); procedure VNSetUInt(const Src: TPSVariantIFC; const Val: Cardinal); {$IFNDEF PS_NOINT64} procedure VNSetInt64(const Src: TPSVariantIFC; const Val: Int64); +{$ENDIF} +{$IFNDEF PS_NOUINT64} procedure VNSetUInt64(const Src: TPSVariantIFC; const Val: UInt64); {$ENDIF} procedure VNSetReal(const Src: TPSVariantIFC; const Val: Extended); @@ -972,6 +996,9 @@ function VGetUInt(const Src: PIFVariant): Cardinal; {$IFNDEF PS_NOINT64} function VGetInt64(const Src: PIFVariant): Int64; {$ENDIF} +{$IFNDEF PS_NOUINT64} +function VGetUInt64(const Src: PIFVariant): UInt64; +{$ENDIF} function VGetReal(const Src: PIFVariant): Extended; function VGetCurrency(const Src: PIFVariant): Currency; function VGetInt(const Src: PIFVariant): Longint; @@ -987,6 +1014,9 @@ procedure VSetUInt(const Src: PIFVariant; const Val: Cardinal); {$IFNDEF PS_NOINT64} procedure VSetInt64(const Src: PIFVariant; const Val: Int64); {$ENDIF} +{$IFNDEF PS_NOUINT64} +procedure VSetUInt64(const Src: PIFVariant; const Val: UInt64); +{$ENDIF} procedure VSetReal(const Src: PIFVariant; const Val: Extended); procedure VSetCurrency(const Src: PIFVariant; const Val: Currency); procedure VSetInt(const Src: PIFVariant; const Val: Longint); @@ -1121,11 +1151,13 @@ function MakeWString(const s: tbtunicodestring): tbtstring; function IDispatchInvoke(Self: IDispatch; PropertySet: Boolean; const Name: tbtString; const Par: array of Variant): Variant; {$ENDIF} - implementation + uses - TypInfo {$IFDEF DELPHI3UP} - {$IFNDEF FPC}{$IFDEF MSWINDOWS} , ComObj {$ENDIF}{$ENDIF}{$ENDIF} + TypInfo + {$IFDEF DELPHI3UP} + {$IFNDEF FPC}{$IFDEF MSWINDOWS}, ComObj {$ENDIF}{$ENDIF} + {$ENDIF} {$IFDEF PS_FPC_HAS_COM}, ComObj{$ENDIF} {$IF NOT DEFINED (NEXTGEN) AND NOT DEFINED (MACOS) AND DEFINED (DELPHI_TOKYO_UP)}, AnsiStrings{$IFEND}; @@ -1570,7 +1602,7 @@ function PropertyToString(Instance: TObject; PName: tbtString): tbtString; tkEnumeration: begin Result := tbtstring(GetEnumName(pp^.PropType{$IFNDEF FPC}{$IFDEF DELPHI3UP}^{$ENDIF}{$ENDIF}, GetOrdProp(Instance, pp))); exit; end; {$IFNDEF PS_NOINT64} tkInt64: begin Result := IntToStr(GetInt64Prop(Instance, pp)); exit; end; - {$ENDIF} + {$ENDIF} tkFloat: begin Result := FloatToStr(GetFloatProp(Instance, PP)); exit; end; tkString, tkLString: begin Result := ''''+tbtString(GetStrProp(Instance, PP))+''''; exit; end; tkSet: begin Result := '[Set]'; exit; end; @@ -1608,7 +1640,7 @@ function ClassVariantInfo(const pvar: TPSVariantIFC; const PropertyName: tbtStri function PSVariantToString(const p: TPSVariantIFC; const ClassProperties: tbtString): tbtString; var i, n: Longint; - b: Boolean; + b : Boolean; begin if p.Dta = nil then begin @@ -1664,10 +1696,8 @@ function PSVariantToString(const p: TPSVariantIFC; const ClassProperties: tbtStr btWideString: Result := MakeWString(tbtwidestring(p.dta^)); btUnicodeString: Result := MakeWString(tbtUnicodeString(p.dta^)); {$ENDIF} - {$IFNDEF PS_NOINT64} - btS64: str(tbts64(p.dta^), Result); - btU64: str(tbtu64(p.dta^), Result); - {$ENDIF} + {$IFNDEF PS_NOINT64}btS64: str(tbts64(p.dta^), Result);{$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: str(tbtu64(p.dta^), Result);{$ENDIF} btStaticArray, btArray: begin Result := ''; @@ -1773,7 +1803,7 @@ procedure TPSTypeRec.CalcSize; btProcPtr: FRealSize := 3 * sizeof(Pointer); btCurrency: FrealSize := Sizeof(Currency); btPointer: FRealSize := 3 * sizeof(Pointer); // ptr, type, freewhendone - btDouble{$IFNDEF PS_NOINT64}, bts64, btU64{$ENDIF}: FrealSize := 8; + btDouble{$IFNDEF PS_NOINT64}, bts64{$ENDIF}{$IFNDEF PS_NOUINT64}, btu64{$ENDIF}: FrealSize := 8; btExtended: FrealSize := SizeOf(Extended); btReturnAddress: FrealSize := Sizeof(TBTReturnAddress); else @@ -1845,7 +1875,7 @@ procedure InitializeVariant(p: Pointer; aType: TPSTypeRec); Pointer(Pointer(IPointer(p)+(2*PointerSize))^) := nil; end; btCurrency: tbtCurrency(P^) := 0; - btDouble{$IFNDEF PS_NOINT64}, bts64, btU64{$ENDIF}: {$IFNDEF PS_NOINT64}tbtS64(P^) := 0{$ELSE}tbtdouble(p^) := 0 {$ENDIF}; + btDouble{$IFNDEF PS_NOINT64}, bts64{$ENDIF}{$IFNDEF PS_NOUINT64}, btu64{$ENDIF}: {$IFNDEF PS_NOINT64}tbtS64(P^) := 0{$ELSE}tbtdouble(p^) := 0 {$ENDIF}; btExtended: tbtExtended(p^) := 0; btVariant: Initialize(Variant(p^)); btReturnAddress:; // there is no point in initializing a return address @@ -2466,7 +2496,9 @@ function TPSExec.LoadData(const s: tbtString): Boolean; Result := False; exit; end; - btU64: if not read(PPSVariantU64(VarP)^.Data, sizeof(tbtu64)) then + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: if not read(PPSVariantU64(VarP)^.Data, sizeof(tbtu64)) then begin CMD_Err(erOutOfRange); DestroyHeapVariant(VarP); @@ -2637,7 +2669,8 @@ function TPSExec.LoadData(const s: tbtString): Boolean; end else fe := False; case currf.BaseType of - {$IFNDEF PS_NOINT64}bts64, btU64, {$ENDIF} + {$IFNDEF PS_NOINT64}bts64, {$ENDIF} + {$IFNDEF PS_NOUINT64}btu64, {$ENDIF} btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btCurrency, btExtended, btString, btPointer, btPChar, btVariant, btChar{$IFNDEF PS_NOWIDESTRING}, btUnicodeString, btWideString, btWideChar{$ENDIF}: begin @@ -3154,6 +3187,13 @@ function VNGetInt64(const Src: TPSVariantIFC): Int64; end; {$ENDIF} +{$IFNDEF PS_NOUINT64} +function VNGetUInt64(const Src: TPSVariantIFC): UInt64; +begin + Result := PSGetUInt64(Src.Dta, Src.aType); +end; +{$ENDIF} + function VNGetReal(const Src: TPSVariantIFC): Extended; begin Result := PSGetReal(Src.Dta, Src.aType); @@ -3207,7 +3247,9 @@ procedure VNSetInt64(const Src: TPSVariantIFC; const Val: Int64); begin PSSetInt64(Src.Dta, Src.aType, Dummy, Val); end; +{$ENDIF} +{$IFNDEF PS_NOINT64} procedure VNSetUInt64(const Src: TPSVariantIFC; const Val: UInt64); var Dummy: Boolean; @@ -3299,6 +3341,13 @@ function VGetInt64(const Src: PIFVariant): Int64; end; {$ENDIF} +{$IFNDEF PS_NOUINT64} +function VGetUInt64(const Src: PIFVariant): UInt64; +begin + Result := PSGetUInt64(@PPSVariantData(src).Data, src.FType); +end; +{$ENDIF} + function VGetReal(const Src: PIFVariant): Extended; begin Result := PSGetReal(@PPSVariantData(src).Data, src.FType); @@ -3360,6 +3409,15 @@ procedure VSetInt64(const Src: PIFVariant; const Val: Int64); end; {$ENDIF} +{$IFNDEF PS_NOINT64} +procedure VSetUInt64(const Src: PIFVariant; const Val: UInt64); +var + Dummy: Boolean; +begin + PSSetUInt64(@PPSVariantData(src).Data, src.FType, Dummy, Val); +end; +{$ENDIF} + procedure VSetReal(const Src: PIFVariant; const Val: Extended); var Dummy: Boolean; @@ -3460,8 +3518,10 @@ function PSGetUInt(Src: Pointer; aType: TPSTypeRec): Cardinal; btS16: Result := tbts16(src^); btU32: Result := tbtu32(src^); btS32: Result := tbts32(src^); - {$IFNDEF PS_NOINT64} +{$IFNDEF PS_NOINT64} btS64: Result := tbts64(src^); +{$ENDIF} +{$IFNDEF PS_NOUINT64} btU64: Result := tbtu64(src^); {$ENDIF} btChar: Result := Ord(tbtchar(Src^)); @@ -3515,7 +3575,6 @@ procedure PSSetObject(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; Const va end; end; - {$IFNDEF PS_NOINT64} function PSGetInt64(Src: Pointer; aType: TPSTypeRec): Int64; begin @@ -3544,7 +3603,9 @@ function PSGetInt64(Src: Pointer; aType: TPSTypeRec): Int64; else raise Exception.Create(RPS_TypeMismatch); end; end; +{$ENDIF} +{$IFNDEF PS_NOUINT64} function PSGetUInt64(Src: Pointer; aType: TPSTypeRec): UInt64; begin if aType.BaseType = btPointer then @@ -3589,10 +3650,8 @@ function PSGetReal(Src: Pointer; aType: TPSTypeRec): Extended; btS16: Result := tbts16(src^); btU32: Result := tbtu32(src^); btS32: Result := tbts32(src^); -{$IFNDEF PS_NOINT64} - btS64: Result := tbts64(src^); - btU64: Result := tbtu64(src^); -{$ENDIF} +{$IFNDEF PS_NOINT64} btS64: Result := tbts64(src^);{$ENDIF} +{$IFNDEF PS_NOUINT64} btu64: Result := tbtu64(src^);{$ENDIF} btSingle: Result := tbtsingle(Src^); btDouble: Result := tbtdouble(Src^); btExtended: Result := tbtextended(Src^); @@ -3617,10 +3676,8 @@ function PSGetCurrency(Src: Pointer; aType: TPSTypeRec): Currency; btS16: Result := tbts16(src^); btU32: Result := tbtu32(src^); btS32: Result := tbts32(src^); - {$IFNDEF PS_NOINT64} - btS64: Result := tbts64(src^); - btU64: Result := tbtu64(src^); - {$ENDIF} +{$IFNDEF PS_NOINT64} btS64: Result := tbts64(src^);{$ENDIF} +{$IFNDEF PS_NOUINT64} btU64: Result := tbtu64(src^);{$ENDIF} btSingle: Result := tbtsingle(Src^); btDouble: Result := tbtdouble(Src^); btExtended: Result := tbtextended(Src^); @@ -3646,10 +3703,8 @@ function PSGetInt(Src: Pointer; aType: TPSTypeRec): Longint; btS16: Result := tbts16(src^); btU32: Result := tbtu32(src^); btS32: Result := tbts32(src^); -{$IFNDEF PS_NOINT64} - btS64: Result := tbts64(src^); - btU64: Result := tbtu64(src^); -{$ENDIF} +{$IFNDEF PS_NOINT64} btS64: Result := tbts64(src^);{$ENDIF} +{$IFNDEF PS_NOUINT64} btU64: Result := tbtu64(src^);{$ENDIF} btChar: Result := Ord(tbtchar(Src^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: Result := Ord(tbtwidechar(Src^));{$ENDIF} btVariant: Result := Variant(src^); @@ -3756,10 +3811,8 @@ procedure PSSetUInt(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: end; btU32: tbtu32(src^) := Val; btS32: tbts32(src^) := Val; -{$IFNDEF PS_NOINT64} - btS64: tbts64(src^) := Val; - btU64: tbtu64(src^) := Val; -{$ENDIF} +{$IFNDEF PS_NOINT64} btS64: tbts64(src^) := Val;{$ENDIF} +{$IFNDEF PS_NOUINT64} btU64: tbtu64(src^) := Val;{$ENDIF} btChar: tbtchar(Src^) := tbtChar(Val); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbtwidechar(Src^) := tbtwidechar(Val);{$ENDIF} btSingle: tbtSingle(src^) := Val; @@ -3818,47 +3871,90 @@ procedure PSSetInt64(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val else ok := false; end; end; +{$ENDIF} -procedure PSSetUInt64(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: UInt64); +{$IFNDEF PS_NOINT64} +procedure PSSetuInt64(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: UInt64); begin if (Src = nil) or (aType = nil) then begin Ok := false; exit; end; if aType.BaseType = btPointer then begin - aType := PIFTypeRec(Pointer(IPointer(Src)+PointerSize)^); + atype := PIFTypeRec(Pointer(IPointer(Src)+PointerSize)^); Src := Pointer(Src^); - if (Src = nil) or (aType = nil) then begin Ok := false; exit; end; + if (src = nil) or (aType = nil) then begin Ok := false; exit; end; end; case aType.BaseType of - btU8: tbtu8(Src^) := Val; - btS8: tbts8(Src^) := Val; - btU16: tbtu16(Src^) := Val; - btS16: tbts16(Src^) := Val; - btU32: tbtu32(Src^) := Val; - btS32: tbts32(Src^) := Val; - btS64: tbts64(Src^) := Val; - btU64: tbtu64(Src^) := Val; + btU8: tbtu8(src^) := Val; + btS8: tbts8(src^) := Val; + btU16: tbtu16(src^) := Val; + btS16: tbts16(src^) := Val; + btU32: tbtu32(src^) := Val; + btS32: tbts32(src^) := Val; + btS64: tbts64(src^) := Val; + btU64: tbtu64(src^) := Val; btChar: tbtchar(Src^) := tbtChar(Val); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbtwidechar(Src^) := tbtwidechar(Val); {$ENDIF} - btSingle: tbtSingle(Src^) := Val; - btDouble: tbtDouble(Src^) := Val; - btCurrency: tbtCurrency(Src^) := Val; - btExtended: tbtExtended(Src^) := Val; + btSingle: tbtSingle(src^) := Val; + btDouble: tbtDouble(src^) := Val; + btCurrency: tbtCurrency(src^) := Val; + btExtended: tbtExtended(src^) := Val; {$IFDEF DELPHI6UP} btVariant: begin try - Variant(Src^) := Val; + Variant(src^) := Val; except Ok := false; end; end; {$ENDIF} - else Ok := false; + else ok := false; end; end; +{$ENDIF} +{$IFNDEF PS_NOUINT64} +procedure PSSetuUInt64(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: UInt64); +begin + if (Src = nil) or (aType = nil) then begin Ok := false; exit; end; + if aType.BaseType = btPointer then + begin + atype := PIFTypeRec(Pointer(IPointer(Src)+PointerSize)^); + Src := Pointer(Src^); + if (src = nil) or (aType = nil) then begin Ok := false; exit; end; + end; + case aType.BaseType of + btU8: tbtu8(src^) := Val; + btS8: tbts8(src^) := Val; + btU16: tbtu16(src^) := Val; + btS16: tbts16(src^) := Val; + btU32: tbtu32(src^) := Val; + btS32: tbts32(src^) := Val; + btS64: tbts64(src^) := Val; + btU64: tbtu64(src^) := Val; + btChar: tbtchar(Src^) := tbtChar(Val); +{$IFNDEF PS_NOWIDESTRING} + btWideChar: tbtwidechar(Src^) := tbtwidechar(Val); +{$ENDIF} + btSingle: tbtSingle(src^) := Val; + btDouble: tbtDouble(src^) := Val; + btCurrency: tbtCurrency(src^) := Val; + btExtended: tbtExtended(src^) := Val; +{$IFDEF DELPHI6UP} + btVariant: + begin + try + Variant(src^) := Val; + except + Ok := false; + end; + end; +{$ENDIF} + else ok := false; + end; +end; {$ENDIF} procedure PSSetReal(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Extended); @@ -3935,10 +4031,8 @@ procedure PSSetInt(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: end; btU32: tbtu32(src^) := Val; btS32: tbts32(src^) := Val; -{$IFNDEF PS_NOINT64} - btS64: tbts64(src^) := Val; - btU64: tbtu64(src^) := Val; -{$ENDIF} +{$IFNDEF PS_NOINT64} btS64: tbts64(src^) := Val;{$ENDIF} +{$IFNDEF PS_NOUINT64} btU64: tbtu64(src^) := Val;{$ENDIF} btChar: tbtchar(Src^) := tbtChar(Val); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbtwidechar(Src^) := tbtwidechar(Val);{$ENDIF} btSingle: tbtSingle(src^) := Val; @@ -4164,7 +4258,9 @@ function CopyArrayContents(dest, src: Pointer; Len: Longint; aType: TPSTypeRec): Dest := Pointer(IPointer(Dest) + 8); Src := Pointer(IPointer(Src) + 8); end; - btU64: + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: for i := 0 to Len -1 do begin tbtu64(Dest^) := tbtu64(Src^); @@ -4586,10 +4682,8 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR btS16: tbtu32(Dest^) := tbts16(src^); btU32: tbtu32(Dest^) := tbtu32(src^); btS32: tbtu32(Dest^) := tbts32(src^); - {$IFNDEF PS_NOINT64} - btS64: tbtu32(Dest^) := tbts64(src^); - btU64: tbtu32(Dest^) := tbtu64(src^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtu32(Dest^) := tbts64(src^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtu32(Dest^) := tbtu64(src^);{$ENDIF} btChar: tbtu32(Dest^) := Ord(tbtchar(Src^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbtu32(Dest^) := Ord(tbtwidechar(Src^));{$ENDIF} btVariant: tbtu32(Dest^) := Variant(src^); @@ -4615,10 +4709,8 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR btS16: tbts32(Dest^) := tbts16(src^); btU32: tbts32(Dest^) := tbtu32(src^); btS32: tbts32(Dest^) := tbts32(src^); - {$IFNDEF PS_NOINT64} - btS64: tbts32(Dest^) := tbts64(src^); - btU64: tbts32(Dest^) := tbtu64(src^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbts32(Dest^) := tbts64(src^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbts32(Dest^) := tbtu64(src^);{$ENDIF} btChar: tbts32(Dest^) := Ord(tbtchar(Src^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbts32(Dest^) := Ord(tbtwidechar(Src^));{$ENDIF} btVariant: tbts32(Dest^) := Variant(src^); @@ -4658,6 +4750,8 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR else raise Exception.Create(RPS_TypeMismatch); end; end; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: begin if srctype.BaseType = btPointer then @@ -4701,10 +4795,8 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR btS16: tbtsingle(Dest^) := tbts16(src^); btU32: tbtsingle(Dest^) := tbtu32(src^); btS32: tbtsingle(Dest^) := tbts32(src^); - {$IFNDEF PS_NOINT64} - btS64: tbtsingle(Dest^) := tbts64(src^); - btU64: tbtsingle(Dest^) := tbtu64(src^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtsingle(Dest^) := tbts64(src^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtsingle(Dest^) := tbtu64(src^);{$ENDIF} btSingle: tbtsingle(Dest^) := tbtsingle(Src^); btDouble: tbtsingle(Dest^) := tbtdouble(Src^); btExtended: tbtsingle(Dest^) := tbtextended(Src^); @@ -4728,10 +4820,8 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR btS16: tbtdouble(Dest^) := tbts16(src^); btU32: tbtdouble(Dest^) := tbtu32(src^); btS32: tbtdouble(Dest^) := tbts32(src^); - {$IFNDEF PS_NOINT64} - btS64: tbtdouble(Dest^) := tbts64(src^); - btU64: tbtdouble(Dest^) := tbtu64(src^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtdouble(Dest^) := tbts64(src^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtdouble(Dest^) := tbtu64(src^);{$ENDIF} btSingle: tbtdouble(Dest^) := tbtsingle(Src^); btDouble: tbtdouble(Dest^) := tbtdouble(Src^); btExtended: tbtdouble(Dest^) := tbtextended(Src^); @@ -4756,10 +4846,8 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR btS16: tbtextended(Dest^) := tbts16(src^); btU32: tbtextended(Dest^) := tbtu32(src^); btS32: tbtextended(Dest^) := tbts32(src^); - {$IFNDEF PS_NOINT64} - btS64: tbtextended(Dest^) := tbts64(src^); - btU64: tbtextended(Dest^) := tbtu64(src^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtextended(Dest^) := tbts64(src^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtextended(Dest^) := tbtu64(src^);{$ENDIF} btSingle: tbtextended(Dest^) := tbtsingle(Src^); btDouble: tbtextended(Dest^) := tbtdouble(Src^); btExtended: tbtextended(Dest^) := tbtextended(Src^); @@ -5052,10 +5140,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btDouble: b := PSGetReal(Var1, var1type) >= tbtdouble(var2^); btSingle: B := psGetReal(Var1, var1Type) >= tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) >= tbtExtended(var2^); - {$IFNDEF PS_NOINT64} - btS64: b := tbts32(var1^) >= tbts64(Var2^); - btU64: b := tbts32(var1^) >= tbtu64(Var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: b := tbts32(var1^) >= tbts64(Var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: b := tbts32(var1^) >= tbtu64(Var2^);{$ENDIF} btChar: b := tbts32(var1^) >= Ord(tbtchar(Var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: b := tbts32(var1^) >= Ord(tbtwidechar(Var2^));{$ENDIF} btVariant: b := tbts32(var1^) >= Variant(Var2^); @@ -5068,6 +5154,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btExtended: b := tbtextended(var1^) >= PSGetReal(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: b := tbts64(var1^) >= PSGetInt64(Var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: b := tbtu64(var1^) >= PSGetUInt64(Var2, var2type); {$ENDIF} btPChar,btString: b := tbtstring(var1^) >= PSGetAnsiString(Var2, var2type); @@ -5132,10 +5220,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btDouble: b := PSGetReal(Var1, var1type) <= tbtdouble(var2^); btSingle: B := psGetReal(Var1, var1Type) <= tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) <= tbtExtended(var2^); - {$IFNDEF PS_NOINT64} - btS64: b := tbts32(var1^) <= tbts64(Var2^); - btU64: b := tbts32(var1^) <= tbtu64(Var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: b := tbts32(var1^) <= tbts64(Var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: b := tbts32(var1^) <= tbtu64(Var2^);{$ENDIF} btChar: b := tbts32(var1^) <= Ord(tbtchar(Var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: b := tbts32(var1^) <= Ord(tbtwidechar(Var2^));{$ENDIF} btVariant: b := tbts32(var1^) <= Variant(Var2^); @@ -5147,6 +5233,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btExtended: b := tbtextended(var1^) <= PSGetReal(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: b := tbts64(var1^) <= PSGetInt64(Var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: b := tbtu64(var1^) <= PSGetUInt64(Var2, var2type); {$ENDIF} btPChar,btString: b := tbtstring(var1^) <= PSGetAnsiString(Var2, var2type); @@ -5211,10 +5299,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btDouble: b := PSGetReal(Var1, var1type) > tbtdouble(var2^); btSingle: B := psGetReal(Var1, var1Type) > tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) > tbtExtended(var2^); - {$IFNDEF PS_NOINT64} - btS64: b := tbts32(var1^) > tbts64(Var2^); - btU64: b := tbts32(var1^) > tbtu64(Var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: b := tbts32(var1^) > tbts64(Var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: b := tbts32(var1^) > tbtu64(Var2^);{$ENDIF} btChar: b := tbts32(var1^) > Ord(tbtchar(Var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: b := tbts32(var1^) = Ord(tbtwidechar(Var2^));{$ENDIF} btVariant: b := tbts32(var1^) > Variant(Var2^); @@ -5226,6 +5312,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btCurrency: b := tbtcurrency(var1^) > PSGetCurrency(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: b := tbts64(var1^) > PSGetInt64(Var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOINT64} btU64: b := tbtu64(var1^) > PSGetUInt64(Var2, var2type); {$ENDIF} btPChar,btString: b := tbtstring(var1^) > PSGetAnsiString(Var2, var2type); @@ -5283,10 +5371,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btDouble: b := PSGetReal(Var1, var1type) < tbtdouble(var2^); btSingle: B := psGetReal(Var1, var1Type) < tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) < tbtExtended(var2^); - {$IFNDEF PS_NOINT64} - btS64: b := tbts32(var1^) < tbts64(Var2^); - btU64: b := tbts32(var1^) < tbtu64(Var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: b := tbts32(var1^) < tbts64(Var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: b := tbts32(var1^) < tbtu64(Var2^);{$ENDIF} btChar: b := tbts32(var1^) < Ord(tbtchar(Var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: b := tbts32(var1^) < Ord(tbtwidechar(Var2^));{$ENDIF} btVariant: b := tbts32(var1^) < Variant(Var2^); @@ -5298,6 +5384,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btExtended: b := tbtextended(var1^) < PSGetReal(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: b := tbts64(var1^) < PSGetInt64(Var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOINT64} btU64: b := tbtu64(var1^) < PSGetUInt64(Var2, var2type); {$ENDIF} btPChar,btString: b := tbtstring(var1^) < PSGetAnsiString(Var2, var2type); @@ -5380,10 +5468,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btDouble: b := PSGetReal(Var1, var1type) <> tbtdouble(var2^); btSingle: B := psGetReal(Var1, var1Type) <> tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) <> tbtExtended(var2^); - {$IFNDEF PS_NOINT64} - btS64: b := tbts32(var1^) <> tbts64(Var2^); - btU64: b := tbts32(var1^) <> tbtu64(Var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: b := tbts32(var1^) <> tbts64(Var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: b := tbts32(var1^) <> tbtu64(Var2^);{$ENDIF} btChar: b := tbts32(var1^) <> Ord(tbtchar(Var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: b := tbts32(var1^) <> Ord(tbtwidechar(Var2^));{$ENDIF} btVariant: b := tbts32(var1^) <> Variant(Var2^); @@ -5396,6 +5482,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btPChar,btString: b := tbtstring(var1^) <> PSGetAnsiString(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: b := tbts64(var1^) <> PSGetInt64(Var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: b := tbtu64(var1^) <> PSGetUInt64(Var2, var2type); {$ENDIF} btChar: b := tbtchar(var1^) <> PSGetAnsiString(Var2, var2type); @@ -5494,10 +5582,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btDouble: b := PSGetReal(Var1, var1type) = tbtdouble(var2^); btSingle: B := psGetReal(Var1, var1Type) = tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) = tbtExtended(var2^); - {$IFNDEF PS_NOINT64} - btS64: b := tbts32(var1^) = tbts64(Var2^); - btU64: b := tbts32(var1^) = tbtu64(Var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: b := tbts32(var1^) = tbts64(Var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: b := tbts32(var1^) = tbtu64(Var2^);{$ENDIF} btChar: b := tbts32(var1^) = Ord(tbtchar(Var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: b := tbts32(var1^) = Ord(tbtwidechar(Var2^));{$ENDIF} btVariant: b := tbts32(var1^) = Variant(Var2^); @@ -5510,6 +5596,8 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btPchar, btString: b := tbtstring(var1^) = PSGetAnsiString(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: b := tbts64(var1^) = PSGetInt64(Var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: b := tbtu64(var1^) = PSGetUInt64(Var2, var2type); {$ENDIF} btChar: b := tbtchar(var1^) = PSGetAnsiString(Var2, var2type); @@ -5695,10 +5783,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtU32(var1^) := tbtU32(var1^) + cardinal(longint(tbts16(var2^))); btU32: tbtU32(var1^) := tbtU32(var1^) + tbtu32(var2^); btS32: tbtU32(var1^) := tbtU32(var1^) + cardinal(tbts32(var2^)); - {$IFNDEF PS_NOINT64} - btS64: tbtU32(var1^) := tbtU32(var1^) + tbts64(var2^); - btU64: tbtU32(var1^) := tbtU32(var1^) + tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtU32(var1^) := tbtU32(var1^) + tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtU32(var1^) := tbtU32(var1^) + tbtu64(var2^);{$ENDIF} btChar: tbtU32(var1^) := tbtU32(var1^) + Ord(tbtchar(var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbtU32(var1^) := tbtU32(var1^) + Ord(tbtwidechar(var2^));{$ENDIF} btVariant: tbtU32(var1^) := tbtU32(var1^) + Variant(var2^); @@ -5720,10 +5806,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbts32(var1^) := tbts32(var1^) + tbts16(var2^); btU32: tbts32(var1^) := tbts32(var1^) + Longint(tbtu32(var2^)); btS32: tbts32(var1^) := tbts32(var1^) + tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbts32(var1^) := tbts32(var1^) + tbts64(var2^); - btU64: tbts32(var1^) := tbts32(var1^) + tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbts32(var1^) := tbts32(var1^) + tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbts32(var1^) := tbts32(var1^) + tbtu64(var2^);{$ENDIF} btChar: tbts32(var1^) := tbts32(var1^) + Ord(tbtchar(var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbts32(var1^) := tbts32(var1^) + Ord(tbtwidechar(var2^));{$ENDIF} btVariant: tbts32(var1^) := tbts32(var1^) + Variant(var2^); @@ -5732,6 +5816,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal end; {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) + PSGetInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtu64(var1^) := tbtu64(var1^) + PSGetUInt64(var2, var2type); {$ENDIF} btSingle: @@ -5749,10 +5835,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtsingle(var1^) := tbtsingle(var1^) + tbts16(var2^); btU32: tbtsingle(var1^) := tbtsingle(var1^) + tbtu32(var2^); btS32: tbtsingle(var1^) := tbtsingle(var1^) + tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtsingle(var1^) := tbtsingle(var1^) + tbts64(var2^); - btU64: tbtsingle(var1^) := tbtsingle(var1^) + tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtsingle(var1^) := tbtsingle(var1^) + tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtsingle(var1^) := tbtsingle(var1^) + tbtu64(var2^);{$ENDIF} btSingle: tbtsingle(var1^) := tbtsingle(var1^) + tbtsingle(var2^); btDouble: tbtsingle(var1^) := tbtsingle(var1^) + tbtdouble(var2^); btExtended: tbtsingle(var1^) := tbtsingle(var1^) + tbtextended(var2^); @@ -5776,10 +5860,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtdouble(var1^) := tbtdouble(var1^) + tbts16(var2^); btU32: tbtdouble(var1^) := tbtdouble(var1^) + tbtu32(var2^); btS32: tbtdouble(var1^) := tbtdouble(var1^) + tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtdouble(var1^) := tbtdouble(var1^) + tbts64(var2^); - btU64: tbtdouble(var1^) := tbtdouble(var1^) + tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtdouble(var1^) := tbtdouble(var1^) + tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtdouble(var1^) := tbtdouble(var1^) + tbtu64(var2^);{$ENDIF} btSingle: tbtdouble(var1^) := tbtdouble(var1^) + tbtsingle(var2^); btDouble: tbtdouble(var1^) := tbtdouble(var1^) + tbtdouble(var2^); btExtended: tbtdouble(var1^) := tbtdouble(var1^) + tbtextended(var2^); @@ -5803,10 +5885,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtcurrency(var1^) := tbtcurrency(var1^) + tbts16(var2^); btU32: tbtcurrency(var1^) := tbtdouble(var1^) + tbtu32(var2^); btS32: tbtcurrency(var1^) := tbtcurrency(var1^) + tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtcurrency(var1^) := tbtdouble(var1^) + tbts64(var2^); - btU64: tbtcurrency(var1^) := tbtdouble(var1^) + tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtcurrency(var1^) := tbtdouble(var1^) + tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtcurrency(var1^) := tbtdouble(var1^) + tbtu64(var2^);{$ENDIF} btSingle: tbtcurrency(var1^) := tbtcurrency(var1^) + tbtsingle(var2^); btDouble: tbtcurrency(var1^) := tbtcurrency(var1^) + tbtdouble(var2^); btExtended: tbtcurrency(var1^) := tbtcurrency(var1^) + tbtextended(var2^); @@ -5830,10 +5910,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtextended(var1^) := tbtextended(var1^) + tbts16(var2^); btU32: tbtextended(var1^) := tbtextended(var1^) + tbtu32(var2^); btS32: tbtextended(var1^) := tbtextended(var1^) + tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtextended(var1^) := tbtextended(var1^) + tbts64(var2^); - btU64: tbtextended(var1^) := tbtextended(var1^) + tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtextended(var1^) := tbtextended(var1^) + tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtextended(var1^) := tbtextended(var1^) + tbtu64(var2^);{$ENDIF} btSingle: tbtextended(var1^) := tbtextended(var1^) + tbtsingle(var2^); btDouble: tbtextended(var1^) := tbtextended(var1^) + tbtdouble(var2^); btExtended: tbtextended(var1^) := tbtextended(var1^) + tbtextended(var2^); @@ -5899,10 +5977,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtU32(var1^) := tbtU32(var1^) - cardinal(longint(tbts16(var2^))); btU32: tbtU32(var1^) := tbtU32(var1^) - tbtu32(var2^); btS32: tbtU32(var1^) := tbtU32(var1^) - cardinal(tbts32(var2^)); - {$IFNDEF PS_NOINT64} - btS64: tbtU32(var1^) := tbtU32(var1^) - tbts64(var2^); - btU64: tbtU32(var1^) := tbtU32(var1^) - tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtU32(var1^) := tbtU32(var1^) - tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtU32(var1^) := tbtU32(var1^) - tbtu64(var2^);{$ENDIF} btChar: tbtU32(var1^) := tbtU32(var1^) - Ord(tbtchar(var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbtU32(var1^) := tbtU32(var1^) - Ord(tbtwidechar(var2^));{$ENDIF} btVariant: tbtU32(var1^) := tbtU32(var1^) - Variant(var2^); @@ -5924,10 +6000,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbts32(var1^) := tbts32(var1^) - tbts16(var2^); btU32: tbts32(var1^) := tbts32(var1^) - Longint(tbtu32(var2^)); btS32: tbts32(var1^) := tbts32(var1^) - tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbts32(var1^) := tbts32(var1^) - tbts64(var2^); - btU64: tbts32(var1^) := tbts32(var1^) - tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbts32(var1^) := tbts32(var1^) - tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbts32(var1^) := tbts32(var1^) - tbtu64(var2^);{$ENDIF} btChar: tbts32(var1^) := tbts32(var1^) - Ord(tbtchar(var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbts32(var1^) := tbts32(var1^) - Ord(tbtwidechar(var2^));{$ENDIF} btVariant: tbts32(var1^) := tbts32(var1^) - Variant(var2^); @@ -5936,6 +6010,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal end; {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) - PSGetInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOINT64} btU64: tbtu64(var1^) := tbtu64(var1^) - PSGetUInt64(var2, var2type); {$ENDIF} btSingle: @@ -5953,10 +6029,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtsingle(var1^) := tbtsingle(var1^) - tbts16(var2^); btU32: tbtsingle(var1^) := tbtsingle(var1^) - tbtu32(var2^); btS32: tbtsingle(var1^) := tbtsingle(var1^) - tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtsingle(var1^) := tbtsingle(var1^) - tbts64(var2^); - btU64: tbtsingle(var1^) := tbtsingle(var1^) - tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtsingle(var1^) := tbtsingle(var1^) - tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtsingle(var1^) := tbtsingle(var1^) - tbtu64(var2^);{$ENDIF} btSingle: tbtsingle(var1^) := tbtsingle(var1^) - tbtsingle(var2^); btDouble: tbtsingle(var1^) := tbtsingle(var1^) - tbtdouble(var2^); btExtended: tbtsingle(var1^) := tbtsingle(var1^) - tbtextended(var2^); @@ -5980,10 +6054,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtcurrency(var1^) := tbtcurrency(var1^) - tbts16(var2^); btU32: tbtcurrency(var1^) := tbtdouble(var1^) - tbtu32(var2^); btS32: tbtcurrency(var1^) := tbtcurrency(var1^) - tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtcurrency(var1^) := tbtdouble(var1^) - tbts64(var2^); - btU64: tbtcurrency(var1^) := tbtdouble(var1^) - tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtcurrency(var1^) := tbtdouble(var1^) - tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtcurrency(var1^) := tbtdouble(var1^) - tbtu64(var2^);{$ENDIF} btSingle: tbtcurrency(var1^) := tbtcurrency(var1^) - tbtsingle(var2^); btDouble: tbtcurrency(var1^) := tbtcurrency(var1^) - tbtdouble(var2^); btExtended: tbtcurrency(var1^) := tbtcurrency(var1^) - tbtextended(var2^); @@ -6007,10 +6079,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtdouble(var1^) := tbtdouble(var1^) - tbts16(var2^); btU32: tbtdouble(var1^) := tbtdouble(var1^) - tbtu32(var2^); btS32: tbtdouble(var1^) := tbtdouble(var1^) - tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtdouble(var1^) := tbtdouble(var1^) - tbts64(var2^); - btU64: tbtdouble(var1^) := tbtdouble(var1^) - tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtdouble(var1^) := tbtdouble(var1^) - tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtdouble(var1^) := tbtdouble(var1^) - tbtu64(var2^);{$ENDIF} btSingle: tbtdouble(var1^) := tbtdouble(var1^) - tbtsingle(var2^); btDouble: tbtdouble(var1^) := tbtdouble(var1^) - tbtdouble(var2^); btExtended: tbtdouble(var1^) := tbtdouble(var1^) - tbtextended(var2^); @@ -6034,10 +6104,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtextended(var1^) := tbtextended(var1^) - tbts16(var2^); btU32: tbtextended(var1^) := tbtextended(var1^) - tbtu32(var2^); btS32: tbtextended(var1^) := tbtextended(var1^) - tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtextended(var1^) := tbtextended(var1^) - tbts64(var2^); - btU64: tbtextended(var1^) := tbtextended(var1^) - tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtextended(var1^) := tbtextended(var1^) -+tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtextended(var1^) := tbtextended(var1^) -+tbtu64(var2^);{$ENDIF} btSingle: tbtextended(var1^) := tbtextended(var1^) - tbtsingle(var2^); btDouble: tbtextended(var1^) := tbtextended(var1^) - tbtdouble(var2^); btExtended: tbtextended(var1^) := tbtextended(var1^) - tbtextended(var2^); @@ -6098,10 +6166,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtU32(var1^) := tbtU32(var1^) * cardinal(longint(tbts16(var2^))); btU32: tbtU32(var1^) := tbtU32(var1^) * tbtu32(var2^); btS32: tbtU32(var1^) := tbtU32(var1^) * cardinal(tbts32(var2^)); - {$IFNDEF PS_NOINT64} - btS64: tbtU32(var1^) := tbtU32(var1^) * tbts64(var2^); - btU64: tbtU32(var1^) := tbtU32(var1^) * tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtU32(var1^) := tbtU32(var1^) * tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtU32(var1^) := tbtU32(var1^) * tbtu64(var2^);{$ENDIF} btChar: tbtU32(var1^) := tbtU32(var1^) * Ord(tbtchar(var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbtU32(var1^) := tbtU32(var1^) * Ord(tbtwidechar(var2^));{$ENDIF} btVariant: tbtU32(var1^) := tbtU32(var1^) * Variant(var2^); @@ -6123,10 +6189,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbts32(var1^) := tbts32(var1^) * tbts16(var2^); btU32: tbts32(var1^) := tbts32(var1^) * Longint(tbtu32(var2^)); btS32: tbts32(var1^) := tbts32(var1^) * tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbts32(var1^) := tbts32(var1^) * tbts64(var2^); - btU64: tbts32(var1^) := tbts32(var1^) * tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbts32(var1^) := tbts32(var1^) * tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbts32(var1^) := tbts32(var1^) * tbtu64(var2^);{$ENDIF} btChar: tbts32(var1^) := tbts32(var1^) * Ord(tbtchar(var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbts32(var1^) := tbts32(var1^) * Ord(tbtwidechar(var2^));{$ENDIF} btVariant: tbts32(var1^) := tbts32(var1^) * Variant(var2^); @@ -6135,6 +6199,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal end; {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) * PSGetInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtu64(var1^) := tbtu64(var1^) * PSGetUInt64(var2, var2type); {$ENDIF} btCurrency: @@ -6152,10 +6218,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtcurrency(var1^) := tbtcurrency(var1^) * tbts16(var2^); btU32: tbtcurrency(var1^) := tbtdouble(var1^) * tbtu32(var2^); btS32: tbtcurrency(var1^) := tbtcurrency(var1^) * tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtcurrency(var1^) := tbtdouble(var1^) * tbts64(var2^); - btU64: tbtcurrency(var1^) := tbtdouble(var1^) * tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtcurrency(var1^) := tbtdouble(var1^) * tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtcurrency(var1^) := tbtdouble(var1^) * tbtu64(var2^);{$ENDIF} btSingle: tbtcurrency(var1^) := tbtcurrency(var1^) * tbtsingle(var2^); btDouble: tbtcurrency(var1^) := tbtcurrency(var1^) * tbtdouble(var2^); btExtended: tbtcurrency(var1^) := tbtcurrency(var1^) * tbtextended(var2^); @@ -6179,10 +6243,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtsingle(var1^) := tbtsingle(var1^) *tbts16(var2^); btU32: tbtsingle(var1^) := tbtsingle(var1^) *tbtu32(var2^); btS32: tbtsingle(var1^) := tbtsingle(var1^) *tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtsingle(var1^) := tbtsingle(var1^) *tbts64(var2^); - btU64: tbtsingle(var1^) := tbtsingle(var1^) *tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtsingle(var1^) := tbtsingle(var1^) *tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtsingle(var1^) := tbtsingle(var1^) *tbtu64(var2^);{$ENDIF} btSingle: tbtsingle(var1^) := tbtsingle(var1^) *tbtsingle(var2^); btDouble: tbtsingle(var1^) := tbtsingle(var1^) *tbtdouble(var2^); btExtended: tbtsingle(var1^) := tbtsingle(var1^) *tbtextended(var2^); @@ -6206,10 +6268,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtdouble(var1^) := tbtdouble(var1^) *tbts16(var2^); btU32: tbtdouble(var1^) := tbtdouble(var1^) *tbtu32(var2^); btS32: tbtdouble(var1^) := tbtdouble(var1^) *tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtdouble(var1^) := tbtdouble(var1^) *tbts64(var2^); - btU64: tbtdouble(var1^) := tbtdouble(var1^) *tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtdouble(var1^) := tbtdouble(var1^) *tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtdouble(var1^) := tbtdouble(var1^) *tbtu64(var2^);{$ENDIF} btSingle: tbtdouble(var1^) := tbtdouble(var1^) *tbtsingle(var2^); btDouble: tbtdouble(var1^) := tbtdouble(var1^) *tbtdouble(var2^); btExtended: tbtdouble(var1^) := tbtdouble(var1^) *tbtextended(var2^); @@ -6233,10 +6293,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtextended(var1^) := tbtextended(var1^) *tbts16(var2^); btU32: tbtextended(var1^) := tbtextended(var1^) *tbtu32(var2^); btS32: tbtextended(var1^) := tbtextended(var1^) *tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtextended(var1^) := tbtextended(var1^) *tbts64(var2^); - btU64: tbtextended(var1^) := tbtextended(var1^) *tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtextended(var1^) := tbtextended(var1^) *tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtextended(var1^) := tbtextended(var1^) *tbtu64(var2^);{$ENDIF} btSingle: tbtextended(var1^) := tbtextended(var1^) *tbtsingle(var2^); btDouble: tbtextended(var1^) := tbtextended(var1^) *tbtdouble(var2^); btExtended: tbtextended(var1^) := tbtextended(var1^) *tbtextended(var2^); @@ -6293,10 +6351,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtU32(var1^) := tbtU32(var1^) div cardinal(longint(tbts16(var2^))); btU32: tbtU32(var1^) := tbtU32(var1^) div tbtu32(var2^); btS32: tbtU32(var1^) := tbtU32(var1^) div cardinal(tbts32(var2^)); - {$IFNDEF PS_NOINT64} - btS64: tbtU32(var1^) := tbtU32(var1^) div tbts64(var2^); - btU64: tbtU32(var1^) := tbtU32(var1^) div tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtU32(var1^) := tbtU32(var1^) div tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtU32(var1^) := tbtU32(var1^) div tbtu64(var2^);{$ENDIF} btChar: tbtU32(var1^) := tbtU32(var1^) div Ord(tbtchar(var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbtU32(var1^) := tbtU32(var1^) div Ord(tbtwidechar(var2^));{$ENDIF} btVariant: tbtU32(var1^) := tbtU32(var1^) div Variant(var2^); @@ -6318,10 +6374,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbts32(var1^) := tbts32(var1^) div tbts16(var2^); btU32: tbts32(var1^) := tbts32(var1^) div Longint(tbtu32(var2^)); btS32: tbts32(var1^) := tbts32(var1^) div tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbts32(var1^) := tbts32(var1^) div tbts64(var2^); - btU64: tbts32(var1^) := tbts32(var1^) div tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbts32(var1^) := tbts32(var1^) div tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbts32(var1^) := tbts32(var1^) div tbtu64(var2^);{$ENDIF} btChar: tbts32(var1^) := tbts32(var1^) div Ord(tbtchar(var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbts32(var1^) := tbts32(var1^) div Ord(tbtwidechar(var2^));{$ENDIF} btVariant: tbts32(var1^) := tbts32(var1^) div Variant(var2^); @@ -6330,7 +6384,9 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal end; {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) div PSGetInt64(var2, var2type); - btU64: tbtu64(var1^) := tbtu64(var1^) div PSGetUInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btU64: tbts64(var1^) := tbtu64(var1^) div PSGetUInt64(var2, var2type); {$ENDIF} btSingle: begin @@ -6347,10 +6403,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtsingle(var1^) := tbtsingle(var1^) / tbts16(var2^); btU32: tbtsingle(var1^) := tbtsingle(var1^) / tbtu32(var2^); btS32: tbtsingle(var1^) := tbtsingle(var1^) / tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtsingle(var1^) := tbtsingle(var1^) / tbts64(var2^); - btU64: tbtsingle(var1^) := tbtsingle(var1^) / tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtsingle(var1^) := tbtsingle(var1^) / tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtsingle(var1^) := tbtsingle(var1^) / tbtu64(var2^);{$ENDIF} btSingle: tbtsingle(var1^) := tbtsingle(var1^) / tbtsingle(var2^); btDouble: tbtsingle(var1^) := tbtsingle(var1^) / tbtdouble(var2^); btExtended: tbtsingle(var1^) := tbtsingle(var1^) / tbtextended(var2^); @@ -6374,10 +6428,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtcurrency(var1^) := tbtcurrency(var1^) / tbts16(var2^); btU32: tbtcurrency(var1^) := tbtdouble(var1^) / tbtu32(var2^); btS32: tbtcurrency(var1^) := tbtcurrency(var1^) / tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtcurrency(var1^) := tbtdouble(var1^) / tbts64(var2^); - btU64: tbtcurrency(var1^) := tbtdouble(var1^) / tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtcurrency(var1^) := tbtdouble(var1^) / tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtcurrency(var1^) := tbtdouble(var1^) / tbtu64(var2^);{$ENDIF} btSingle: tbtcurrency(var1^) := tbtcurrency(var1^) / tbtsingle(var2^); btDouble: tbtcurrency(var1^) := tbtcurrency(var1^) / tbtdouble(var2^); btExtended: tbtcurrency(var1^) := tbtcurrency(var1^) / tbtextended(var2^); @@ -6401,10 +6453,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtdouble(var1^) := tbtdouble(var1^) / tbts16(var2^); btU32: tbtdouble(var1^) := tbtdouble(var1^) / tbtu32(var2^); btS32: tbtdouble(var1^) := tbtdouble(var1^) / tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtdouble(var1^) := tbtdouble(var1^) / tbts64(var2^); - btU64: tbtdouble(var1^) := tbtdouble(var1^) / tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtdouble(var1^) := tbtdouble(var1^) / tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtdouble(var1^) := tbtdouble(var1^) / tbtu64(var2^);{$ENDIF} btSingle: tbtdouble(var1^) := tbtdouble(var1^) / tbtsingle(var2^); btDouble: tbtdouble(var1^) := tbtdouble(var1^) / tbtdouble(var2^); btExtended: tbtdouble(var1^) := tbtdouble(var1^) / tbtextended(var2^); @@ -6428,10 +6478,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtextended(var1^) := tbtextended(var1^) / tbts16(var2^); btU32: tbtextended(var1^) := tbtextended(var1^) / tbtu32(var2^); btS32: tbtextended(var1^) := tbtextended(var1^) / tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbtextended(var1^) := tbtextended(var1^) / tbts64(var2^); - btU64: tbtextended(var1^) := tbtextended(var1^) / tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtextended(var1^) := tbtextended(var1^) / tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtextended(var1^) := tbtextended(var1^) / tbtu64(var2^);{$ENDIF} btSingle: tbtextended(var1^) := tbtextended(var1^) / tbtsingle(var2^); btDouble: tbtextended(var1^) := tbtextended(var1^) / tbtdouble(var2^); btExtended: tbtextended(var1^) := tbtextended(var1^) / tbtextended(var2^); @@ -6486,10 +6534,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbtU32(var1^) := tbtU32(var1^) mod cardinal(longint(tbts16(var2^))); btU32: tbtU32(var1^) := tbtU32(var1^) mod tbtu32(var2^); btS32: tbtU32(var1^) := tbtU32(var1^) mod cardinal(tbts32(var2^)); - {$IFNDEF PS_NOINT64} - btS64: tbtU32(var1^) := tbtU32(var1^) mod tbts64(var2^); - btU64: tbtU32(var1^) := tbtU32(var1^) mod tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbtU32(var1^) := tbtU32(var1^) mod tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtU32(var1^) := tbtU32(var1^) mod tbtu64(var2^);{$ENDIF} btChar: tbtU32(var1^) := tbtU32(var1^) mod Ord(tbtchar(var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbtU32(var1^) := tbtU32(var1^) mod Ord(tbtwidechar(var2^));{$ENDIF} btVariant: tbtU32(var1^) := tbtU32(var1^) mod Variant(var2^); @@ -6511,10 +6557,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS16: tbts32(var1^) := tbts32(var1^) mod tbts16(var2^); btU32: tbts32(var1^) := tbts32(var1^) mod Longint(tbtu32(var2^)); btS32: tbts32(var1^) := tbts32(var1^) mod tbts32(var2^); - {$IFNDEF PS_NOINT64} - btS64: tbts32(var1^) := tbts32(var1^) mod tbts64(var2^); - btU64: tbts32(var1^) := tbts32(var1^) mod tbtu64(var2^); - {$ENDIF} + {$IFNDEF PS_NOINT64} btS64: tbts32(var1^) := tbts32(var1^) mod tbts64(var2^);{$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbts32(var1^) := tbts32(var1^) mod tbtu64(var2^);{$ENDIF} btChar: tbts32(var1^) := tbts32(var1^) mod Ord(tbtchar(var2^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: tbts32(var1^) := tbts32(var1^) mod Ord(tbtwidechar(var2^));{$ENDIF} btVariant: tbts32(var1^) := tbts32(var1^) mod Variant(var2^); @@ -6523,6 +6567,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal end; {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) mod PSGetInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtu64(var1^) := tbtu64(var1^) mod PSGetUInt64(var2, var2type); {$ENDIF} btVariant: @@ -6553,6 +6599,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS32: tbts32(var1^) := tbts32(var1^) shl PSGetInt(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) shl PSGetInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtu64(var1^) := tbtu64(var1^) shl PSGetUInt64(var2, var2type); {$ENDIF} btVariant: @@ -6583,6 +6631,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS32: tbts32(var1^) := tbts32(var1^) shr PSGetInt(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) shr PSGetInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtu64(var1^) := tbtu64(var1^) shr PSGetUInt64(var2, var2type); {$ENDIF} btVariant: @@ -6613,6 +6663,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS32: tbts32(var1^) := tbts32(var1^) and PSGetInt(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) and PSGetInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtu64(var1^) := tbtu64(var1^) and PSGetUInt64(var2, var2type); {$ENDIF} btVariant: @@ -6643,6 +6695,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS32: tbts32(var1^) := tbts32(var1^) or PSGetInt(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) or PSGetInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtu64(var1^) := tbtu64(var1^) or PSGetUInt64(var2, var2type); {$ENDIF} btVariant: @@ -6673,6 +6727,8 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btS32: tbts32(var1^) := tbts32(var1^) xor PSGetInt(Var2, var2type); {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) xor PSGetInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtu64(var1^) := tbtu64(var1^) xor PSGetUInt64(var2, var2type); {$ENDIF} btVariant: @@ -6958,7 +7014,9 @@ function TPSExec.ReadVariable(var Dest: TPSResultData; UsePointer: Boolean): Boo {$endif} Inc(FCurrentPosition, 8); end; - btU64: + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: begin if FCurrentPosition + 7>= FDataLength then begin @@ -7392,7 +7450,9 @@ function TPSExec.DoMinus(Dta: Pointer; aType: TPSTypeRec): Boolean; btS32: tbts32(dta^) := -tbts32(dta^); {$IFNDEF PS_NOINT64} bts64: tbts64(dta^) := -tbts64(dta^); - btU64: tbtu64(dta^) := -tbtu64(dta^); + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: tbtu64(dta^) := -tbtu64(dta^); {$ENDIF} btSingle: tbtsingle(dta^) := -tbtsingle(dta^); btDouble: tbtdouble(dta^) := -tbtdouble(dta^); @@ -7429,7 +7489,9 @@ function TPSExec.DoBooleanNot(Dta: Pointer; aType: TPSTypeRec): Boolean; btS32: tbts32(dta^) := tbts32(tbts32(dta^) = 0); {$IFNDEF PS_NOINT64} bts64: tbts64(dta^) := tbts64(tbts64(dta^) = 0); - btU64: tbtu64(dta^) := tbtu64(tbtu64(dta^) = 0); + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: tbtu64(dta^) := tbtu64(tbtu64(dta^) = 0); {$ENDIF} btVariant: begin @@ -7974,7 +8036,9 @@ function TPSExec.DoIntegerNot(Dta: Pointer; aType: TPSTypeRec): Boolean; btS32: tbts32(dta^) := not tbts32(dta^); {$IFNDEF PS_NOINT64} bts64: tbts64(dta^) := not tbts64(dta^); - btU64: tbtu64(dta^) := not tbtu64(dta^); + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: tbtu64(dta^) := not tbtu64(dta^); {$ENDIF} btVariant: begin @@ -9121,7 +9185,9 @@ function TPSExec.RunScript: Boolean; bts32: dec(tbts32(vd.P^)); {$IFNDEF PS_NOINT64} bts64: dec(tbts64(vd.P^)); - btU64: dec(tbtu64(vd.P^)); +{$ENDIF} +{$IFNDEF PS_NOUINT64} + btu64: dec(tbtu64(vd.P^)); {$ENDIF} else begin @@ -9153,7 +9219,9 @@ function TPSExec.RunScript: Boolean; bts32: Inc(tbts32(vd.P^)); {$IFNDEF PS_NOINT64} bts64: Inc(tbts64(vd.P^)); - btU64: Inc(tbtu64(vd.P^)); +{$ENDIF} +{$IFNDEF PS_NOUINT64} + btu64: Inc(tbtu64(vd.P^)); {$ENDIF} else begin @@ -9745,6 +9813,11 @@ function DefProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack end; end; end; +{$ENDIF} +{$IFNDEF PS_NOUINT64} + 45: Stack.SetUInt64(-1, StrToUInt64(string(Stack.GetAnsiString(-2)))); // StrToUInt64 + 46: Stack.SetAnsiString(-1, tbtstring(SysUtils.IntToStr(Stack.GetUInt64(-2))));// UInt64ToStr + 47: Stack.SetUInt64(-1, StrToUInt64Def(string(Stack.GetAnsiString(-2)), Stack.GetUInt64(-3))); // StrToUInt64Def {$ENDIF} else begin @@ -9855,6 +9928,14 @@ function Length_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack end; end; +function FillChar_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; +var + arr: TPSVariantIFC; +begin + Result:=True; + arr:=NewTPSVariantIFC(Stack[Stack.Count-1],true); + FillChar( arr.Dta^, STack.GetInt(-2), STack.GetInt(-3) ); +end; function SetLength_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; var @@ -9904,8 +9985,22 @@ function Low_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): btS32 : Stack.SetInt(-1,Low(Integer)); //Integer/LongInt: -2147483648 {$IFNDEF PS_NOINT64} btS64 : Stack.SetInt64(-1,Low(Int64)); //Int64: -9223372036854775808 - btU64 : Stack.SetUInt64(-1,Low(UInt64)); //UInt64: 0 {$ENDIF} +{$IFNDEF PS_NOINT64} + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} + btU64 : Stack.SetUInt64(-1, UInt64( 0 ) ); //UInt64: 0 + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} +{$ENDIF} else Result:=false; end; end; @@ -9928,7 +10023,13 @@ function High_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): btS32 : Stack.SetInt(-1,High(Integer)); //Integer/LongInt: 2147483647 {$IFNDEF PS_NOINT64} btS64 : Stack.SetInt64(-1,High(Int64)); //Int64: 9223372036854775807 - btU64 : Stack.SetUInt64(-1,High(UInt64)); //UInt64: 18446744073709551615 +{$ENDIF} +{$IFNDEF PS_NOINT64} + {$IF CompilerVersion >= 23} + btU64 : Stack.SetUInt64(-1,High(UInt64)); //UInt64: 18446744073709551615 + {$ELSE} + btU64 : Stack.SetUInt64(-1,UInt64( $FFFFFFFFFFFFFFFF ) ); //UInt64: 18446744073709551615 + {$IFEND} {$ENDIF} else Result:=false; end; @@ -9949,7 +10050,21 @@ function Dec_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): btS32 : Stack.SetInt(-1,Tbts32(arr.dta^)-1); //Integer/LongInt {$IFNDEF PS_NOINT64} btS64 : Stack.SetInt64(-1,Tbts64(arr.dta^)-1); +{$ENDIF} +{$IFNDEF PS_NOUINT64} + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} btU64 : Stack.SetUInt64(-1,Tbtu64(arr.dta^)-1); + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} {$ENDIF} else Result:=false; end; @@ -9970,7 +10085,21 @@ function Inc_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): btS32 : Stack.SetInt(-1,Tbts32(arr.dta^)+1); //Integer/LongInt {$IFNDEF PS_NOINT64} btS64 : Stack.SetInt64(-1,Tbts64(arr.dta^)+1); +{$ENDIF} +{$IFNDEF PS_NOUINT64} + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} btU64 : Stack.SetUInt64(-1,Tbtu64(arr.dta^)+1); + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} {$ENDIF} else Result:=false; end; @@ -10045,6 +10174,7 @@ procedure TPSExec.RegisterStandardProcs; RegisterFunctionName('Length',Length_,nil,nil); RegisterFunctionName('SetLength',SetLength_,nil,nil); + RegisterFunctionName('FillChar',FillChar_,nil,nil); RegisterFunctionName('Low',Low_,nil,nil); RegisterFunctionName('High',High_,nil,nil); RegisterFunctionName('Dec',Dec_,nil,nil); @@ -10111,6 +10241,13 @@ procedure TPSExec.RegisterStandardProcs; RegisterDelphiFunction(@_VarArrayGet, 'VarArrayGet', cdRegister); RegisterDelphiFunction(@_VarArraySet, 'VarArraySet', cdRegister); {$ENDIF} + + {$IFNDEF PS_NOUINT64} + RegisterFunctionName('StrToUInt64', DefProc, Pointer(45), nil); + RegisterFunctionName('UInt64ToStr', DefProc, Pointer(46), nil); + RegisterFunctionName('StrToUInt64Def', DefProc, Pointer(47), nil); + {$ENDIF} + RegisterInterfaceLibraryRuntime(Self); end; @@ -10183,9 +10320,15 @@ function IntPIFVariantToVariant(Src: pointer; aType: TPSTypeRec; var Dest: Varia {$IFNDEF PS_NOINT64} {$IFDEF DELPHI6UP} btS64: Dest := tbts64(Src^); - btU64: Dest := tbtu64(Src^); {$ELSE} - btS64, btU64: begin Result := False; exit; end; + bts64: begin Result := False; exit; end; + {$ENDIF} + {$ENDIF} + {$IFNDEF PS_NOUINT64} + {$IFDEF DELPHI6UP} + btU64: Dest := tbtu64(Src^); + {$ELSE} + btu64: begin Result := False; exit; end; {$ENDIF} {$ENDIF} btChar: Dest := tbtString(tbtchar(src^)); @@ -10357,6 +10500,8 @@ function CreateOpenArray(VarParam: Boolean; Sender: TPSExec; val: PPSVariantIFC) New(tvarrec(p^).VInt64); tvarrec(p^).VInt64^ := tbts64(cp^); end; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: begin tvarrec(p^).VType := vtInt64; New(tvarrec(p^).VInt64); @@ -10463,10 +10608,12 @@ procedure DestroyOpenArray(Sender: TPSExec; V: POpenArray); tbts64(cp^) := tvarrec(p^).vInt64^; dispose(tvarrec(p^).VInt64); end; + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: begin if v^.VarParam then tbtu64(cp^) := tvarrec(p^).vInt64^; - dispose(tvarrec(p^).VInt64); + dispose(tvarrec(p^).vInt64); end; {$ENDIF} {$IFNDEF PS_NOWIDESTRING} @@ -10546,7 +10693,7 @@ procedure DestroyOpenArray(Sender: TPSExec; V: POpenArray); {$ENDIF} {$ENDIF} {$ELSE} - + {$IFDEF USEINVOKECALL} {$include InvokeCall.inc} {$DEFINE _INVOKECALL_INC_} @@ -10700,12 +10847,36 @@ function FindVirtualMethodPtr(Ret: TPSRuntimeClass; FClass: TClass; Ptr: Pointer begin if I <> ({$IFDEF VER90}-44{$ELSE}vmtTypeInfo{$ENDIF} div SizeOf(Pointer)) then begin // from GExperts code + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} if (IPointer(p^[I]) > IPointer(p)) and ((IPointer(p^[I]) - IPointer(p)) + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} div //PointerSize < Ret.FEndOfVMT) then PointerSize < Cardinal(Ret.FEndOfVMT)) then begin + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} Ret.FEndOfVMT := (IPointer(p^[I]) - IPointer(p)) div SizeOf(Pointer); + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} end; end; end; @@ -11375,6 +11546,8 @@ function ClassCallProcProperty(Caller: TPSExec; p: TPSExternalProcRec; Global, S btS32: SetOrdProp(TObject(FSelf), PPropInfo(p.Ext1), tbts32(n.Dta^)); {$IFNDEF PS_NOINT64} btS64: SetInt64Prop(TObject(FSelf), PPropInfo(p.Ext1), tbts64(n.Dta^)); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: SetInt64Prop(TObject(FSelf), PPropInfo(p.Ext1), tbtu64(n.Dta^)); {$ENDIF} btSingle: SetFloatProp(TObject(FSelf), p.Ext1, tbtsingle(n.Dta^)); @@ -11442,6 +11615,8 @@ function ClassCallProcProperty(Caller: TPSExec; p: TPSExternalProcRec; Global, S btS32: tbts32(n.Dta^) := GetOrdProp(TObject(FSelf), p.Ext1); {$IFNDEF PS_NOINT64} btS64: tbts64(n.Dta^) := GetInt64Prop(TObject(FSelf), p.Ext1); + {$ENDIF} + {$IFNDEF PS_NOUINT64} btU64: tbtu64(n.Dta^) := GetInt64Prop(TObject(FSelf), p.Ext1); {$ENDIF} btSingle: tbtsingle(n.Dta^) := GetFloatProp(TObject(FSelf), p.Ext1); @@ -12481,6 +12656,8 @@ function ResultAsRegister(b: TPSTypeRec): Boolean; {$ENDIF} {$IFNDEF PS_NOINT64} bts64, +{$ENDIF} +{$IFNDEF PS_NOUINT64} btU64, {$ENDIF} btPChar, @@ -12509,6 +12686,8 @@ function SupportsRegister(b: TPSTypeRec): Boolean; {$IFDEF CPU64} {$IFNDEF PS_NOINT64} bts64, +{$ENDIF} +{$IFNDEF PS_NOUINT64} btU64, {$ENDIF} {$ENDIF} @@ -12913,7 +13092,10 @@ function MyAllMethodsHandler32(Self: PScriptMethodInfo; const Stack: PPointer; _ end else begin {$IFNDEF PS_NOINT64} - if (res^.FType.BaseType <> btS64) and (res^.FType.BaseType <> btU64) then + if res^.FType.BaseType <> btS64 then +{$ENDIF} +{$IFNDEF PS_NOUINT64} + if res^.FType.BaseType <> btU64 then {$ENDIF} CopyArrayContents(Pointer(IPointer(Stack)-PointerSize2), @PPSVariantData(res)^.Data, 1, Res^.FType); end; @@ -13294,7 +13476,9 @@ function TPSStack.GetInt64(ItemNo: Longint): Int64; val := items[ItemNo]; Result := PSGetInt64(@PPSVariantData(val).Data, val.FType); end; +{$ENDIF} +{$IFNDEF PS_NOUINT64} function TPSStack.GetUInt64(ItemNo: Longint): UInt64; var val: PPSVariant; @@ -13529,7 +13713,9 @@ procedure TPSStack.SetInt64(ItemNo: Longint; const Data: Int64); PSSetInt64(@PPSVariantData(val).Data, val.FType, ok, Data); if not ok then raise Exception.Create(RPS_TypeMismatch); end; +{$ENDIF} +{$IFNDEF PS_NOUINT64} procedure TPSStack.SetUInt64(ItemNo: Longint; const Data: UInt64); var val: PPSVariant; diff --git a/Source/uPSUtils.pas b/Source/uPSUtils.pas index d88954e4..a5be8bcd 100644 --- a/Source/uPSUtils.pas +++ b/Source/uPSUtils.pas @@ -2,6 +2,11 @@ {$I PascalScript.inc} interface + +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CODE OFF +{$WARN UNSAFE_CAST OFF} + uses Classes, SysUtils {$IFDEF VER130}, Windows {$ENDIF}; @@ -38,6 +43,7 @@ interface tbtPChar = {$IFDEF DELPHI2009UP}PAnsiChar{$ELSE}PChar{$ENDIF}; tbtChar = {$IFDEF DELPHI4UP}AnsiChar{$ELSE}CHAR{$ENDIF}; {$ENDIF} + tbtAnsiChar = AnsiChar; TPSBaseType = Byte; @@ -107,8 +113,8 @@ interface btUnicodeString = 28; -{$IFNDEF PS_NOINT64} - btU64 = 29; +{$IFNDEF PS_NOUINT64} + btu64 = 29; {$ENDIF} btType = 130; @@ -313,21 +319,23 @@ function MakeHash(const s: TbtString): Longint; TbtSingle = Single; - TbtDouble = Double; + TbtDouble = double; TbtExtended = Extended; tbtCurrency = Currency; {$IFNDEF PS_NOINT64} - tbts64 = int64; +{$ENDIF} + +{$IFNDEF PS_NOUINT64} tbtu64 = uint64; {$ENDIF} {$IFNDEF PS_NOWIDESTRING} - tbtWideString = WideString; + tbtwidestring = widestring; tbtUnicodeString = {$IFDEF FPC} @@ -336,7 +344,7 @@ function MakeHash(const s: TbtString): Longint; {$IFDEF UNICODE}UnicodeString{$ELSE}WideString{$ENDIF} {$ENDIF}; - tbtWideChar = WideChar; + tbtwidechar = widechar; tbtNativeString = {$IFDEF DELPHI2009UP}tbtUnicodeString{$ELSE}tbtString{$ENDIF}; {$ENDIF} {$IFDEF FPC} @@ -450,9 +458,9 @@ TPSUnit = class(TObject) function HasUses(pUnitName: TbtString): Boolean; - {$WARNINGS OFF} + {.$WARNINGS OFF} property UnitName: TbtString read fUnitName write SetUnitName; - {$WARNINGS ON} + {.$WARNINGS ON} end; TPSUnitList = class @@ -610,6 +618,7 @@ TPSPascalParser = class(TObject) property OriginalToken: TbtString read FOriginalToken; property CurrTokenPos: Cardinal read FRealPosition; + property CurrTokenLength: Cardinal read FTokenLength; property CurrTokenID: TPSPasToken read FTokenId; @@ -654,8 +663,20 @@ function GRLW(var s: TbtString): TbtString; function WideUpperCase(const S: WideString): WideString; function WideLowerCase(const S: WideString): WideString; {$ENDIF} + +{$IF CompilerVersion < 23} +function StrToUInt64( const s: string ): UInt64; +function StrToUInt64Def( const s: string; Default : UInt64 ): UInt64; +function UIntToStr( UInt : UInt64 ): string; +{$IFEND} + implementation +{$IF CompilerVersion < 23} +uses + Variants; +{$IFEND} + {$IFDEF DELPHI3UP } resourceString {$ELSE } @@ -765,7 +786,11 @@ function IntToStr(I: LongInt): TbtString; //------------------------------------------------------------------- function FloatToStr(E: Extended): TbtString; +//var +// s: tbtstring; begin +// Str(e:0:12, s); +// result := s; Result := TbtString(SysUtils.FloatToStr(E)); end; @@ -1749,8 +1774,39 @@ procedure TPSUnit.SetUnitName(const Value: TbtString); fUnitName := FastUpperCase(Value); end; +{$IF CompilerVersion < 23} +{$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} +{$ENDIF} +function StrToUInt64( const s: string ): UInt64; +const + SInvalidUInt64 = '''%s'' is not a valid UInt64 value'; +var + Error: Integer; +begin + Val( S, result, Error ); + if Error <> 0 then + Raise Exception.Create( Format( SInvalidUInt64, [ S ] ) ); +end; -end. - +function StrToUInt64Def( const s: string; Default : UInt64 ): UInt64; +var + Error: Integer; +begin + Val( S, result, Error ); + if Error <> 0 then + result := Default; +end; +function UIntToStr( UInt : UInt64 ): string; +begin + result := VarToStr( UInt ); +end; +{$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} +{$ENDIF} +{$IFEND} +end. diff --git a/Source/x64.inc b/Source/x64.inc index af1d24e1..675fec42 100644 --- a/Source/x64.inc +++ b/Source/x64.inc @@ -699,7 +699,8 @@ _XMM0: Double; btClass, {$IFNDEF PS_NOWIDESTRING} btUnicodeString, btWideString, btWideChar, {$ENDIF} btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency - {$IFNDEF PS_NOINT64}, bts64, btU64{$ENDIF}: + {$IFNDEF PS_NOINT64}, bts64{$ENDIF} + {$IFNDEF PS_NOUINT64}, btu64{$ENDIF}: begin Varptr := fvar.Dta; end; @@ -821,6 +822,8 @@ _XMM0: Double; begin StoreReg(IPointer(int64(fvar^.dta^))); end; +{$ENDIF} +{$IFNDEF PS_NOUINT64} btU64: begin StoreReg(IPointer(tbtu64(fvar^.dta^))); @@ -951,6 +954,8 @@ begin btPChar: pansichar(res.dta^) := Pansichar(_RAX); {$IFNDEF PS_NOINT64} bts64: tbts64(res.dta^) := Int64(_RAX); +{$ENDIF} +{$IFNDEF PS_NOUINT64} btU64: tbtu64(res.dta^) := UInt64(_RAX); {$ENDIF} btCurrency: tbts64(res.Dta^) := Int64(_RAX); { Do not change to tbtCurrency: see 08d2743a } @@ -998,5 +1003,3 @@ begin end; end; end; - - diff --git a/Source/x86.inc b/Source/x86.inc index 39c6455b..73457619 100644 --- a/Source/x86.inc +++ b/Source/x86.inc @@ -328,7 +328,8 @@ var btClass, {$IFNDEF PS_NOWIDESTRING} btUnicodeString, btWideString, btWideChar, {$ENDIF} btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency - {$IFNDEF PS_NOINT64}, bts64, btU64{$ENDIF}: + {$IFNDEF PS_NOINT64}, bts64{$ENDIF} + {$IFNDEF PS_NOUINT64}, btu64{$ENDIF}: begin Varptr := fvar.Dta; end; @@ -481,11 +482,23 @@ var TempStr:= StringOfChar(AnsiChar(#0),8); Int64((@TempStr[1])^) := int64(fvar^.dta^); UseReg := False; - end; - btU64: + end;{$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: begin - TempStr := StringOfChar(AnsiChar(#0),8); + TempStr:= StringOfChar(AnsiChar(#0),8); + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} UInt64((@TempStr[1])^) := tbtu64(fvar^.dta^); + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} UseReg := False; end;{$ENDIF} end; {case} @@ -607,13 +620,28 @@ begin btu32,bts32{$IFDEF FPC},btArray{$ENDIF}: tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil); btPChar: pansichar(res.dta^) := Pansichar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil)); - {$IFNDEF PS_NOINT64}bts64, btU64: + {$IFNDEF PS_NOINT64}bts64: begin EAX := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX); - if res^.aType.BaseType = btU64 then - tbtu64(res.dta^) := UInt64(Cardinal(EDX)) shl 32 or Cardinal(EAX) - else - tbts64(res.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + tbts64(res.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + end; + {$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: + begin + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} + EAX := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX); + tbtu64(res.dta^) := UInt64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} end; {$ENDIF} btCurrency: tbtCurrency(res.Dta^) := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4) / 10000; @@ -668,13 +696,28 @@ begin {$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.Dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil); btClass, btu32, bts32: tbtu32(res^.Dta^):= RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil); btPChar: pansichar(res^.dta^) := Pansichar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil)); - {$IFNDEF PS_NOINT64}bts64, btU64: + {$IFNDEF PS_NOINT64}bts64: + begin + EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX); + tbts64(res^.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + end; + {$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: begin + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX); - if res^.aType.BaseType = btU64 then - tbtu64(res^.dta^) := UInt64(Cardinal(EDX)) shl 32 or Cardinal(EAX) - else - tbts64(res^.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + tbtu64(res^.dta^) := UInt64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} end; {$ENDIF} btVariant, @@ -730,13 +773,28 @@ begin {$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil); btClass, btu32, bts32: tbtu32(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil); btPChar: pansichar(res^.dta^) := Pansichar(RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil)); - {$IFNDEF PS_NOINT64}bts64, btU64: + {$IFNDEF PS_NOINT64}bts64: begin EAX := RealCall_CDecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX); - if res^.aType.BaseType = btU64 then - tbtu64(res^.Dta^) := UInt64(Cardinal(EDX)) shl 32 or Cardinal(EAX) - else - tbts64(res^.Dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + tbts64(res^.Dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + end; + {$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: + begin + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} + EAX := RealCall_CDecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX); + tbtu64(res^.Dta^) := UInt64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} end; {$ENDIF} btVariant, {$IFNDEF PS_NOWIDESTRING}btUnicodeString, btWideString, {$ENDIF} @@ -768,13 +826,28 @@ begin {$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil); btclass, btu32, bts32: tbtu32(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil); btPChar: pansichar(res^.dta^) := Pansichar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil)); - {$IFNDEF PS_NOINT64}bts64, btU64: + {$IFNDEF PS_NOINT64}bts64: + begin + EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX); + tbts64(res^.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + end; + {$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: begin + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFOPT R+} + {$DEFINE RANGECHECK_REENABLE} + {$RANGECHECKS OFF} // {$R-} + {$ENDIF} + {$IFEND CompilerVersion <= 20} EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX); - if res^.aType.BaseType = btU64 then - tbtu64(res^.dta^) := UInt64(Cardinal(EDX)) shl 32 or Cardinal(EAX) - else - tbts64(res^.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + tbtu64(res^.dta^) := UInt64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + {$IF CompilerVersion <= 20} // RangeCheck might cause Internal-Error C1118 + {$IFDEF RANGECHECK_REENABLE} + {$RANGECHECKS ON} // {$R+} + {$UNDEF RANGECHECK_REENABLE} + {$ENDIF} + {$IFEND CompilerVersion <= 20} end; {$ENDIF} btVariant, {$IFNDEF PS_NOWIDESTRING}btUnicodeString, btWideString, {$ENDIF} diff --git a/unit-importing/Main.dfm b/unit-importing/Main.dfm index 878cdf54..12fffa5a 100644 --- a/unit-importing/Main.dfm +++ b/unit-importing/Main.dfm @@ -1,9 +1,9 @@ object frmMain: TfrmMain Left = 269 Top = 246 - Width = 696 - Height = 551 Caption = 'Import Files' + ClientHeight = 492 + ClientWidth = 680 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -19,27 +19,26 @@ object frmMain: TfrmMain TextHeight = 16 object Splitter1: TSplitter Left = 0 - Top = 382 - Width = 688 + Top = 388 + Width = 680 Height = 4 Cursor = crVSplit Align = alBottom end object lboMessages: TListBox Left = 0 - Top = 386 - Width = 688 + Top = 392 + Width = 680 Height = 81 Align = alBottom - ItemHeight = 16 TabOrder = 0 OnDblClick = lboMessagesDblClick end object TabControl1: TTabControl Left = 0 Top = 29 - Width = 688 - Height = 353 + Width = 680 + Height = 359 Align = alClient Style = tsFlatButtons TabOrder = 1 @@ -51,8 +50,8 @@ object frmMain: TfrmMain object Editor: TSynEdit Left = 4 Top = 30 - Width = 680 - Height = 319 + Width = 672 + Height = 325 Align = alClient Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -63,6 +62,14 @@ object frmMain: TfrmMain OnClick = EditorClick OnKeyDown = EditorKeyDown OnKeyUp = EditorKeyUp + CodeFolding.GutterShapeSize = 11 + CodeFolding.CollapsedLineColor = clGrayText + CodeFolding.FolderBarLinesColor = clGrayText + CodeFolding.IndentGuidesColor = clGray + CodeFolding.IndentGuides = True + CodeFolding.ShowCollapsedLine = False + CodeFolding.ShowHintMark = True + UseCodeFolding = False Gutter.DigitCount = 2 Gutter.Font.Charset = DEFAULT_CHARSET Gutter.Font.Color = clWindowText @@ -79,6 +86,7 @@ object frmMain: TfrmMain OnChange = EditorChange OnDropFiles = EditorDropFiles OnScroll = EditorScroll + FontSmoothing = fsmNone RemovedKeystrokes = < item Command = ecContextHelp @@ -94,13 +102,12 @@ object frmMain: TfrmMain object ToolBar1: TToolBar Left = 0 Top = 0 - Width = 688 + Width = 680 Height = 29 ButtonHeight = 24 ButtonWidth = 25 Caption = 'ToolBar1' EdgeBorders = [ebBottom] - Flat = True Images = ImageList1 TabOrder = 2 object ToolButton1: TToolButton @@ -184,8 +191,8 @@ object frmMain: TfrmMain end object stbMain: TStatusBar Left = 0 - Top = 467 - Width = 688 + Top = 473 + Width = 680 Height = 19 Panels = < item @@ -201,6 +208,9 @@ object frmMain: TfrmMain Top = 65532 end object pashighlighter: TSynPasSyn + Options.AutoDetectEnabled = False + Options.AutoDetectLineLimit = 0 + Options.Visible = False Left = 480 end object mnuMain: TMainMenu diff --git a/unit-importing/ParserU.pas b/unit-importing/ParserU.pas index 968cbe7a..fea16d22 100644 --- a/unit-importing/ParserU.pas +++ b/unit-importing/ParserU.pas @@ -1591,26 +1591,24 @@ function TUnitParser.ParseProcDecl(var ProcName, decl, CallingConvention: string Include(result,IsCallHelper); Include(Proc.ProcAttr, IsDone); Writeln('New Name :''' + ProcName + ''''); - with Proc do + + ParamStr := ''; + if ParamNames.count <> 0 then begin - ParamStr := ''; - if ParamNames.count <> 0 then - begin - for Index := 0 to ParamNames.count - 1 do - ParamStr := ParamStr + ', ' + ParamNames[Index]; - end; - system.Delete(ParamStr,1,2); - s := ''; - If (IsFunction in Result) then s := 'Result := '; - If ParamStr <> '' then ParamStr := '('+ParamStr +')'; - If (IsConstructor in Result) then - Add('Begin Result := '+OwnerClass+'.' + OldProcName+ParamStr+'; END;') - else - If (IsMethod in Options) then - Add('Begin '+S+'Self.' + OldProcName+ParamStr+'; END;') - else - Add('Begin '+s+UnitName + '.' + OldProcName +ParamStr+ '; END;'); + for Index := 0 to ParamNames.count - 1 do + ParamStr := ParamStr + ', ' + ParamNames[Index]; end; + system.Delete(ParamStr,1,2); + s := ''; + If (IsFunction in Result) then s := 'Result := '; + If ParamStr <> '' then ParamStr := '('+ParamStr +')'; + If (IsConstructor in Result) then + Proc.Add('Begin Result := '+OwnerClass+'.' + OldProcName+ParamStr+'; END;') + else + If (IsMethod in Options) then + Proc.Add('Begin '+S+'Self.' + OldProcName+ParamStr+'; END;') + else + Proc.Add('Begin '+s+UnitName + '.' + OldProcName +ParamStr+ '; END;'); end; NextToken; Match(CSTI_Semicolon); diff --git a/unit-importing/bigini.pas b/unit-importing/bigini.pas index ec1927dd..eddebad1 100644 --- a/unit-importing/bigini.pas +++ b/unit-importing/bigini.pas @@ -222,7 +222,7 @@ TSectionList = class(TStringList) constructor Create; function EraseDuplicates(callBackProc:TEraseSectionCallback) : Boolean; function GetSectionItems(index: Integer): TStringList; - function IndexOf(const S: AnsiString): Integer; override; + function IndexOf(const S: String): Integer; override; function IndexOfName(const name: string): Integer; //override; property SectionItems[index: Integer]: TStringList Read GetSectionItems; end; @@ -546,7 +546,7 @@ function TSectionList.EraseDuplicates(callBackProc:TEraseSectionCallback) : Bool {. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . } { search string } {. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . } -function TSectionList.IndexOf(const S: AnsiString): Integer; +function TSectionList.IndexOf(const S: String): Integer; var ix, LastIX : Integer; @@ -1401,7 +1401,7 @@ procedure TBiggerIniFile.RenameKey(const aSection, OldKey, NewKey : String); function TBiggerIniFile.ReadBinaryData(const aSection, aKey: String; var Buffer; BufSize: Integer): Integer; var ix : Integer; - bufPtr : PChar; + bufPtr : PAnsiChar; hexDump : AnsiString; begin hexDump := ReadAnsiString(aSection,aKey,''); @@ -1411,7 +1411,7 @@ function TBiggerIniFile.ReadBinaryData(const aSection, aKey: String; var Buffer; bufPtr := Pointer(Buffer); for ix := 0 to result -1 do begin - Byte(bufPtr[ix]) := StrToIntDef('$' + Copy(hexDump,1 + ix*2,2) ,0); + bufPtr[ix] := AnsiChar( StrToIntDef('$' + Copy(hexDump,1 + ix*2,2) ,0) ); end; end; @@ -1422,7 +1422,7 @@ function TBiggerIniFile.ReadBinaryData(const aSection, aKey: String; var Buffer; procedure TBiggerIniFile.WriteBinaryData(const aSection, aKey: String; var Buffer; BufSize: Integer); var ix : Integer; - bufPtr : PChar; + bufPtr : PAnsiChar; hexDump : AnsiString; begin hexDump := '';