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 3a59b5d4..eba3520d 100644 --- a/Source/InvokeCall.inc +++ b/Source/InvokeCall.inc @@ -1,202 +1,934 @@ -function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean; -var SysCalConv : TCallConv; - Args: TArray; - Arg : TValue; - i : Integer; - fvar: PPSVariantIFC; - IsConstr : Boolean; - ctx: TRTTIContext; - RttiType : TRttiType; - ResValue : TValue; +//NEED FPC TESTS & FIXES!!! + +type + EInvocationError = class(Exception); + TEmptyArr = array of Byte; + + +{$if not declared(btCharIsWide)} +const + {$if not declared(btCharSize)} + btCharSize = SizeOf(TbtString(nil^)[1]); + {$ifend} + {$IFNDEF FPC}{$warn comparison_true off}{$ENDIF} + btCharIsWide = {$if btCharSize=2}True{$else}False{$ifend}; +{$ifend} + +const + EmptyPChar: array[0..1] of Byte = (0, 0); + +var + RTTITypesDict : TDictionary = nil; + ctx: TRTTIContext; + +procedure InitRTTITypesDictInstance; begin - Result := False; - case CallingConv of - cdRegister : SysCalConv := ccReg; - cdPascal : SysCalConv := ccPascal; - cdCdecl : SysCalConv := ccCdecl; - cdStdCall : SysCalConv := ccStdCall; - cdSafeCall : SysCalConv := ccSafeCall; - else - SysCalConv := ccReg;//to prevent warning "W1036 Variable might not have been initialized" + if Assigned(RTTITypesDict) then + Exit; + RTTITypesDict := TDictionary.Create; +end; + +procedure DisposeRTTITypesDictInstance; +begin //this method should be called in finalization section of uPSRuntime.pas, + //but i dont want to modify it too much. Just keep in mind, that memory + //manager can report about leak in RTTITypesDict when program closing, + //if leakage detection enabled. + if Assigned(RTTITypesDict) then + RTTITypesDict.Free; +end; + +function GetOrSearchRTTIType(ScriptTypeName : String; var DRttiType : TRttiType) : Boolean; +var RttiType : TRttiType; +begin + InitRTTITypesDictInstance; + TMonitor.Enter(RTTITypesDict); + try + if not RTTITypesDict.TryGetValue(ScriptTypeName, DRttiType) then + begin + DRttiType := nil; + for RttiType in ctx.GetTypes do + if (RttiType.Name.ToUpper.EndsWith(ScriptTypeName)) then + begin + DRttiType := RttiType; + Break; + end; + RTTITypesDict.AddOrSetValue(ScriptTypeName, DRttiType); + end; + Result := Assigned(DRttiType); + finally + TMonitor.Exit(RTTITypesDict); end; +end; + +{$if not declared(BoolToTxt)} +function BoolToTxt(B: Boolean): string; +begin + if B then + Result := 'True' + else + Result := 'False'; +end; +{$ifend} + +{$if not declared(PSBaseTypeToStr)} +function PSBaseTypeToStr(Self: PIFTypeRec): string; +var i: Longint; +begin + case Self.BaseType of + btU8 : Result := 'U8'; + btS8 : Result := 'S8'; + btU16 : Result := 'U16'; + btS16 : Result := 'S16'; + btU32 : Result := 'U32'; + btS32 : Result := 'S32'; + btSingle : Result := 'Single'; + btDouble : Result := 'Double'; + btExtended : Result := 'Extended'; + btString : Result := {$if btCharIsWide}'UnicodeString'{$else}'AnsiString'{$ifend}; + btRecord : begin + Result := 'Record'; + i := TPSTypeRec_Record(Self).FieldTypes.Count; + if (i > 0) then begin + Result := Result+'(' + + PSBaseTypeToStr(PIFTypeRec(TPSTypeRec_Record(Self).FieldTypes[0])); + for i := 1 to i-1 do + Result := Result+',' + + PSBaseTypeToStr(PIFTypeRec(TPSTypeRec_Record(Self).FieldTypes[i])); + Result := Result + ')'; + end; + end; + btArray : Result := 'Array of '+PSBaseTypeToStr(TPSTypeRec_Array(Self).ArrayType); + btPointer : Result := 'Pointer'; + btPChar : Result := {$if btCharIsWide}'PWideChar'{$else}'PAnsiChar'{$ifend}; + btResourcePointer : Result := 'ResourcePointer'; + btVariant : Result := 'Variant'; + {$IFNDEF PS_NOINT64} + btS64 : Result := 'S64'; + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btU64 : Result := 'U64'; + {$ENDIF} + btChar : Result := {$if btCharIsWide}'WideChar'{$else}'AnsiChar'{$ifend}; + {$IFNDEF PS_NOWIDESTRING} + btWideString : Result := 'WideString'; + btWideChar : Result := 'WideChar'; + {$ELSE} + {$IFDEF UNICODE} + btWideChar : Result := 'WideChar'; + {$ENDIF} + {$ENDIF} + btProcPtr : Result := 'ProcPtr'; + btStaticArray : Result := 'StaticArray' + + '['+SysUtils.IntToStr(TPSTypeRec_StaticArray(Self).Size) + + '] of '+PSBaseTypeToStr(TPSTypeRec_Array(Self).ArrayType) + ; + btSet : Result := 'Set'; + btCurrency : Result := 'Currency'; + btClass : Result := 'Class' + //+ ': '+string(TPSTypeRec_Class(Self).CN) + ; + btInterface : Result := 'Interface'; + btNotificationVariant : Result := 'NotificationVariant'; + btUnicodeString : Result := 'UnicodeString'; + {$if declared(btPWideChar)} + btPWideChar : Result := 'PWideChar'; + {$ifend} + btType : Result := 'Type'; + btEnum : Result := 'Enum'; + btExtClass : Result := 'ExtClass'; + else Result := 'Unknown '+SysUtils.IntToStr(Self.BaseType); + end; // case +end; // function PSBaseTypeToStr +{$ifend} + +{$if not declared(PSParamTypeToStr)} +function PSParamTypeToStr(P: PPSVariantIFC): string; +begin + Result := ''; + if P = nil then + Exit; + Result := 'type var: '+BoolToTxt(P.VarParam)+' "' + + 'BT: '+SysUtils.IntToStr(Integer(P.aType.BaseType)) + + ', ' + PSBaseTypeToStr(P.aType) + ; + if P.aType.ExportName <> '' then + Result := Result + + '; EN: '+string(P.aType.ExportName); + Result := Result + + '; SZ: '+string(SysUtils.IntToStr(Integer(P.aType.RealSize))) + + '"' + ; +end; +{$ifend} + +function DoInvoke(CodeAddress: Pointer; const Args: TArray; + CallingConvention: TCallConv; AResultType: PTypeInfo; + IsStatic : Boolean = False; IsConstructor: Boolean = False): TValue; +begin + Result := Invoke(CodeAddress,Args,CallingConvention,AResultType,IsStatic + {$if defined(FPC) or defined(DELPHI23UP)} + ,{IsConstructor:}IsConstructor + {$ifend} + ); +end; - if Assigned(_Self) then - Args := Args + [TValue.From( _Self )]; +function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; + Params: TPSList; res: PPSVariantIFC): Boolean; +{$IFNDEF FPC} +var + ExtraSizeRes : Integer; + CustomTypeRes : PTypeInfo; + TypeData: PTypeData; - for I := 0 to Params.Count - 1 do + function InvokeWithResTypeByKindSize(CodeAddress: Pointer; const Args: TArray; + CallingConvention: TCallConv; RTypeKind : TTypeKind = tkUnknown; RTypeSize: Longint = 0; IsStatic : Boolean = False): TValue; begin - if Params[i] = nil - then Exit; - fvar := Params[i]; - - if fvar.varparam then - begin { var param } - 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, - btUnicodeString - {$IFNDEF PS_NOINT64}, bts64{$ENDIF}: - Arg := TValue.From( Pointer(fvar.dta) ); - else - begin - Exit; - end; + case RTypeKind of + tkArray: ExtraSizeRes := SizeOf(TArrayTypeData); + tkRecord: ExtraSizeRes := 2*SizeOf(Integer); + tkDynArray: ExtraSizeRes := (2*SizeOf(Integer)) + (2*SizeOf(PPTypeInfo)) + + SizeOf({$IFDEF FPC}ShortStringBase{$ELSE}TSymbolName{$ENDIF}); + tkSet : ExtraSizeRes := SizeOf(UInt8) + SizeOf(PPTypeInfo); + else raise EInvocationError.Create('Unknown TypeKind in InvokeWithResTypeByKindSize!'); + end; + CustomTypeRes := AllocMem(SizeOf(TTypeInfo) + ExtraSizeRes); + try + CustomTypeRes.Kind := RTypeKind; + TypeData := GetTypeData(CustomTypeRes); + case CustomTypeRes.Kind of + tkArray: + begin + TypeData^.ArrayData.Size := RTypeSize; + TypeData^.ArrayData.{$IFDEF FPC}ElTypeRef{$ELSE}ElType{$ENDIF} := AllocMem(SizeOf(Pointer)); + TypeData^.ArrayData.{$IFDEF FPC}ElTypeRef{$ELSE}ElType{$ENDIF}^:= TypeInfo(Byte); + end; + tkSet : + begin + {$IFDEF FPC} + TypeData^.SetSize := RTypeSize; + {$ELSE} + {$IFDEF DELPHI26UP} + TypeData^.SetTypeOrSize := $80 or RTypeSize; + {$ENDIF} + {$ENDIF} + end; + tkRecord: + begin + TypeData^.RecSize := RTypeSize; + TypeData^.ManagedFldCount := 0; + end; + tkDynArray: + begin + TypeData^.elSize := RTypeSize; + TypeData^.{$IFDEF FPC}ElTypeRef{$ELSE}ElType{$ENDIF} := nil; + TypeData^.{$IFDEF FPC}elType2Ref{$ELSE}ElType2{$ENDIF} := AllocMem(SizeOf(Pointer)); + TypeData^.{$IFDEF FPC}elType2Ref{$ELSE}ElType2{$ENDIF}^:= TypeInfo(Byte); + end; end; - end - else - begin { not a var param } - case fvar.aType.BaseType of - { add normal params here } - {$IFNDEF PS_NOWIDESTRING} - btWidestring, - btUnicodestring, - {$ENDIF} - btString: Arg := TValue.From(pstring(fvar.dta)^); - btU8, btS8: Arg := TValue.From(pbyte(fvar.dta)^); - btU16, BtS16: Arg := TValue.From(pword(fvar.dta)^); - btU32, btS32: Arg := TValue.From(pCardinal(fvar.dta)^); - {$IFNDEF PS_NOINT64}bts64:{$ENDIF} Arg := TValue.From(pint64(fvar.dta)^); - btSingle: Arg := TValue.From(PSingle(fvar.dta)^); - btDouble: Arg := TValue.From(PDouble(fvar.dta)^); - btExtended: Arg := TValue.From(PExtended(fvar.dta)^); - btPChar: Arg := TValue.From(ppchar(fvar.dta)^); - btChar: Arg := TValue.From(pchar(fvar.dta)^); - btClass: Arg := TValue.From(TObject(fvar.dta^)); - btRecord: Arg := TValue.From(fvar.dta); - btStaticArray: Arg := TValue.From(fvar.dta); - btVariant: - Arg := TValue.From(Variant(fvar.dta^)); - btArray: - begin - if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then - begin //openarray - //in case of openarray we should provide TWO params: first is pointer to array, - Args := Args + [TValue.From(Pointer(fvar.Dta^))]; - //2nd - integer with arraylength - 1 (high) - Arg := TValue.From(PSDynArrayGetLength(Pointer(fvar.Dta^), fvar.aType)-1);// = High of OpenArray - end - else //dynarray = just push pointer - Arg := TValue.From(fvar.dta); - end; - btSet: - begin - case TPSTypeRec_Set(fvar.aType).aByteSize of - 1: Arg := TValue.From(pbyte(fvar.dta)^); - 2: Arg := TValue.From(pWord(fvar.dta)^); - 3, - 4: Arg := TValue.From(pCardinal(fvar.dta)^); - else - Arg := TValue.From(fvar.dta); - end; - end; - else -// writeln(stderr, 'Parameter type not implemented!'); - Exit; - end; { case } + Result := DoInvoke(CodeAddress,Args,CallingConvention,CustomTypeRes,IsStatic,False); + except + Result := nil; end; - Args := Args + [Arg]; end; + {$ENDIF} + + function InnerfuseCallReal(Exec : TPSExec;_Self, Address: Pointer; CallingConv: TPSCallingConvention; + Params: TPSList; res: PPSVariantIFC): Boolean; + + function rp(p: PPSVariantIFC): PPSVariantIFC; + begin + if (p = nil) or (p.aType = nil) then begin + Result := nil; + Exit; + end; + if (p.aType.BaseType = btPointer) then begin + p^.aType := Pointer(Pointer(IPointer(p^.Dta) + PointerSize)^); + p^.Dta := Pointer(p^.Dta^); + end; + Result := p; + end; + + var + Args: TArray; + ArgIdx : Integer; + + procedure AddArg(Arg : TValue); + begin + Inc(ArgIdx); + Args[ArgIdx] := Arg; + end; - IsConstr := (Integer(CallingConv) and 64) <> 0; - if not assigned(res) then + var SysCalConv : TCallConv; + Arg : TValue; + i : Integer; + fvar: PPSVariantIFC; + IsConstr, IsStatic : Boolean; + ResValue : TValue; + S: string; + RttiType : TRttiType; + {%H-}p: Pointer; + {%H-}pp: ^Byte; + {%H-}CallData : TPSList; begin - Invoke(Address,Args,SysCalConv,nil,False,IsConstr); { ignore return } - end - else begin - case res.atype.basetype of - { add result types here } - btString: tbtstring(res.dta^) := tbtstring(Invoke(Address,Args,SysCalConv,TypeInfo(String),False,IsConstr).AsString) - ; - {$IFNDEF PS_NOWIDESTRING} - btUnicodeString: tbtunicodestring(res.dta^) := Invoke(Address,Args,SysCalConv,TypeInfo(String),False,IsConstr).AsString; - btWideString: tbtWideString(res.dta^) := Invoke(Address,Args,SysCalConv,TypeInfo(String),False,IsConstr).AsString; - {$ENDIF} - btU8, btS8: pbyte(res.dta)^ := Byte(Invoke(Address,Args,SysCalConv,TypeInfo(Byte),False,IsConstr).AsInteger); - btU16, btS16: pword(res.dta)^ := word(Invoke(Address,Args,SysCalConv,TypeInfo(Word),False,IsConstr).AsInteger); - btU32, btS32: pCardinal(res.dta)^ := Cardinal(Invoke(Address,Args,SysCalConv,TypeInfo(Cardinal),False,IsConstr).AsInteger); - {$IFNDEF PS_NOINT64}bts64:{$ENDIF} pInt64(res.dta)^ := Int64(Invoke(Address,Args,SysCalConv,TypeInfo(Int64),False,IsConstr).AsInt64); - btSingle: psingle(res.dta)^ := Double(Invoke(Address,Args,SysCalConv,TypeInfo(Single),False,IsConstr).AsExtended); - btDouble: pdouble(res.dta)^ := Double(Invoke(Address,Args,SysCalConv,TypeInfo(Double),False,IsConstr).AsExtended); - btExtended: pextended(res.dta)^ := Extended(Invoke(Address,Args,SysCalConv,TypeInfo(Extended),False,IsConstr).AsExtended); - {$IFDEF FPC} - btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),False,IsConstr).AsOrdinal); - btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),False,IsConstr).AsChar); - {$ELSE} - btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),False,IsConstr).AsType()); - btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),False,IsConstr).AsType()); + Result := False; + case CallingConv of + cdRegister : begin SysCalConv := ccReg; end; + cdPascal : begin SysCalConv := ccPascal; end; + cdCdecl : begin SysCalConv := ccCdecl; end; + cdStdCall : begin SysCalConv := ccStdCall; end; + cdSafeCall : begin SysCalConv := ccSafeCall; end; + {$IFNDEF FPC} + else begin SysCalConv := ccReg; end; // to prevent warning "W1036 Variable might not have been initialized" {$ENDIF} - btSet: - begin - case TPSTypeRec_Set(res.aType).aByteSize of - 1: byte(res.Dta^) := Byte(Invoke(Address,Args,SysCalConv,TypeInfo(Byte),False,IsConstr).AsInteger); - 2: word(res.Dta^) := word(Invoke(Address,Args,SysCalConv,TypeInfo(Word),False,IsConstr).AsInteger); - 3, - 4: Longint(res.Dta^) := Cardinal(Invoke(Address,Args,SysCalConv,TypeInfo(Cardinal),False,IsConstr).AsInteger); - {$IFNDEF FPC} - else - begin - for RttiType in ctx.GetTypes do - if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkSet) - and (RttiType.TypeSize = TPSTypeRec_Set(res.aType).aByteSize) then + end; + + IsConstr := (Integer(CallingConv) and 64) <> 0; + + {$IFDEF FPC} // FPC: FIX FOR FPC constructor calls + //x64.inc: {$if defined(FPC) and (fpc_version >= 3)} + //x86.inc: {$ifdef FPC} + case CallingConv of cdRegister + // dcc: Warning: W1023 Comparing signed and unsigned types - widened both operands + // => Integer(fpc_version) + {$if defined(CPU32) or (declared(fpc_version) and (Integer(fpc_version) >= 3)) } // TODO: FPC: test and check other platforms + {$IFDEF CPU32} + if (CallingConv = cdRegister) then + {$ENDIF } + begin + if IsConstr then begin + fvar := Params[0]; + p := rp(fvar); + if p = nil then + Exit; // this goes first // internal error + case fVar.aType.BaseType of + btArray, + btVariant, + btSet, + btStaticArray, + btRecord, + btInterface, + btClass, + {$IFNDEF PS_NOWIDESTRING} + btUnicodeString, btWideString, btWideChar, + {$if declared(btPWideChar)} + btPWideChar, + {$ifend} + {$ENDIF !PS_NOWIDESTRING} + btU8, btS8, btU16, + btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency + {$IFNDEF PS_NOINT64} + ,bts64 + {$ENDIF} + {$IFNDEF PS_NOUINT64} + ,btu64 + {$ENDIF} + ,btProcPtr + : { empty } ; + else + Exit; // this goes first // internal error + end; // case + DisposePPSVariantIFC(p); + Params.Delete(0); + end; + end; + {$ifend} + {$ENDIF FPC} + + ArgIdx := -1; + SetLength(Args, 2*Params.Count+1); // maximum params + + IsStatic := not Assigned(_Self); + if Assigned(_Self) then + AddArg( TValue.From( _Self ) ); + + CallData := nil; + try + for I := 0 to Params.Count - 1 do + begin + if Params[i] = nil then + raise EInvocationError.Create('Internal: Unassigned parameter #"' + + SysUtils.IntToStr(i) + '"!'); + + fvar := Params[i]; + + fvar := rp(PPSVariantIFC(fvar)); + + if fvar = nil then + raise EInvocationError.Create('Internal: Unassigned parameter ref #"' + + SysUtils.IntToStr(i) + '"!'); + + Arg := nil; + if fvar.varparam then + begin { var param } + case fvar.aType.BaseType of + btArray: + begin + if Copy(fVar.aType.ExportName, 1, 10) = '!OPENARRAY' then begin - Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr).ExtractRawData(res.dta); - Break; - end; - end; + p := CreateOpenArray(True, Exec, fVar); + if p = nil then + raise EInvocationError.Create('Internal: ' + 'CreateOpenArray call for var param failed!'); + + if CallData = nil then + CallData := TPSList.Create; + CallData.Add(p); + + + Arg := TValue.From( Pointer(POpenArray(p)^.Data) ); + AddArg(Arg); + Arg := TValue.From( Longint(POpenArray(p)^.ItemCount-1) ); //?? type IPointer + + end + else + Arg := TValue.From( Pointer(fvar.Dta) ); + end; + btVariant, + btSet, + btStaticArray, + btRecord, + btInterface, + btClass, + {$IFNDEF PS_NOWIDESTRING} + btUnicodeString, btWideString, btWideChar, + {$if declared(btPWideChar)} + btPWideChar, + {$ifend} + {$ENDIF !PS_NOWIDESTRING} + btU8, btS8, btU16, + btS16, btU32, btS32, btSingle, btDouble, btExtended, + btString, btPChar, btChar, btCurrency + {$IFNDEF PS_NOINT64} + ,bts64 {$ENDIF} + {$IFNDEF PS_NOUINT64} + ,btu64 + {$ENDIF}: begin + Arg := TValue.From( Pointer(fvar.Dta) ); + end; + + else + begin + {$if declared(PSParamTypeToStr)} + S := '@Var Param: '+PSParamTypeToStr(fvar) + + '" not implemented!'; + {$else} + S := '@Var Paramtype '+ SysUtils.IntToStr(fvar.aType.BaseType) + + '" not implemented!'; + {$ifend} // "$if declared(PSParamTypeToStr)" + raise EInvocationError.Create('Internal: ' + S); // optional + Exit; + end; end; + end + else + begin { not a var param } + case fvar.aType.BaseType of { add normal params here } + {$IFNDEF PS_NOWIDESTRING} + btWidestring: Arg := TValue.From( PWideString(fvar.Dta)^ ); + btUnicodeString: Arg := TValue.From( PUnicodeString(fvar.Dta)^ ); + {$ENDIF} + {$if btCharIsWide} // unicode string + btString: Arg := TValue.From( PUnicodeString(fvar.Dta)^ ); + {$else} // ansi string + btString: Arg := TValue.From( PAnsiString(fvar.Dta)^ ); + {$ifend} + btU8, btS8: Arg := TValue.From( PByte(fvar.Dta)^ ); + btU16, BtS16: Arg := TValue.From( PWord(fvar.Dta)^ ); + btU32, btS32: Arg := TValue.From( PCardinal(fvar.Dta)^ ); + {$IFNDEF PS_NOINT64} + btS64: Arg := TValue.From( PInt64(fvar.Dta)^ ); + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btU64: Arg := TValue.From( PUInt64(fvar.Dta)^ ); + {$ENDIF} + btSingle: Arg := TValue.From( PSingle(fvar.Dta)^ ); + btDouble: Arg := TValue.From( PDouble(fvar.Dta)^ ); + btExtended: Arg := TValue.From( PExtended(fvar.Dta)^ ); + btCurrency: Arg := TValue.From( PCurrency(fvar.Dta)^ ); + {$if btCharIsWide} // unicode + btPChar: //-Arg := TValue.From( PPWideChar(fvar.Dta)^ ); + if Pointer(fVar.Dta^) = nil then + Arg := TValue.From( PPWideChar(@EmptyPChar)^ ) + else + Arg := TValue.From( PPWideChar(fvar.Dta)^ ); + {$else} // ansi + btPChar: //-Arg := TValue.From( PPAnsiChar(fvar.Dta)^ ); + if Pointer(fVar.Dta^) = nil then + Arg := TValue.From( PPAnsiChar(@EmptyPChar)^ ) + else + Arg := TValue.From( PPAnsiChar(fvar.Dta)^ ); + {$ifend} + {$IFNDEF PS_NOWIDESTRING} + btWideChar: Arg := TValue.From( PWideChar(fvar.Dta)^ ); + {$if declared(btPWideChar)} + btPWideChar: //-Arg := TValue.From( PPWideChar(fvar.Dta)^ ); + if Pointer(fVar.Dta^) = nil then + Arg := TValue.From( PPWideChar(@EmptyPChar)^ ) + else + Arg := TValue.From( PPWideChar(fvar.Dta)^ ); + {$ifend} + {$ENDIF !PS_NOWIDESTRING} + {$if btCharIsWide} // unicode char + btChar: Arg := TValue.From( PWideChar(fvar.Dta)^ ); + {$else} // ansi char + btChar: Arg := TValue.From( PAnsiChar(fvar.Dta)^ ); + {$ifend} + btClass: Arg := TValue.From( TObject(fvar.Dta^) ); + btPointer: Arg := TValue.From( PPointer(fvar.Dta)^ ); + btProcPtr: + begin + Arg := TValue.From( MKMethod(Exec, Longint(fVar.Dta^)) ); // +x64, -x86 + end; + btInterface: + begin + Arg := TValue.From( PPointer(fvar.Dta)^ ); + end; + btRecord: + begin + //Arg := TValue.From(fvar.Dta); + if fVar.aType.RealSize <= SizeOf(Pointer) then + Arg := TValue.From( IPointer(fvar.Dta^) ) + else + Arg := TValue.From( Pointer(fvar.Dta) ); + end; + btStaticArray: Arg := TValue.From( Pointer(fvar.Dta) ); + btArray: + begin + if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then + begin + p := CreateOpenArray(False, Exec, fVar); + if p = nil then + raise EInvocationError.Create('Internal: ' + 'CreateOpenArray call for param failed!'); + + if CallData = nil then + CallData := TPSList.Create; + CallData.Add(p); + + //in case of openarray we should provide TWO params: first is pointer to array, + Arg := TValue.From( Pointer(POpenArray(p)^.Data) ); + AddArg(Arg); + + //2nd - integer with arraylength - 1 (high) + Arg := TValue.From( Integer (POpenArray(p)^.ItemCount-1) ); //?? type IPointer + end + else //dynarray = just push pointer: + Arg := TValue.From( PPointer(fvar.Dta){$IFNDEF FPC}^{$ENDIF} ); + end; + btVariant: Arg := TValue.From( Pointer(fvar.Dta) ); + btSet: + case TPSTypeRec_Set(fvar.aType).aByteSize of + 1: Arg := TValue.From (PByte (fvar.Dta)^); + 2: Arg := TValue.From (PWord (fvar.Dta)^); + 3,4: Arg := TValue.From(PCardinal(fvar.Dta)^); + {$IFDEF FPC} + 5,6,7,8: Arg := TValue.From (PInt64 (fvar.Dta)^); + {$ENDIF} + else Arg := TValue.From (Pointer (fvar.Dta)); + end; // case + + else + begin + {$if declared(PSParamTypeToStr)} + S := '@Param: '+PSParamTypeToStr(fvar) + + '" not implemented!'; + {$else} + S := '@Paramtype '+ SysUtils.IntToStr(fvar.aType.BaseType) + + '" not implemented!'; + {$ifend} // "$if declared(PSParamTypeToStr)" + raise EInvocationError.Create('Internal: ' + S); // optional + Exit; + end; + end; { case } + end; { if "not a var param" } + + if (Arg.Kind <> tkClass) and (Arg.IsEmpty) then //Obj value can be nil, why not? + begin + {$if declared(PSParamTypeToStr)} + S := '#Param '+PSParamTypeToStr(fvar) + + '" not detected!'; + + raise EInvocationError.Create('Internal: ' + S); // optional + {$ifend} // "$if declared(PSParamTypeToStr)" + //Exit; end; - btClass: - begin - {$IFNDEF FPC}for RttiType in ctx.GetTypes do - if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkClass) then{$ENDIF} - begin - TObject(res.dta^) := Invoke(Address,Args,SysCalConv,{$IFDEF FPC}TypeInfo(TObject){$ELSE}RttiType.Handle{$ENDIF},False,IsConstr).AsObject; - {$IFNDEF FPC}Break;{$ENDIF} - end; + AddArg(Arg); end; - {$IFNDEF FPC} - btStaticArray: + SetLength(Args, ArgIdx+1); // truncate args + + res := rp(PPSVariantIFC(res)); + if Assigned(res) then + res.VarParam := True; + + if not assigned(res) then + DoInvoke(Address,Args,SysCalConv,nil,IsStatic,IsConstr) { ignore return } + else begin - for RttiType in ctx.GetTypes do - if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkArray) then + case res.aType.BaseType of { add result types here } + {$if btCharIsWide} + btString: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(UnicodeString),IsStatic,IsConstr); + {$IFDEF FPC} + TbtString(res.Dta^) := TbtString( ResValue.AsUnicodeString ); + {$ELSE} + TbtString(res.Dta^) := TbtString( ResValue.AsType ); + {$ENDIF} + end; + {$else} + btString: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(AnsiString), IsStatic,IsConstr); + {$IFDEF FPC} + TbtString(res.Dta^) := TbtString( ResValue.AsAnsiString ); + {$ELSE} + TbtString(res.Dta^) := TbtString( ResValue.AsType ); + {$ENDIF} + end; + {$ifend} + {$IFNDEF PS_NOWIDESTRING} + btUnicodeString: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(UnicodeString),IsStatic,IsConstr); + {$IFDEF FPC} + {TbtUnicodeString}UnicodeString(res.Dta^) := ResValue.AsUnicodeString; + {$ELSE} + {TbtUnicodeString}UnicodeString(res.Dta^) := ResValue.AsType; + {$ENDIF} + end; + btWideString: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(WideString),IsStatic,IsConstr); + {$IFDEF FPC} + {TbtWideString}WideString(res.Dta^) := ResValue.AsUnicodeString; + {$ELSE} + {TbtWideString}WideString(res.Dta^) := ResValue.AsType; + {$ENDIF} + end; + {$ENDIF} + btU8, btS8: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(Byte),IsStatic,IsConstr); + {$IFDEF FPC} + PByte(res.Dta)^ := Byte(ResValue.AsOrdinal); + {$ELSE} + PByte(res.Dta)^ := ResValue.AsType + {$ENDIF} + end; + btU16, btS16: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(Word),IsStatic,IsConstr); + {$IFDEF FPC} + PWord(res.Dta)^ := Word(ResValue.AsOrdinal); + {$ELSE} + PWord(res.Dta)^ := ResValue.AsType; + {$ENDIF} + end; + btU32, btS32: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(Cardinal),IsStatic,IsConstr); + {$IFDEF FPC} + PCardinal(res.Dta)^ := Cardinal(ResValue.AsOrdinal); + {$ELSE} + PCardinal(res.Dta)^ := ResValue.AsType; + {$ENDIF} + end; + {$IFNDEF PS_NOINT64} + btS64: begin + PInt64(res.Dta)^ := DoInvoke(Address,Args,SysCalConv, + TypeInfo(Int64),IsStatic,IsConstr).AsInt64; + end; + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btU64: begin + PInt64(res.Dta)^ := DoInvoke(Address,Args,SysCalConv, + TypeInfo(UInt64),IsStatic,IsConstr).AsUInt64; + end; + {$ENDIF} + btCurrency: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(Currency),IsStatic,IsConstr); + {$IFDEF FPC} + PCurrency(res.Dta)^ := ResValue.AsCurrency; + {$ELSE} + PCurrency(res.Dta)^ := ResValue.AsType; + {$ENDIF} + end; + btSingle: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(Single),IsStatic,IsConstr); + {$IFDEF FPC} + PSingle(res.Dta)^ := ResValue.AsExtended; + {$ELSE} + PSingle(res.Dta)^ := ResValue.AsType; + {$ENDIF} + end; + btDouble: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(Double),IsStatic,IsConstr); + {$IFDEF FPC} + PDouble(res.Dta)^ := ResValue.AsExtended; + {$ELSE} + PDouble(res.Dta)^ := ResValue.AsType; + {$ENDIF} + end; + btExtended: begin + PExtended(res.Dta)^ := DoInvoke(Address,Args,SysCalConv, + TypeInfo(Extended),IsStatic,IsConstr).AsExtended; + end; + {$if btCharIsWide} // unicode + btPChar: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(PWideChar),IsStatic,IsConstr); + {$IFDEF FPC} + {PTbtChar}PWideChar(res.Dta^) := PWideChar(ResValue.AsOrdinal); + {$ELSE} + {PTbtChar}PWideChar(res.Dta^) := ResValue.AsType; + {$ENDIF} + end; + {$else} // ansi + btPChar: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(PAnsiChar),IsStatic,IsConstr); + {$IFDEF FPC} + {PTbtChar}PAnsiChar(res.Dta^) := PAnsiChar(ResValue.AsOrdinal); + {$ELSE} + {PTbtChar}PAnsiChar(res.Dta^) := ResValue.AsType; + {$ENDIF} + end; + {$ifend} + {$if btCharIsWide} // unicode + btChar: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(WideChar),IsStatic,IsConstr); + {$IFDEF FPC} + {TbtChar}WideChar(res.Dta^) := ResValue.AsWideChar; + {$ELSE} + {TbtChar}WideChar(res.Dta^) := ResValue.AsType; + {$ENDIF} + end; + {$else} // ansi + btChar: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(AnsiChar),IsStatic,IsConstr); + {$IFDEF FPC} + {TbtChar}AnsiChar(res.Dta^) := ResValue.AsAnsiChar; + {$ELSE} + {TbtChar}AnsiChar(res.Dta^) := ResValue.AsType; + {$ENDIF} + end; + {$ifend} + {$IFNDEF PS_NOWIDESTRING} + btWideChar: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(WideChar),IsStatic,IsConstr); + {$IFDEF FPC} + {TbtWideChar}PWideChar(res.Dta)^ := ResValue.AsWideChar; + {$ELSE} + {TbtWideChar}PWideChar(res.Dta)^ := ResValue.AsType; + {$ENDIF} + end; + {$if declared(btPWideChar)} + btPWideChar: begin + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(PWideChar),IsStatic,IsConstr); + {$IFDEF FPC} + {PTbtWideChar}PWideChar(res.Dta^) := PWideChar(ResValue.AsOrdinal); + {$ELSE} + {PTbtWideChar}PWideChar(res.Dta^) := ResValue.AsType; + {$ENDIF} + end; + {$ifend} + {$ENDIF} + btInterface: begin // TODO: pult: ... ?empty ; check RefCount // + ResValue := DoInvoke(Address,Args,SysCalConv, + TypeInfo(IInterface),IsStatic,IsConstr); + {$IFDEF FPC} + IInterface(res.Dta^) := ResValue.AsInterface; + {$ELSE} + IInterface(res.Dta^) := ResValue.AsType; + {$ENDIF} + end; + btClass: begin + ResValue := DoInvoke(Address,Args,SysCalConv,TypeInfo(TObject),IsStatic,IsConstr); + TObject(res.Dta^) := ResValue.AsObject; + end; + btVariant: begin + {$IFDEF FPC} + ResValue := DoInvoke(Address,Args,SysCalConv,TypeInfo(TVarData), IsStatic); + ResValue.ExtractRawData(res.Dta); + {$ELSE} + ResValue := DoInvoke(Address,Args,SysCalConv,TypeInfo(Variant), IsStatic); + ResValue.ExtractRawData(res.Dta); + {$ENDIF} + end; + btProcPtr: begin + ResValue := DoInvoke(Address,Args,SysCalConv,TypeInfo(TMethod), IsStatic); + {$IFDEF FPC} + ResValue.ExtractRawData(res.Dta); + {$ELSE} + Pointer(Pointer(IPointer(res.Dta)+PointerSize)^) := ResValue.AsType.Data; + Pointer(Pointer(IPointer(res.Dta)+PointerSize2)^) := ResValue.AsType.Code; + {$ENDIF} + end; + btSet: begin - CopyArrayContents(res.dta, Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr).GetReferenceToRawData, TPSTypeRec_StaticArray(res.aType).Size, TPSTypeRec_StaticArray(res.aType).ArrayType); - Break; + if GetOrSearchRTTIType(String(res.aType.FExportName),RttiType) then + begin + ResValue := DoInvoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic); + p := ResValue.GetReferenceToRawData; + Move(p^, res.Dta^, TPSTypeRec_Set(res.aType).aByteSize); + end + else + case TPSTypeRec_Set(res.aType).aByteSize of + 1: Byte(res.Dta^) := Byte(DoInvoke(Address,Args,SysCalConv,TypeInfo(Byte), IsStatic).AsInteger); + 2: Word(res.Dta^) := Word(DoInvoke(Address,Args,SysCalConv,TypeInfo(Word), IsStatic).AsInteger); + 3, + 4: Longint(res.Dta^) := Cardinal(DoInvoke(Address,Args,SysCalConv,TypeInfo(Cardinal),IsStatic,IsConstr).AsInteger); + 5,6,7,8: + begin + {$IFDEF FPC} + Int64(res.Dta^) := Cardinal(DoInvoke(Address,Args,SysCalConv,TypeInfo(Int64),IsStatic,IsConstr).AsInt64); + {$ELSE} + {$IFDEF DELPHI26UP} + ResValue := InvokeWithResTypeByKindSize(Address,Args,SysCalConv, tkSet, + TPSTypeRec_Set(res.aType).aByteSize, IsStatic); + p := ResValue.GetReferenceToRawData; + Move(p^, res.Dta^, TPSTypeRec_Set(res.aType).aByteSize); + {$ELSE} + S := 'Large sets setting available only in Delphi Rio+'; + raise EInvocationError.Create('Internal error: ' + S); // optional + {$ENDIF} + {$ENDIF} + end; + end; // case end; - end; - btRecord: - begin - for RttiType in ctx.GetTypes do - if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkRecord) then + btStaticArray: begin - CopyArrayContents(res.dta, (Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr).GetReferenceToRawData), 1, res.aType); - Break; + if GetOrSearchRTTIType(String(res.aType.FExportName),RttiType) then + begin + ResValue := DoInvoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic); + CopyArrayContents(res.dta, ResValue.GetReferenceToRawData, + TPSTypeRec_StaticArray(res.aType).Size, TPSTypeRec_StaticArray(res.aType).ArrayType); + end + else + begin + {$IFDEF FPC} + ResValue := Invoke(Address,Args,SysCalConv,TypeInfo(Pointer),IsStatic,IsConstr); + PPointer(res.Dta)^ := Pointer(ResValue.AsOrdinal); + {$ELSE !FPC} + ResValue := InvokeWithResTypeByKindSize(Address,Args,SysCalConv, tkArray, + TPSTypeRec_StaticArray(res.aType).Size * TPSTypeRec_StaticArray(res.aType).ArrayType.RealSize, + IsStatic); + CopyArrayContents(res.dta, ResValue.GetReferenceToRawData, + TPSTypeRec_StaticArray(res.aType).Size, TPSTypeRec_StaticArray(res.aType).ArrayType); + {$ENDIF !FPC} + end; + end; + btRecord: + begin + if GetOrSearchRTTIType(String(res.aType.FExportName),RttiType) then + begin + ResValue := DoInvoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic); + CopyRecordContents(res.Dta, ResValue.GetReferenceToRawData, TPSTypeRec_Record(res.aType)); + end + else + begin + {$IFDEF FPC} + ResValue := Invoke(Address,Args,SysCalConv,TypeInfo(Pointer),IsStatic,IsConstr); + PPointer(res.Dta)^ := Pointer(ResValue.AsOrdinal); + {$ELSE !FPC} + ResValue := InvokeWithResTypeByKindSize(Address,Args,SysCalConv, tkRecord, res.aType.RealSize, IsStatic); + CopyRecordContents(res.Dta, ResValue.GetReferenceToRawData, TPSTypeRec_Record(res.aType)); + {$ENDIF !FPC} + end; end; - end; - btArray: //need to check with open arrays - begin - for RttiType in ctx.GetTypes do - if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkDynArray) then + btArray: //open arrays can't be returned. So, just DynArray here. begin - ResValue := Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr); - if ResValue.GetArrayLength > 0 then - CopyArrayContents(res.dta, ResValue.GetReferenceToRawData, 1, res.aType) + if GetOrSearchRTTIType(String(res.aType.FExportName),RttiType) then + begin + ResValue := DoInvoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic); + CopyArrayContents(res.Dta, ResValue.GetReferenceToRawData, 1, res.aType); + end else - res.dta := nil; - Break; + begin + {$IFDEF FPC} + ResValue := Invoke(Address,Args,SysCalConv,TypeInfo(Pointer),IsStatic,IsConstr); + PPointer(res.Dta)^ := Pointer(ResValue.AsOrdinal); + {$ELSE !FPC} + ResValue := InvokeWithResTypeByKindSize(Address,Args,SysCalConv, tkDynArray, + PSDynArrayGetLength(Pointer(res.Dta^), res.aType),IsStatic); + CopyArrayContents(res.Dta, ResValue.GetReferenceToRawData, 1, res.aType) + {$ENDIF !FPC} + end; end; + else + begin + {$if declared(PSParamTypeToStr)} + S := '$Param '+PSParamTypeToStr(res) + + '" not implemented!'; + + raise EInvocationError.Create('Internal: ' + S); // optional + {$ifend} // "$if declared(PSParamTypeToStr)" + Exit; + end; + end; { case } + end; //assigned(res) + + Result := True; + finally + if Assigned(CallData) then begin + for i := CallData.Count-1 downto 0 do begin + pp := CallData[i]; + case pp^ of + 0: begin + DestroyOpenArray(Exec, Pointer(pp)); + end; + 254: begin + FreeMem(pp); + end; + end; // case + end; // for + CallData.Free; + end; // if + end; // finally + end; //InnerfuseCall + +begin + {$IFNDEF FPC} + CustomTypeRes := nil; + {$ENDIF} + try + Result := InnerfuseCallReal(Self, _Self,Address,CallingConv,Params, res); + finally + {$IFNDEF FPC} + if Assigned(CustomTypeRes) then + begin + TypeData := GetTypeData(CustomTypeRes); + case CustomTypeRes.Kind of + tkArray: FreeMem(TypeData^.ArrayData.ElType, SizeOf(Pointer)); + tkDynArray: FreeMem(TypeData^.elType2, SizeOf(Pointer)); end; - btVariant: - begin - PVariant(res.dta)^ := Invoke(Address, Args, SysCalConv, TypeInfo(Variant), False, IsConstr).AsVariant; - end; - {$ENDIF} - else -// writeln(stderr, 'Result type not implemented!'); - Exit; - end; { case } - end; //assigned(res) + FreeMem(CustomTypeRes, SizeOf(TTypeInfo) + ExtraSizeRes); + end; + {$ENDIF} + end; - Result := True; end; + + +{$if defined (Delphi) and (not defined (MSWINDOWS)) and (not defined (MACOS32))} +procedure MyAllMethodsHandler3(P0, P1, P2, P3: Pointer); forward; + +function MkMethod(FSE: TPSExec; No: Cardinal): TMethod; +begin +//No way to do this by available internal methods, because no access to register +// and type decl. +//When will have free time, will do this using TVirtualMethod from Tiny.Library +end; + +procedure MyAllMethodsHandler3(P0, P1, P2, P3: Pointer); +begin +//here will be rewritten code from MyAllMethodsHandler2 with support +//of any params amount, any results, etc. +end; +{$ENDIF} + diff --git a/Source/PascalScript.inc b/Source/PascalScript.inc index 682287b8..52a93f37 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} + {$IFNDEF DELPHI4UP} + {$IFNDEF LINUX} + {$DEFINE PS_NOINT64} + {$DEFINE PS_NOUINT64} + {$ENDIF} + {$ENDIF} -{$IFDEF DELPHI2} - {$DEFINE PS_NOINT64} - {$DEFINE PS_NOWIDESTRING} - {$B-}{$X+}{$T-}{$H+} -{$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} + {$IFDEF LINUX}{KYLIX}{$DEFINE CLX}{$DEFINE DELPHI3UP}{$DEFINE DELPHI6UP}{$ENDIF} {$ENDIF} {$R-}{$Q-} @@ -52,14 +54,16 @@ Defines: PS_NOIDISPATCH PS_NOWIDESTRING PS_NOINT64 + PS_NOUINT64 PS_DELPHIDIV + PS_USECLASSICINVOKE } {$UNDEF DEBUG} -{$IFDEF CLX} +{$IF DEFINED (CLX) OR (DEFINED (DELPHI) AND NOT DEFINED (MSWINDOWS))} {$DEFINE PS_NOIDISPATCH} // not implemented -{$ENDIF} +{$IFEND} {$IFDEF FPC} {$I PascalScriptFPC.inc} diff --git a/Source/ThirdParty/uPSI_SynEdit.pas b/Source/ThirdParty/uPSI_SynEdit.pas new file mode 100644 index 00000000..6c5e6359 --- /dev/null +++ b/Source/ThirdParty/uPSI_SynEdit.pas @@ -0,0 +1,1645 @@ +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 + +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 + ,UITypes + ,Imm + ,SynUnicode + ,SynTextDrawer + ,SynEditTypes + ,SynEditKeyConst + ,SynEditMiscProcs + ,SynEditMiscClasses + ,SynEditTextBuffer + ,SynEditKeyCmds + ,SynEditHighlighter + ,SynEditKbdHandler + ,SynEditCodeFolding + ,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'); + 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)'); + 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); + RegisterProperty('OnScanForFoldRanges', 'TScanForFoldRangesEvent', iptrw); + 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; + +(*----------------------------------------------------------------------------*) +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; + +(*----------------------------------------------------------------------------*) +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; + +(*----------------------------------------------------------------------------*) +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; + +(*----------------------------------------------------------------------------*) +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'); + 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'); + 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'); + RegisterPropertyHelper(@TCustomSynEditCodeFolding_R,@TCustomSynEditCodeFolding_W,'CodeFolding'); + RegisterPropertyHelper(@TCustomSynEditUseCodeFolding_R,@TCustomSynEditUseCodeFolding_W,'UseCodeFolding'); + RegisterPropertyHelper(@TCustomSynEditAllFoldRanges_R,nil,'AllFoldRanges'); + 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'); + RegisterPropertyHelper(@TCustomSynEditOnScanForFoldRanges_R,@TCustomSynEditOnScanForFoldRanges_W,'OnScanForFoldRanges'); + 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/powerpc.inc b/Source/powerpc.inc index aa864467..9ac801d9 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{$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)^)); @@ -328,7 +330,8 @@ begin btDouble, btExtended: addfloat(fvar.dta, 2); btPChar: addgen(dword(ppchar(fvar.dta)^)); btChar: addgen(dword(pchar(fvar.dta)^)); - {$IFNDEF PS_NOINT64}bts64:{$ENDIF} begin + {$IFNDEF PS_NOINT64}bts64:{$ENDIF} + {$IFNDEF PS_NOUINT64}btu64:{$ENDIF} begin addgen(dword(pint64(fvar.dta)^ shr 32)); addgen(dword(pint64(fvar.dta)^ and $ffffffff)); end; diff --git a/Source/uPSC_DB.pas b/Source/uPSC_DB.pas index 9aedadd9..32c2d1f6 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 @@ -536,7 +536,7 @@ procedure SIRegisterTSTRINGFIELD(CL: TPSPascalCompiler); Begin With RegClassS(cl,'TField','TStringField') do begin - RegisterProperty('Value', 'string', iptrw); + RegisterProperty('Value', 'ansistring', iptrw); RegisterProperty('FixedChar', 'Boolean', iptrw); RegisterProperty('Transliterate', 'Boolean', iptrw); end; 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 e2b52f5c..c51d95be 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); @@ -710,6 +720,11 @@ TPSConstant = class(TObject) procedure SetInt64(const Val: Int64); {$ENDIF} + {$IFNDEF PS_NOUINT64} + + procedure SetUInt64(const Val: UInt64); + {$ENDIF} + procedure SetString(const Val: tbtString); procedure SetChar(c: tbtChar); @@ -920,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 @@ -962,6 +978,7 @@ TPSPascalCompiler = class FOnFunctionStart: TPSOnFunction; FOnFunctionEnd: TPSOnFunction; FAttributesOpenTokenID, FAttributesCloseTokenID: TPsPasToken; + FOnAddFunction : TPSOnAddFunction; FWithCount: Integer; FTryCount: Integer; @@ -1070,9 +1087,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; @@ -1138,11 +1156,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; @@ -1154,6 +1200,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; @@ -1216,9 +1264,11 @@ TPSPascalCompiler = class property AttributesCloseTokenID: TPSPasToken read FAttributesCloseTokenID write FAttributesCloseTokenID; - {$WARNINGS OFF} + property OnAddFunction: TPSOnAddFunction read FOnAddFunction write FOnAddFunction; + + {.$WARNINGS OFF} property UnitName: tbtString read FUnitName; - {$WARNINGS ON} + {.$WARNINGS ON} end; TIFPSPascalCompiler = TPSPascalCompiler; @@ -1759,7 +1809,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 @@ -1878,7 +1929,7 @@ procedure BlockWriteData(BlockInfo: TPSBlockInfo; const Data; Len: Longint); Move(Data, BlockInfo.Proc.FData[Length(BlockInfo.Proc.FData) - Len + 1], Len); end; -procedure BlockWriteLong(BlockInfo: TPSBlockInfo; l: Cardinal); +procedure BlockWriteLong(BlockInfo: TPSBlockInfo; l: {$IF CompilerVersion < 23}Integer{$ELSE}Cardinal{$IFEND}); begin BlockWriteData(BlockInfo, l, 4); end; @@ -1938,6 +1989,9 @@ procedure BlockWriteVariant(BlockInfo: TPSBlockInfo; p: PIfRVariant); {$IFNDEF PS_NOINT64} bts64: BlockWriteData(BlockInfo, p^.ts64, 8); {$ENDIF} + {$IFNDEF PS_NOINT64} + btu64: BlockWriteData(BlockInfo, p^.tu64, 8); + {$ENDIF} btProcPtr: BlockWriteData(BlockInfo, p^.tu32, 4); {$IFDEF DEBUG} {$IFNDEF FPC} @@ -2029,7 +2083,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; @@ -2169,6 +2222,7 @@ function ParseMethodEx(Owner: TPSPascalCompiler; const FClassName: tbtString; De 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');{$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: VCType := FindAndAddType(Owner, '!OPENARRAYOFS64', 'array of UInt64');{$ENDIF} btChar: VCType := FindAndAddType(Owner, '!OPENARRAYOFCHAR', 'array of Char'); {$IFNDEF PS_NOWIDESTRING} btWideString: VCType := FindAndAddType(Owner, '!OPENARRAYOFWIDESTRING', 'array of WideString'); @@ -2664,6 +2718,7 @@ procedure CopyVariantContents(Src, Dest: PIfRVariant); btCurrency: Dest^.tcurrency := Src^.tcurrency; btchar: Dest^.tchar := src^.tchar; {$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); @@ -2740,7 +2795,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{$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; @@ -2758,7 +2813,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{$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; @@ -2823,6 +2878,9 @@ function GetUInt(Src: PIfRVariant; var s: Boolean): Cardinal; {$IFNDEF PS_NOINT64} bts64: Result := src^.ts64; {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: Result := src^.tu64; + {$ENDIF} btChar: Result := ord(Src^.tchar); {$IFNDEF PS_NOWIDESTRING} btWideChar: Result := ord(tbtwidechar(src^.twidechar)); @@ -2848,6 +2906,9 @@ function GetInt(Src: PIfRVariant; var s: Boolean): Longint; {$IFNDEF PS_NOINT64} bts64: Result := src^.ts64; {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: Result := src^.tu64; + {$ENDIF} btChar: Result := ord(Src^.tchar); {$IFNDEF PS_NOWIDESTRING} btWideChar: Result := ord(tbtwidechar(src^.twidechar)); @@ -2860,6 +2921,7 @@ function GetInt(Src: PIfRVariant; var s: Boolean): Longint; end; end; end; + {$IFNDEF PS_NOINT64} function GetInt64(Src: PIfRVariant; var s: Boolean): Int64; begin @@ -2871,6 +2933,33 @@ function GetInt64(Src: PIfRVariant; var s: Boolean): Int64; btU32: Result := Src^.tu32; btS32: Result := Src^.ts32; bts64: Result := src^.ts64; + btu64: Result := src^.tu64; + btChar: Result := ord(Src^.tchar); + {$IFNDEF PS_NOWIDESTRING} + btWideChar: Result := ord(tbtwidechar(src^.twidechar)); + {$ENDIF} + btEnum: Result := src^.tu32; + else + begin + s := False; + Result := 0; + end; + end; +end; +{$ENDIF} + +{$IFNDEF PS_NOUINT64} +function GetUInt64(Src: PIfRVariant; var s: Boolean): UInt64; +begin + case Src.FType.BaseType of + btU8: Result := Src^.tu8; + btS8: Result := Src^.ts8; + btU16: Result := Src^.tu16; + btS16: Result := Src^.ts16; + btU32: Result := Src^.tu32; + btS32: Result := Src^.ts32; + bts64: Result := src^.ts64; + btu64: Result := src^.tu64; btChar: Result := ord(Src^.tchar); {$IFNDEF PS_NOWIDESTRING} btWideChar: Result := ord(tbtwidechar(src^.twidechar)); @@ -2897,6 +2986,9 @@ function GetReal(Src: PIfRVariant; var s: Boolean): Extended; {$IFNDEF PS_NOINT64} bts64: Result := src^.ts64; {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: Result := src^.tu64; + {$ENDIF} btChar: Result := ord(Src^.tchar); {$IFNDEF PS_NOWIDESTRING} btWideChar: Result := ord(tbtwidechar(src^.twidechar)); @@ -3194,6 +3286,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$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); @@ -3231,6 +3324,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$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); @@ -3255,6 +3349,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$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); @@ -3292,6 +3387,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 div GetUInt64(Var2, Result); {$ENDIF} else Result := False; end; end; @@ -3306,6 +3402,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$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); @@ -3324,6 +3421,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 mod GetUInt64(Var2, Result); {$ENDIF} else Result := False; end; end; @@ -3337,6 +3435,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.ts64 shl GetUInt64(Var2, Result); {$ENDIF} else Result := False; end; end; @@ -3350,6 +3449,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 shr GetUInt64( Var2, Result); {$ENDIF} else Result := False; end; end; @@ -3364,6 +3464,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$ENDIF} + {$IFNDEF PS_NOUINT64}btU64: var1^.tu64 := var1^.tu64 and GetUInt64(Var2, Result); {$ENDIF} else Result := False; end; end; @@ -3377,6 +3478,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$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; @@ -3391,6 +3493,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: 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); {$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; @@ -3405,6 +3508,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btU32: b := var1^.tu32 >= GetUint(Var2, Result); btS32: b := var1^.ts32 >= Getint(Var2, Result); {$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); @@ -3431,6 +3535,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btU32: b := var1^.tu32 <= GetUint(Var2, Result); btS32: b := var1^.ts32 <= Getint(Var2, Result); {$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); @@ -3457,6 +3562,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btU32: b := var1^.tu32 > GetUint(Var2, Result); btS32: b := var1^.ts32 > Getint(Var2, Result); {$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); @@ -3476,6 +3582,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btU32: b := var1^.tu32 < GetUint(Var2, Result); btS32: b := var1^.ts32 < Getint(Var2, Result); {$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); @@ -3494,6 +3601,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btS16: b := var1^.ts16 <> Getint(Var2, Result); btU32: b := var1^.tu32 <> GetUint(Var2, Result); {$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); @@ -3530,6 +3638,7 @@ function TPSPascalCompiler.PreCalc(FUseUsedTypes: Boolean; Var1Mod: Byte; var1: btU32: b := var1^.tu32 = GetUint(Var2, Result); btS32: b := var1^.ts32 = Getint(Var2, Result); {$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); @@ -3982,6 +4091,9 @@ function TPSPascalCompiler.ReadType(const Name: tbtString; FParser: TPSPascalPar {$IFNDEF PS_NOINT64} bts64: FArrayStart := tempf.ts64; {$ENDIF} + {$IFNDEF PS_NOINT64} + btu64: FArrayStart := tempf.tu64; + {$ENDIF} else begin DisposeVariant(tempf); @@ -4014,6 +4126,9 @@ function TPSPascalCompiler.ReadType(const Name: tbtString; FParser: TPSPascalPar {$IFNDEF PS_NOINT64} bts64: FArrayLength := tempf.ts64; {$ENDIF} + {$IFNDEF PS_NOINT64} + btu64: FArrayLength := tempf.tu64; + {$ENDIF} else DisposeVariant(tempf); MakeError('', ecTypeMismatch, ''); @@ -5508,9 +5623,24 @@ function TPSPascalCompiler.ReadString: PIfRVariant; 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 < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + UI := StrToUInt64Def(string(s), 0); + if ( UI > High( Int64 ) ) then + begin + InitializeVariant(Result, at2ut(FindBaseType(btu64))); + Result^.tu64 := UI; + Exit; + end; + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 + {$ENDIF PS_NOUINT64} + r := StrToInt64Def(string(s), 0); if (r >= Low(Integer)) and (r <= High(Integer)) then begin @@ -5529,7 +5659,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; @@ -7511,34 +7641,37 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; bi := BlockInfo; while bi <> nil do begin - for l := bi.WithList.Count -1 downto 0 do - begin - TWith := TPSValueAllocatedStackVar.Create; - TPSValueAllocatedStackVar(TWith).LocalVarNo := TPSValueAllocatedStackVar(TPSValueReplace(bi.WithList[l]).NewValue).LocalVarNo; - Temp := TWith; - VNo := TPSValueAllocatedStackVar(Temp).LocalVarNo; - lOldRecCount := TPSValueVar(TWith).GetRecCount; - vt := ivtVariable; - if Temp = TWith then CheckFurther(TWith, True); - if Temp = TWith then CheckClass(TWith, vt, vno, True); - if Temp = TWith then CheckExtClass(TWith, vt, vno, True); - if (Temp <> TWith) or (Cardinal(lOldRecCount) <> TPSValueVar(TWith).GetRecCount) then - begin - repeat - Temp := TWith; - if TWith <> nil then CheckFurther(TWith, False); - if TWith <> nil then CheckClass(TWith, vt, vno, False); - if TWith <> nil then CheckExtClass(TWith, vt, vno, False); -{$IFNDEF PS_NOIDISPATCH}if TWith <> nil then CheckIntf(TWith, vt, vno, False);{$ENDIF} - if TWith <> nil then CheckProcCall(TWith); - if TWith <> nil then CheckClassArrayProperty(TWith, vt, vno); - vno := InvalidVal; - until (TWith = nil) or (Temp = TWith); - Result := TWith; - Exit; + if ( bi.WithList.Count > 0 ) then + begin + for l := bi.WithList.Count -1 downto 0 do + begin + TWith := TPSValueAllocatedStackVar.Create; + TPSValueAllocatedStackVar(TWith).LocalVarNo := TPSValueAllocatedStackVar(TPSValueReplace(bi.WithList[l]).NewValue).LocalVarNo; + Temp := TWith; + VNo := TPSValueAllocatedStackVar(Temp).LocalVarNo; + lOldRecCount := TPSValueVar(TWith).GetRecCount; + vt := ivtVariable; + if Temp = TWith then CheckFurther(TWith, True); + if Temp = TWith then CheckClass(TWith, vt, vno, True); + if Temp = TWith then CheckExtClass(TWith, vt, vno, True); + if (Temp <> TWith) or (Cardinal(lOldRecCount) <> TPSValueVar(TWith).GetRecCount) then + begin + repeat + Temp := TWith; + if TWith <> nil then CheckFurther(TWith, False); + if TWith <> nil then CheckClass(TWith, vt, vno, False); + if TWith <> nil then CheckExtClass(TWith, vt, vno, False); + {$IFNDEF PS_NOIDISPATCH}if TWith <> nil then CheckIntf(TWith, vt, vno, False);{$ENDIF} + if TWith <> nil then CheckProcCall(TWith); + if TWith <> nil then CheckClassArrayProperty(TWith, vt, vno); + vno := InvalidVal; + until (TWith = nil) or (Temp = TWith); + Result := TWith; + Exit; + end; + TWith.Free; + end; end; - TWith.Free; - end; bi := bi.FOwner; end; end; @@ -7613,72 +7746,77 @@ 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 - (PIFPSProcVar(BlockInfo.Proc.ProcVars[l]).Name = s) then + if ( BlockInfo.Proc.ProcVars.Count > 0 ) then begin - PIFPSProcVar(BlockInfo.Proc.ProcVars[l]).Use; - vno := l; - vt := ivtVariable; - if @FOnUseVariable <> nil then - FOnUseVariable(Self, vt, vno, BlockInfo.ProcNo, FParser.CurrTokenPos, ''); - Result := TPSValueLocalVar.Create; - with TPSValueLocalVar(Result) do + for l := 0 to BlockInfo.Proc.ProcVars.Count - 1 do + begin + if (PIFPSProcVar(BlockInfo.Proc.ProcVars[l]).NameHash = h) and + (PIFPSProcVar(BlockInfo.Proc.ProcVars[l]).Name = s) then begin - LocalVarNo := l; - SetParserPos(FParser); - end; - FParser.Next; - repeat - Temp := Result; - if Result <> nil then CheckFurther(Result, False); - if Result <> nil then CheckClass(Result, vt, vno, False); - if Result <> nil then CheckExtClass(Result, vt, vno, False); -{$IFNDEF PS_NOIDISPATCH}if Result <> nil then CheckIntf(Result, vt, vno, False);{$ENDIF} - if Result <> nil then CheckProcCall(Result); - if Result <> nil then CheckClassArrayProperty(Result, vt, vno); - vno := InvalidVal; - until (Result = nil) or (Temp = Result); + PIFPSProcVar(BlockInfo.Proc.ProcVars[l]).Use; + vno := l; + vt := ivtVariable; + if @FOnUseVariable <> nil then + FOnUseVariable(Self, vt, vno, BlockInfo.ProcNo, FParser.CurrTokenPos, ''); + Result := TPSValueLocalVar.Create; + with TPSValueLocalVar(Result) do + begin + LocalVarNo := l; + SetParserPos(FParser); + end; + FParser.Next; + repeat + Temp := Result; + if Result <> nil then CheckFurther(Result, False); + if Result <> nil then CheckClass(Result, vt, vno, False); + if Result <> nil then CheckExtClass(Result, vt, vno, False); + {$IFNDEF PS_NOIDISPATCH}if Result <> nil then CheckIntf(Result, vt, vno, False);{$ENDIF} + if Result <> nil then CheckProcCall(Result); + if Result <> nil then CheckClassArrayProperty(Result, vt, vno); + vno := InvalidVal; + until (Result = nil) or (Temp = Result); - exit; + exit; + end; end; end; - for l := 0 to FVars.Count - 1 do - begin - if (TPSVar(FVars[l]).NameHash = h) and - (TPSVar(FVars[l]).Name = s) {$IFDEF PS_USESSUPPORT} and - (IsInLocalUnitList(TPSVar(FVars[l]).FDeclareUnit)){$ENDIF} then + if ( FVars.Count > 0 ) then begin - TPSVar(FVars[l]).Use; - Result := TPSValueGlobalVar.Create; - with TPSValueGlobalVar(Result) do + for l := 0 to FVars.Count - 1 do + begin + if (TPSVar(FVars[l]).NameHash = h) and + (TPSVar(FVars[l]).Name = s) {$IFDEF PS_USESSUPPORT} and + (IsInLocalUnitList(TPSVar(FVars[l]).FDeclareUnit)){$ENDIF} then begin - SetParserPos(FParser); - GlobalVarNo := l; + TPSVar(FVars[l]).Use; + Result := TPSValueGlobalVar.Create; + with TPSValueGlobalVar(Result) do + begin + SetParserPos(FParser); + GlobalVarNo := l; + end; + vt := ivtGlobal; + vno := l; + if @FOnUseVariable <> nil then + FOnUseVariable(Self, vt, vno, BlockInfo.ProcNo, FParser.CurrTokenPos, ''); + FParser.Next; + repeat + Temp := Result; + if Result <> nil then CheckNotificationVariant(Result); + if Result <> nil then CheckFurther(Result, False); + if Result <> nil then CheckClass(Result, vt, vno, False); + if Result <> nil then CheckExtClass(Result, vt, vno, False); + {$IFNDEF PS_NOIDISPATCH}if Result <> nil then CheckIntf(Result, vt, vno, False);{$ENDIF} + if Result <> nil then CheckProcCall(Result); + if Result <> nil then CheckClassArrayProperty(Result, vt, vno); + vno := InvalidVal; + until (Result = nil) or (Temp = Result); + exit; end; - vt := ivtGlobal; - vno := l; - if @FOnUseVariable <> nil then - FOnUseVariable(Self, vt, vno, BlockInfo.ProcNo, FParser.CurrTokenPos, ''); - FParser.Next; - repeat - Temp := Result; - if Result <> nil then CheckNotificationVariant(Result); - if Result <> nil then CheckFurther(Result, False); - if Result <> nil then CheckClass(Result, vt, vno, False); - if Result <> nil then CheckExtClass(Result, vt, vno, False); -{$IFNDEF PS_NOIDISPATCH}if Result <> nil then CheckIntf(Result, vt, vno, False);{$ENDIF} - if Result <> nil then CheckProcCall(Result); - if Result <> nil then CheckClassArrayProperty(Result, vt, vno); - vno := InvalidVal; - until (Result = nil) or (Temp = Result); - exit; end; - end; + end; Temp1 := FindType(FParser.GetToken); if Temp1 <> nil then begin @@ -8801,6 +8939,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; {$IFNDEF PS_NOINT64} bts64: TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64 := not TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64 := not TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; + {$ENDIF} else begin MakeError('', ecTypeMismatch, ''); @@ -8825,6 +8966,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; {$IFNDEF PS_NOINT64} bts64: TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64 := -TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; {$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; btExtended: TPSValueData(TPSUnValueOp(p).FVal1).Data^.textended := -TPSValueData(TPSUnValueOp(p).FVal1).Data^.textended; @@ -8862,6 +9006,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; {$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 begin MakeError('', ecTypeMismatch, ''); @@ -8887,6 +9034,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; {$IFNDEF PS_NOINT64} btS64: TPSValueData(preplace).Data.ts8 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; {$ENDIF} + {$IFNDEF PS_NOINT64} + btU64: TPSValueData(preplace).Data.ts8 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; + {$ENDIF} else begin MakeError('', ecTypeMismatch, ''); @@ -8912,6 +9062,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; {$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 begin MakeError('', ecTypeMismatch, ''); @@ -8937,6 +9090,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; {$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 begin MakeError('', ecTypeMismatch, ''); @@ -8962,6 +9118,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; {$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 begin MakeError('', ecTypeMismatch, ''); @@ -8987,6 +9146,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; {$IFNDEF PS_NOINT64} btS64: TPSValueData(preplace).Data.tu32 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; {$ENDIF} + {$IFNDEF PS_NOINT64} + btU64: TPSValueData(preplace).Data.tu32 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; + {$ENDIF} else begin MakeError('', ecTypeMismatch, ''); @@ -9011,6 +9173,33 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; btU32: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tU32; btS32: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS32; btS64: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; + btU64: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; + else + begin + MakeError('', ecTypeMismatch, ''); + preplace.Free; + Result := False; + exit; + end; + end; + end; + {$ENDIF} + {$IFNDEF PS_NOINT64} + btU64: + begin + case TPSValueData(TPSUnValueOp(p).FVal1).Data.Ftype.basetype of + btchar: TPSValueData(preplace).Data.ts64 := ord(TPSValueData(TPSUnValueOp(p).FVal1).Data^.tchar); + {$IFNDEF PS_NOWIDESTRING} + btwidechar: TPSValueData(preplace).Data.ts64 := ord(TPSValueData(TPSUnValueOp(p).FVal1).Data^.twidechar); + {$ENDIF} + btU8: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu8; + btS8: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS8; + btU16: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu16; + btS16: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS16; + btU32: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tU32; + btS32: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tS32; + btS64: TPSValueData(preplace).Data.ts64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.ts64; + btU64: TPSValueData(preplace).Data.tu64 := TPSValueData(TPSUnValueOp(p).FVal1).Data^.tu64; else begin MakeError('', ecTypeMismatch, ''); @@ -9034,6 +9223,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; {$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 begin MakeError('', ecTypeMismatch, ''); @@ -9708,7 +9900,7 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; exit; end; case lType.BaseType of - btU8, btS8, btU16, btS16, btU32, btS32, {$IFNDEF PS_NOINT64} btS64, {$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, ''); @@ -9756,7 +9948,7 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; exit; end; case lType.BaseType of - btVariant, btEnum, btU8, btS8, btU16, btS16, btU32, {$IFNDEF PS_NOINT64} btS64, {$ENDIF} btS32: ; + btVariant, btEnum, btU8, btS8, btU16, btS16, btU32, {$IFNDEF PS_NOINT64} btS64, {$ENDIF}{$IFNDEF PS_NOUINT64} btU64, {$ENDIF} btS32: ; else begin MakeError('', ecTypeMismatch, ''); @@ -9889,24 +10081,30 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; {$else} Longint((@BlockInfo.Proc.Data[EPos + 1])^) := Length(BlockInfo.Proc.Data) - RPos; {$endif} - for i := 0 to FBreakOffsets.Count -1 do - begin - EPos := IPointer(FBreakOffsets[I]); - {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} - unaligned(Longint((@BlockInfo.Proc.Data[EPos - 3])^)) := Length(BlockInfo.Proc.Data) - Longint(EPos); - {$else} - Longint((@BlockInfo.Proc.Data[EPos - 3])^) := Length(BlockInfo.Proc.Data) - Longint(EPos); - {$endif} - end; - for i := 0 to FContinueOffsets.Count -1 do - begin - EPos := IPointer(FContinueOffsets[I]); - {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} - unaligned(Longint((@BlockInfo.Proc.Data[EPos - 3])^)) := Longint(FPos) - Longint(EPos); - {$else} - Longint((@BlockInfo.Proc.Data[EPos - 3])^) := Longint(FPos) - Longint(EPos); - {$endif} - end; + if ( FBreakOffsets.Count > 0 ) then + begin + for i := 0 to FBreakOffsets.Count -1 do + begin + EPos := IPointer(FBreakOffsets[I]); + {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} + unaligned(Longint((@BlockInfo.Proc.Data[EPos - 3])^)) := Length(BlockInfo.Proc.Data) - Longint(EPos); + {$else} + Longint((@BlockInfo.Proc.Data[EPos - 3])^) := Length(BlockInfo.Proc.Data) - Longint(EPos); + {$endif} + end; + end; + if ( FContinueOffsets.Count > 0 ) then + begin + for i := 0 to FContinueOffsets.Count -1 do + begin + EPos := IPointer(FContinueOffsets[I]); + {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} + unaligned(Longint((@BlockInfo.Proc.Data[EPos - 3])^)) := Longint(FPos) - Longint(EPos); + {$else} + Longint((@BlockInfo.Proc.Data[EPos - 3])^) := Longint(FPos) - Longint(EPos); + {$endif} + end; + end; FBreakOffsets.Free; FContinueOffsets.Free; FContinueOffsets := OldCO; @@ -11265,61 +11463,78 @@ function TPSPascalCompiler.Compile(const s: tbtString): Boolean; FGlobalBlock.Free; FGlobalBlock := nil; - for I := 0 to FRegProcs.Count - 1 do - TObject(FRegProcs[I]).Free; + if ( FRegProcs.Count > 0 ) then + begin + for I := 0 to FRegProcs.Count - 1 do + TObject(FRegProcs[I]).Free; + end; FRegProcs.Free; - for i := 0 to FConstants.Count -1 do - begin - TPSConstant(FConstants[I]).Free; - end; + if ( FConstants.Count > 0 ) then + begin + for i := 0 to FConstants.Count -1 do + TPSConstant(FConstants[I]).Free; + end; Fconstants.Free; - for I := 0 to FVars.Count - 1 do - begin - TPSVar(FVars[I]).Free; - end; + if ( FVars.Count > 0 ) then + begin + for I := 0 to FVars.Count - 1 do + TPSVar(FVars[I]).Free; + end; FVars.Free; FVars := nil; - for I := 0 to FProcs.Count - 1 do - TPSProcedure(FProcs[I]).Free; + if ( FProcs.Count > 0 ) then + begin + for I := 0 to FProcs.Count - 1 do + TPSProcedure(FProcs[I]).Free; + end; FProcs.Free; FProcs := nil; //reverse free types: a custom type's attribute value type may point to a base type - for I := FTypes.Count - 1 downto 0 do - begin - PT := FTypes[I]; - pt.Free; - end; + if ( FTypes.Count > 0 ) then + begin + for I := FTypes.Count - 1 downto 0 do + begin + PT := FTypes[I]; + pt.Free; + end; + end; FTypes.Free; {$IFNDEF PS_NOINTERFACES} - for i := FInterfaces.Count -1 downto 0 do - TPSInterface(FInterfaces[i]).Free; + if ( FInterfaces.Count > 0 ) then + begin + for i := FInterfaces.Count -1 downto 0 do + TPSInterface(FInterfaces[i]).Free; + end; FInterfaces.Free; {$ENDIF} - - for i := FClasses.Count -1 downto 0 do - begin - TPSCompileTimeClass(FClasses[I]).Free; - end; + if ( FClasses.Count > 0 ) then + begin + for i := FClasses.Count -1 downto 0 do + TPSCompileTimeClass(FClasses[I]).Free; + end; FClasses.Free; - for i := FAttributeTypes.Count -1 downto 0 do - begin - TPSAttributeType(FAttributeTypes[i]).Free; - end; + if ( FAttributeTypes.Count > 0 ) then + begin + for i := FAttributeTypes.Count -1 downto 0 do + TPSAttributeType(FAttributeTypes[i]).Free; + end; FAttributeTypes.Free; FAttributeTypes := nil; {$IFDEF PS_USESSUPPORT} - for I := 0 to FUnitInits.Count - 1 do //nvds - begin //nvds - TPSBlockInfo(FUnitInits[I]).free; //nvds - end; //nvds + if ( FUnitInits.Count > 0 ) then + begin + for I := 0 to FUnitInits.Count - 1 do //nvds + TPSBlockInfo(FUnitInits[I]).free; //nvds + end; //nvds FUnitInits.Free; //nvds FUnitInits := nil; // - for I := 0 to FUnitFinits.Count - 1 do //nvds - begin //nvds - TPSBlockInfo(FUnitFinits[I]).free; //nvds - end; //nvds + if ( FUnitFinits.Count > 0 ) then + begin + for I := 0 to FUnitFinits.Count - 1 do //nvds + TPSBlockInfo(FUnitFinits[I]).free; //nvds + end; //nvds FUnitFinits.Free; // FUnitFinits := nil; // @@ -11398,6 +11613,9 @@ function TPSPascalCompiler.Compile(const s: tbtString): Boolean; {$IFNDEF PS_NOINT64} bts64: WriteData(p^.ts64, 8); {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: WriteData(p^.tu64, 8); + {$ENDIF} btProcPtr: WriteData(p^.tu32, 4); {$IFDEF DEBUG} else @@ -11648,17 +11866,23 @@ function TPSPascalCompiler.Compile(const s: tbtString): Boolean; end; begin ProcData := ''; Calls := 1; - for l := 0 to FUnitInits.Count-1 do - if (FUnitInits[l] <> nil) and - (TPSBlockInfo(FUnitInits[l]).Proc.Data<>'') then - WriteProc(TPSBlockInfo(FUnitInits[l]).FProcNo); + if ( FUnitInits.Count > 0 ) then + begin + for l := 0 to FUnitInits.Count-1 do + if (FUnitInits[l] <> nil) and + (TPSBlockInfo(FUnitInits[l]).Proc.Data<>'') then + WriteProc(TPSBlockInfo(FUnitInits[l]).FProcNo); + end; WriteProc(FGlobalBlock.FProcNo); - for l := FUnitFinits.Count-1 downto 0 do - if (FUnitFinits[l] <> nil) and - (TPSBlockInfo(FUnitFinits[l]).Proc.Data<>'') then - WriteProc(TPSBlockInfo(FUnitFinits[l]).FProcNo); + if ( FUnitFinits.Count > 0 ) then + begin + for l := FUnitFinits.Count-1 downto 0 do + if (FUnitFinits[l] <> nil) and + (TPSBlockInfo(FUnitFinits[l]).Proc.Data<>'') then + WriteProc(TPSBlockInfo(FUnitFinits[l]).FProcNo); + end; if Calls = 1 then begin Result := FGlobalBlock.FProcNo; @@ -11896,7 +12120,6 @@ function TPSPascalCompiler.Compile(const s: tbtString): Boolean; if Parse then begin - {$ENDIF} FUses.Add(s); if @FOnUses <> nil then begin @@ -11934,8 +12157,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 @@ -12358,6 +12584,7 @@ constructor TPSPascalCompiler.Create; FMessages := TPSList.Create; FAttributesOpenTokenID := CSTI_OpenBlock; FAttributesCloseTokenID := CSTI_CloseBlock; + FOnAddFunction := nil; end; destructor TPSPascalCompiler.Destroy; @@ -12396,6 +12623,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 @@ -12410,11 +12638,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); @@ -12433,25 +12665,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); + 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]); @@ -12971,6 +13266,9 @@ function TPSPascalCompiler.ReadConstant(FParser: TPSPascalParser; StopOn: TPSPas {$IFNDEF PS_NOINT64} bts64: p1.ts64 := not p1.ts64; {$ENDIF} + {$IFNDEF PS_NOINT64} + btu64: p1.tu64 := not p1.tu64; + {$ENDIF} else begin MakeError('', ecTypeMismatch, ''); @@ -12990,6 +13288,9 @@ function TPSPascalCompiler.ReadConstant(FParser: TPSPascalParser; StopOn: TPSPas {$IFNDEF PS_NOINT64} bts64: p1.ts64 := -p1.ts64; {$ENDIF} + {$IFNDEF PS_NOINT64} + btu64: p1.tu64 := -p1.tu64; + {$ENDIF} btDouble: p1.tdouble := - p1.tDouble; btSingle: p1.tsingle := - p1.tsingle; btCurrency: p1.tcurrency := - p1.tcurrency; @@ -13132,13 +13433,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 @@ -13250,6 +13572,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 @@ -13411,6 +13738,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} // RangeCheck might cause Internal-Error C1118 + function TPSPascalCompiler.AddTypeCopy(const Name: tbtString; TypeNo: TPSType): TPSType; begin @@ -13470,6 +13889,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; @@ -13557,7 +14009,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{$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; @@ -13585,7 +14037,6 @@ function TPSPascalCompiler.AddDelphiFunction(const Decl: tbtString): TPSRegProc; DOrgName: tbtString; FT: TPMFuncType; i: Longint; - begin pDecl := TPSParametersDecl.Create; {$IFNDEF DELPHI_TOKYO_UP} @@ -13618,6 +14069,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; @@ -13718,15 +14172,18 @@ function TPSPascalCompiler.FindClass(const aClass: tbtString): TPSCompileTimeCla begin cl := FastUpperCase(aClass); H := MakeHash(Cl); - for i :=0 to FClasses.Count -1 do - begin - x := FClasses[I]; - if (X.FClassNameHash = H) and (X.FClassName = Cl) then + if ( FClasses.Count > 0 ) then begin - Result := X; - Exit; + for i :=0 to FClasses.Count -1 do + begin + x := FClasses[I]; + if (X.FClassNameHash = H) and (X.FClassName = Cl) then + begin + Result := X; + Exit; + end; + end; end; - end; Result := nil; end; @@ -13792,7 +14249,6 @@ function TPSPascalCompiler.GetConstant(const Name: tbtString): TPSConstant; var h, i: Longint; n: tbtString; - begin n := FastUppercase(name); h := MakeHash(n); @@ -13804,6 +14260,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 @@ -13938,8 +14411,11 @@ destructor TPSInternalProcedure.Destroy; i: Longint; begin FDecl.Free; - for i := FProcVars.Count -1 downto 0 do - TPSProcVar(FProcVars[I]).Free; + if ( FProcVars.Count > 0 ) then + begin + for i := FProcVars.Count -1 downto 0 do + TPSProcVar(FProcVars[I]).Free; + end; FProcVars.Free; FGotos.Free; FLabels.Free; @@ -14046,12 +14522,18 @@ procedure TPSConstant.SetInt(const Val: Longint); {$IFNDEF PS_NOINT64} bts64: FValue.ts64 := Val; {$ENDIF} + {$IFNDEF PS_NOUINT64} + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + btu64: FValue.tu64 := Val; + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 + {$ENDIF} else raise EPSCompilerException.Create(RPS_ConstantValueMismatch); end; end else raise EPSCompilerException.Create(RPS_ConstantValueNotAssigned) end; + {$IFNDEF PS_NOINT64} procedure TPSConstant.SetInt64(const Val: Int64); begin @@ -14067,6 +14549,35 @@ procedure TPSConstant.SetInt64(const Val: Int64); btExtended: FValue.textended := Val; btCurrency: FValue.tcurrency := Val; bts64: FValue.ts64 := Val; + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + btu64: FValue.tu64 := Val; + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 + else + raise EPSCompilerException.Create(RPS_ConstantValueMismatch); + end; + end else + raise EPSCompilerException.Create(RPS_ConstantValueNotAssigned) +end; +{$ENDIF} + +{$IFNDEF PS_NOINT64} +procedure TPSConstant.SetUInt64(const Val: UInt64); +begin + if (FValue <> nil) then + begin + case FValue.FType.BaseType of + btEnum: FValue.tu32 := Val; + btU32, btS32: FValue.ts32 := Val; + btU16, btS16: FValue.ts16 := Val; + btU8, btS8: FValue.ts8 := Val; + btSingle: FValue.tsingle := Val; + btDouble: FValue.tdouble := Val; + btExtended: FValue.textended := Val; + btCurrency: FValue.tcurrency := Val; + bts64: FValue.ts64 := Val; + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + btu64: FValue.tu64 := Val; + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 else raise EPSCompilerException.Create(RPS_ConstantValueMismatch); end; @@ -14074,6 +14585,7 @@ procedure TPSConstant.SetInt64(const Val: Int64); raise EPSCompilerException.Create(RPS_ConstantValueNotAssigned) end; {$ENDIF} + procedure TPSConstant.SetName(const Value: tbtString); begin FName := Value; @@ -14134,6 +14646,11 @@ procedure TPSConstant.SetUInt(const Val: Cardinal); {$IFNDEF PS_NOINT64} bts64: FValue.ts64 := Val; {$ENDIF} + {$IFNDEF PS_NOINT64} + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + btu64: FValue.tu64 := Val; + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 + {$ENDIF} else raise EPSCompilerException.Create(RPS_ConstantValueMismatch); end; @@ -14423,10 +14940,11 @@ destructor TPSValueVar.Destroy; var i: Longint; begin - for i := 0 to FRecItems.Count -1 do - begin - TPSSubItem(FRecItems[I]).Free; - end; + if ( FRecItems.Count > 0 ) then + begin + for i := 0 to FRecItems.Count -1 do + TPSSubItem(FRecItems[I]).Free; + end; FRecItems.Free; inherited Destroy; end; @@ -14739,8 +15257,11 @@ destructor TPSCompileTimeClass.Destroy; var I: Longint; begin - for i := FClassItems.Count -1 downto 0 do - TPSDelphiClassItem(FClassItems[I]).Free; + if ( FClassItems.Count > 0 ) then + begin + for i := FClassItems.Count -1 downto 0 do + TPSDelphiClassItem(FClassItems[I]).Free; + end; FClassItems.Free; inherited Destroy; end; @@ -15148,11 +15669,14 @@ procedure TPSBlockInfo.Clear; var i: Longint; begin - for i := WithList.Count -1 downto 0 do - begin - TPSValue(WithList[i]).Free; - WithList.Delete(i); - end; + if ( WithList.Count > 0 ) then + begin + for i := WithList.Count -1 downto 0 do + begin + TPSValue(WithList[i]).Free; + WithList.Delete(i); + end; + end; end; constructor TPSBlockInfo.Create(Owner: TPSBlockInfo); @@ -15341,10 +15865,13 @@ destructor TPSAttributes.Destroy; var i: Longint; begin - for i := FItems.Count -1 downto 0 do - begin - TPSAttribute(FItems[i]).Free; - end; + if ( FItems.Count > 0 ) then + begin + for i := FItems.Count -1 downto 0 do + begin + TPSAttribute(FItems[i]).Free; + end; + end; FItems.Free; inherited Destroy; end; @@ -15354,21 +15881,23 @@ procedure TPSAttributes.Assign(attr: TPSAttributes; Move: Boolean); newitem, item: TPSAttribute; i: Longint; begin - for i := ATtr.FItems.Count -1 downto 0 do - begin - Item := Attr.Fitems[i]; - if Move then + if ( ATtr.FItems.Count > 0 ) then begin - FItems.Add(Item); - Attr.FItems.Delete(i); - end else + for i := ATtr.FItems.Count -1 downto 0 do begin - newitem := TPSAttribute.Create(Item.FAttribType ); - newitem.Assign(item); - FItems.Add(NewItem); + Item := Attr.Fitems[i]; + if Move then + begin + FItems.Add(Item); + Attr.FItems.Delete(i); + end else + begin + newitem := TPSAttribute.Create(Item.FAttribType ); + newitem.Assign(item); + FItems.Add(NewItem); + end; + end; end; - end; - end; @@ -15403,24 +15932,30 @@ procedure TPSParametersDecl.Assign(Params: TPSParametersDecl); i: Longint; np, orgp: TPSParameterDecl; begin - for i := FParams.Count -1 downto 0 do - begin - TPSParameterDecl(Fparams[i]).Free; - end; - FParams.Clear; + if ( FParams.Count > 0 ) then + begin + for i := FParams.Count -1 downto 0 do + begin + TPSParameterDecl(Fparams[i]).Free; + end; + FParams.Clear; + end; FResult := Params.Result; - for i := 0 to Params.FParams.count -1 do - begin - orgp := Params.FParams[i]; - np := AddParam; - np.OrgName := orgp.OrgName; - np.Mode := orgp.Mode; - np.aType := orgp.aType; - np.DeclarePos:=orgp.DeclarePos; - np.DeclareRow:=orgp.DeclareRow; - np.DeclareCol:=orgp.DeclareCol; - end; + if ( Params.FParams.count > 0 ) then + begin + for i := 0 to Params.FParams.count -1 do + begin + orgp := Params.FParams[i]; + np := AddParam; + np.OrgName := orgp.OrgName; + np.Mode := orgp.Mode; + np.aType := orgp.aType; + np.DeclarePos:=orgp.DeclarePos; + np.DeclareRow:=orgp.DeclareRow; + np.DeclareCol:=orgp.DeclareCol; + end; + end; end; @@ -15459,10 +15994,13 @@ destructor TPSParametersDecl.Destroy; var i: Longint; begin - for i := FParams.Count -1 downto 0 do - begin - TPSParameterDecl(Fparams[i]).Free; - end; + if ( FParams.Count > 0 ) then + begin + for i := FParams.Count -1 downto 0 do + begin + TPSParameterDecl(Fparams[i]).Free; + end; + end; FParams.Free; inherited Destroy; end; diff --git a/Source/uPSComponent.pas b/Source/uPSComponent.pas index 6b906c96..de78926a 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, @@ -344,7 +348,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 +600,7 @@ function TPSScript.Compile: Boolean; begin FPP.Clear; FPP.Defines.Assign(FDefines); + FPP.Compiler := FComp; FComp.OnTranslateLineInfo := CompTranslateLineInfo; Fpp.OnProcessDirective := callObjectOnProcessDirective; Fpp.OnProcessUnknowDirective := callObjectOnProcessUnknowDirective; @@ -1082,7 +1089,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; @@ -1469,7 +1476,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 3f9f975c..66070601 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)]; @@ -687,6 +760,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); @@ -721,6 +799,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 a4c1933c..3679a3c6 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 557416db..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; @@ -716,11 +969,11 @@ procedure TPSPreProcessor.PreProcess(const Filename: tbtstring; var Output: tbts Stream: TMemoryStream; begin FAddedPosition := 0; - {$IFDEF FPC} + {$IFDEF FPC} FCurrentDefines.AddStrings(FDefines); - {$ELSE} + {$ELSE} FCurrentDefines.Assign(FDefines); - {$ENDIF} + {$ENDIF} Stream := TMemoryStream.Create; try IntPreProcess(0, '', FileName, Stream); @@ -798,4 +1051,4 @@ function TPSDefineStates.GetPrevWrite: Boolean; else Result := TPSDefineState(FItems[FItems.Count -2]).DoWrite; end; -end. \ No newline at end of file +end. diff --git a/Source/uPSR_DB.pas b/Source/uPSR_DB.pas index b59ee20d..d3c5b9ba 100644 --- a/Source/uPSR_DB.pas +++ b/Source/uPSR_DB.pas @@ -1,7 +1,11 @@ -{runtime DB support} Unit uPSR_DB; + {$I PascalScript.inc} + Interface + +{$WARN UNSAFE_CODE OFF} + Uses uPSRuntime, uPSUtils, SysUtils; procedure RIRegisterTDATASET(Cl: TPSRuntimeClassImporter); @@ -815,10 +819,10 @@ procedure TSTRINGFIELDFIXEDCHAR_R(Self: TSTRINGFIELD; var T: BOOLEAN); {$ENDIF} -procedure TSTRINGFIELDVALUE_W(Self: TSTRINGFIELD; const T: String); +procedure TSTRINGFIELDVALUE_W(Self: TSTRINGFIELD; const T: AnsiString); begin Self.VALUE := T; end; -procedure TSTRINGFIELDVALUE_R(Self: TSTRINGFIELD; var T: String); +procedure TSTRINGFIELDVALUE_R(Self: TSTRINGFIELD; var T: AnsiString); begin T := Self.VALUE; end; procedure TFIELDONVALIDATE_W(Self: TFIELD; const T: TFIELDNOTIFYEVENT); 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_classes.pas b/Source/uPSR_classes.pas index bfd47ada..3a5f323e 100644 --- a/Source/uPSR_classes.pas +++ b/Source/uPSR_classes.pas @@ -3,6 +3,9 @@ {$I PascalScript.inc} interface + +{$WARN UNSAFE_CODE OFF} + uses uPSRuntime, uPSUtils; 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 b428754a..b4b85de5 100644 --- a/Source/uPSR_controls.pas +++ b/Source/uPSR_controls.pas @@ -3,6 +3,10 @@ {$I PascalScript.inc} interface + +{$WARN UNSAFE_CODE OFF} +{$WARN UNSAFE_TYPE OFF} + uses uPSRuntime, uPSUtils; 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/uPSR_dll.pas b/Source/uPSR_dll.pas index 95c894a8..2543cdd3 100644 --- a/Source/uPSR_dll.pas +++ b/Source/uPSR_dll.pas @@ -2,6 +2,10 @@ {$I PascalScript.inc} interface + +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CODE OFF} + uses uPSRuntime, uPSUtils; diff --git a/Source/uPSR_extctrls.pas b/Source/uPSR_extctrls.pas index 7fc7c2f7..69c6cc30 100644 --- a/Source/uPSR_extctrls.pas +++ b/Source/uPSR_extctrls.pas @@ -3,6 +3,9 @@ {$I PascalScript.inc} interface + +{$WARN UNSAFE_CODE OFF} + uses uPSRuntime, uPSUtils; diff --git a/Source/uPSR_forms.pas b/Source/uPSR_forms.pas index 08be3e12..3fb1ba1e 100644 --- a/Source/uPSR_forms.pas +++ b/Source/uPSR_forms.pas @@ -3,6 +3,9 @@ {$I PascalScript.inc} interface + +{$WARN UNSAFE_CODE OFF} + uses uPSRuntime, uPSUtils; diff --git a/Source/uPSR_graphics.pas b/Source/uPSR_graphics.pas index 9ac5d726..3b645cc7 100644 --- a/Source/uPSR_graphics.pas +++ b/Source/uPSR_graphics.pas @@ -2,6 +2,9 @@ unit uPSR_graphics; {$I PascalScript.inc} interface + +{$WARN UNSAFE_CODE OFF} + uses uPSRuntime, uPSUtils; diff --git a/Source/uPSR_menus.pas b/Source/uPSR_menus.pas index 632ec9f1..7ed4d80c 100644 --- a/Source/uPSR_menus.pas +++ b/Source/uPSR_menus.pas @@ -2,6 +2,9 @@ Unit uPSR_menus; {$I PascalScript.inc} Interface + +{$WARN UNSAFE_CODE OFF} + Uses uPSRuntime; procedure RIRegister_Menus_Routines(S: TPSExec); diff --git a/Source/uPSR_std.pas b/Source/uPSR_std.pas index e256e214..b6993776 100644 --- a/Source/uPSR_std.pas +++ b/Source/uPSR_std.pas @@ -2,6 +2,9 @@ unit uPSR_std; {$I PascalScript.inc} interface + +{$WARN UNSAFE_CODE OFF} + uses uPSRuntime, uPSUtils; diff --git a/Source/uPSR_stdctrls.pas b/Source/uPSR_stdctrls.pas index 32ec6268..65fc8ca8 100644 --- a/Source/uPSR_stdctrls.pas +++ b/Source/uPSR_stdctrls.pas @@ -3,6 +3,9 @@ {$I PascalScript.inc} interface + +{$WARN UNSAFE_CODE OFF} + uses uPSRuntime, uPSUtils; diff --git a/Source/uPSRuntime.pas b/Source/uPSRuntime.pas index 8fac357c..f7b2a8c2 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); @@ -302,6 +310,16 @@ TPSTypeRec_Record = class(TPSTypeRec) end; {$ENDIF} +{$IFNDEF PS_NOUINT64} + + PPSVariantU64 = ^TPSVariantU64; + + TPSVariantU64 = packed record + VI: TPSVariant; + Data: tbtu64; + end; +{$ENDIF} + PPSVariantAChar = ^TPSVariantAChar; TPSVariantAChar = packed record @@ -828,6 +846,9 @@ 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 function GetAnsiString(ItemNo: Longint): tbtstring; @@ -844,6 +865,9 @@ 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); procedure SetAnsiString(ItemNo: Longint; const Data: tbtstring); @@ -893,6 +917,9 @@ 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; function PSGetCurrency(Src: Pointer; aType: TPSTypeRec): Currency; function PSGetInt(Src: Pointer; aType: TPSTypeRec): Longint; @@ -908,6 +935,9 @@ procedure PSSetUInt(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: {$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); procedure PSSetCurrency(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Currency); procedure PSSetInt(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: Longint); @@ -924,6 +954,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; @@ -938,6 +971,9 @@ 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); procedure VNSetCurrency(const Src: TPSVariantIFC; const Val: Currency); procedure VNSetInt(const Src: TPSVariantIFC; const Val: Longint); @@ -952,6 +988,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; @@ -967,6 +1006,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); @@ -1101,11 +1143,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}; @@ -1639,6 +1683,7 @@ function PSVariantToString(const p: TPSVariantIFC; const ClassProperties: tbtStr btUnicodeString: Result := MakeWString(tbtUnicodeString(p.dta^)); {$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 := ''; @@ -1730,7 +1775,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{$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 @@ -1802,7 +1847,7 @@ procedure InitializeVariant(p: Pointer; aType: TPSTypeRec); Pointer(Pointer(IPointer(p)+(2*PointerSize))^) := nil; end; btCurrency: tbtCurrency(P^) := 0; - btDouble{$IFNDEF PS_NOINT64}, bts64{$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 @@ -2424,6 +2469,15 @@ function TPSExec.LoadData(const s: tbtString): Boolean; exit; end; {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: if not read(PPSVariantU64(VarP)^.Data, sizeof(tbtu64)) then + begin + CMD_Err(erOutOfRange); + DestroyHeapVariant(VarP); + Result := False; + exit; + end; + {$ENDIF} btSingle: if not read(PPSVariantSingle(VarP)^.Data, SizeOf(TbtSingle)) then begin CMD_Err(erOutOfRange); @@ -2588,6 +2642,7 @@ function TPSExec.LoadData(const s: tbtString): Boolean; fe := False; case currf.BaseType of {$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 @@ -3099,6 +3154,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); @@ -3147,6 +3209,15 @@ procedure VNSetInt64(const Src: TPSVariantIFC; const Val: Int64); end; {$ENDIF} +{$IFNDEF PS_NOINT64} +procedure VNSetUInt64(const Src: TPSVariantIFC; const Val: UInt64); +var + Dummy: Boolean; +begin + PSSetUInt64(Src.Dta, Src.aType, Dummy, Val); +end; +{$ENDIF} + procedure VNSetReal(const Src: TPSVariantIFC; const Val: Extended); var Dummy: Boolean; @@ -3230,6 +3301,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); @@ -3291,6 +3369,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; @@ -3391,7 +3478,11 @@ function PSGetUInt(Src: Pointer; aType: TPSTypeRec): Cardinal; btS16: Result := tbts16(src^); btU32: Result := tbtu32(src^); btS32: Result := tbts32(src^); -{$IFNDEF PS_NOINT64} btS64: Result := tbts64(src^); +{$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} @@ -3444,7 +3535,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 @@ -3462,6 +3552,37 @@ function PSGetInt64(Src: Pointer; aType: TPSTypeRec): Int64; btU32: Result := tbtu32(src^); btS32: Result := tbts32(src^); btS64: Result := tbts64(src^); + btU64: Result := tbtu64(src^); + btChar: Result := Ord(tbtchar(Src^)); +{$IFNDEF PS_NOWIDESTRING} + btWideChar: Result := Ord(tbtwidechar(Src^)); +{$ENDIF} +{$IFDEF DELPHI6UP} + btVariant: Result := Variant(src^); +{$ENDIF} + 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 + begin + atype := PIFTypeRec(Pointer(IPointer(Src)+PointerSize)^); + Src := Pointer(Src^); + if (src = nil) or (aType = nil) then raise Exception.Create(RPS_TypeMismatch); + end; + case aType.BaseType of + btU8: Result := tbtu8(src^); + btS8: Result := tbts8(src^); + btU16: Result := tbtu16(src^); + btS16: Result := tbts16(src^); + btU32: Result := tbtu32(src^); + btS32: Result := tbts32(src^); + btS64: Result := tbts64(src^); + btU64: Result := tbtu64(src^); btChar: Result := Ord(tbtchar(Src^)); {$IFNDEF PS_NOWIDESTRING} btWideChar: Result := Ord(tbtwidechar(Src^)); @@ -3490,6 +3611,7 @@ function PSGetReal(Src: Pointer; aType: TPSTypeRec): Extended; btU32: Result := tbtu32(src^); btS32: Result := tbts32(src^); {$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^); @@ -3515,6 +3637,7 @@ function PSGetCurrency(Src: Pointer; aType: TPSTypeRec): Currency; btU32: Result := tbtu32(src^); btS32: Result := tbts32(src^); {$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^); @@ -3541,6 +3664,7 @@ function PSGetInt(Src: Pointer; aType: TPSTypeRec): Longint; btU32: Result := tbtu32(src^); btS32: Result := tbts32(src^); {$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^); @@ -3648,6 +3772,7 @@ procedure PSSetUInt(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: btU32: tbtu32(src^) := Val; btS32: tbts32(src^) := Val; {$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; @@ -3684,6 +3809,91 @@ procedure PSSetInt64(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const 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} + +{$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)^); + 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} + +{$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); @@ -3782,6 +3992,7 @@ procedure PSSetInt(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: btU32: tbtu32(src^) := Val; btS32: tbts32(src^) := Val; {$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; @@ -4007,6 +4218,13 @@ function CopyArrayContents(dest, src: Pointer; Len: Longint; aType: TPSTypeRec): Dest := Pointer(IPointer(Dest) + 8); Src := Pointer(IPointer(Src) + 8); end;{$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: + for i := 0 to Len -1 do + begin + tbtu64(Dest^) := tbtu64(Src^); + Dest := Pointer(IPointer(Dest) + 8); + Src := Pointer(IPointer(Src) + 8); + end;{$ENDIF} btExtended: for i := 0 to Len -1 do begin @@ -4422,6 +4640,7 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR btU32: tbtu32(Dest^) := tbtu32(src^); btS32: tbtu32(Dest^) := tbts32(src^); {$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^); @@ -4444,6 +4663,7 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR btU32: tbts32(Dest^) := tbtu32(src^); btS32: tbts32(Dest^) := tbts32(src^); {$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^); @@ -4456,6 +4676,9 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR {$IFNDEF PS_NOINT64} btS64: tbts64(Dest^) := PSGetInt64(Src, srctype); {$ENDIF} + {$IFNDEF PS_NOUINT64} + btU64: tbtu64(Dest^) := PSGetUInt64(Src, srctype); + {$ENDIF} btSingle: begin if srctype.BaseType = btPointer then @@ -4472,6 +4695,7 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR btU32: tbtsingle(Dest^) := tbtu32(src^); btS32: tbtsingle(Dest^) := tbts32(src^); {$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^); @@ -4496,6 +4720,7 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR btU32: tbtdouble(Dest^) := tbtu32(src^); btS32: tbtdouble(Dest^) := tbts32(src^); {$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^); @@ -4521,6 +4746,7 @@ function TPSExec.SetVariantValue(dest, Src: Pointer; desttype, srctype: TPSTypeR btU32: tbtextended(Dest^) := tbtu32(src^); btS32: tbtextended(Dest^) := tbts32(src^); {$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^); @@ -4809,6 +5035,7 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btSingle: B := psGetReal(Var1, var1Type) >= tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) >= tbtExtended(var2^); {$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^); @@ -4822,6 +5049,9 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in {$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); btChar: b := tbtchar(var1^) >= PSGetAnsiString(Var2, var2type); {$IFNDEF PS_NOWIDESTRING} @@ -4885,6 +5115,7 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btSingle: B := psGetReal(Var1, var1Type) <= tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) <= tbtExtended(var2^); {$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^); @@ -4897,6 +5128,9 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in {$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); btChar: b := tbtchar(var1^) <= PSGetAnsiString(Var2, var2type); {$IFNDEF PS_NOWIDESTRING} @@ -4960,6 +5194,7 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btSingle: B := psGetReal(Var1, var1Type) > tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) > tbtExtended(var2^); {$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^); @@ -4972,6 +5207,9 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in {$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); btChar: b := tbtchar(var1^) > PSGetAnsiString(Var2, var2type); {$IFNDEF PS_NOWIDESTRING} @@ -5028,6 +5266,7 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btSingle: B := psGetReal(Var1, var1Type) < tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) < tbtExtended(var2^); {$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^); @@ -5040,6 +5279,9 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in {$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); btChar: b := tbtchar(var1^) < PSGetAnsiString(Var2, var2type); {$IFNDEF PS_NOWIDESTRING} @@ -5121,6 +5363,7 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btSingle: B := psGetReal(Var1, var1Type) <> tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) <> tbtExtended(var2^); {$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^); @@ -5134,6 +5377,9 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in {$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); {$IFNDEF PS_NOWIDESTRING} btWideChar: b := tbtwidechar(var1^) <> PSGetWideString(Var2, var2type); @@ -5231,6 +5477,7 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in btSingle: B := psGetReal(Var1, var1Type) = tbtsingle(var2^); btExtended: B := psGetReal(Var1, var1Type) = tbtExtended(var2^); {$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^); @@ -5244,6 +5491,9 @@ function TPSExec.DoBooleanCalc(var1, Var2, into: Pointer; var1Type, var2type, in {$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); {$IFNDEF PS_NOWIDESTRING} btWideChar: b := tbtwidechar(var1^) = PSGetWideString(Var2, var2type); @@ -5427,6 +5677,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal 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^);{$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^); @@ -5449,6 +5700,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal 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^);{$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^); @@ -5457,6 +5709,9 @@ 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: begin @@ -5474,6 +5729,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtsingle(var1^) := tbtsingle(var1^) + tbtu32(var2^); btS32: tbtsingle(var1^) := tbtsingle(var1^) + tbts32(var2^); {$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^); @@ -5498,6 +5754,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtdouble(var1^) := tbtdouble(var1^) + tbtu32(var2^); btS32: tbtdouble(var1^) := tbtdouble(var1^) + tbts32(var2^); {$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^); @@ -5522,6 +5779,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtcurrency(var1^) := tbtdouble(var1^) + tbtu32(var2^); btS32: tbtcurrency(var1^) := tbtcurrency(var1^) + tbts32(var2^); {$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^); @@ -5546,6 +5804,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtextended(var1^) := tbtextended(var1^) + tbtu32(var2^); btS32: tbtextended(var1^) := tbtextended(var1^) + tbts32(var2^); {$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^); @@ -5610,6 +5869,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal 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^);{$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^); @@ -5632,6 +5892,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal 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^);{$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^); @@ -5640,6 +5901,9 @@ 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: begin @@ -5657,6 +5921,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtsingle(var1^) := tbtsingle(var1^) - tbtu32(var2^); btS32: tbtsingle(var1^) := tbtsingle(var1^) - tbts32(var2^); {$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^); @@ -5681,6 +5946,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtcurrency(var1^) := tbtdouble(var1^) - tbtu32(var2^); btS32: tbtcurrency(var1^) := tbtcurrency(var1^) - tbts32(var2^); {$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^); @@ -5705,6 +5971,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtdouble(var1^) := tbtdouble(var1^) - tbtu32(var2^); btS32: tbtdouble(var1^) := tbtdouble(var1^) - tbts32(var2^); {$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^); @@ -5729,6 +5996,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtextended(var1^) := tbtextended(var1^) - tbtu32(var2^); btS32: tbtextended(var1^) := tbtextended(var1^) - tbts32(var2^); {$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^); @@ -5788,6 +6056,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal 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^);{$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^); @@ -5810,6 +6079,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal 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^);{$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^); @@ -5818,6 +6088,9 @@ 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: begin @@ -5835,6 +6108,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtcurrency(var1^) := tbtdouble(var1^) * tbtu32(var2^); btS32: tbtcurrency(var1^) := tbtcurrency(var1^) * tbts32(var2^); {$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^); @@ -5859,6 +6133,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtsingle(var1^) := tbtsingle(var1^) *tbtu32(var2^); btS32: tbtsingle(var1^) := tbtsingle(var1^) *tbts32(var2^); {$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^); @@ -5883,6 +6158,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtdouble(var1^) := tbtdouble(var1^) *tbtu32(var2^); btS32: tbtdouble(var1^) := tbtdouble(var1^) *tbts32(var2^); {$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^); @@ -5907,6 +6183,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtextended(var1^) := tbtextended(var1^) *tbtu32(var2^); btS32: tbtextended(var1^) := tbtextended(var1^) *tbts32(var2^); {$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^); @@ -5962,6 +6239,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal 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^);{$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^); @@ -5984,6 +6262,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal 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^);{$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^); @@ -5992,6 +6271,9 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal end; {$IFNDEF PS_NOINT64} btS64: tbts64(var1^) := tbts64(var1^) div PSGetInt64(var2, var2type); + {$ENDIF} + {$IFNDEF PS_NOUINT64} + btU64: tbts64(var1^) := tbtu64(var1^) div PSGetUInt64(var2, var2type); {$ENDIF} btSingle: begin @@ -6009,6 +6291,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtsingle(var1^) := tbtsingle(var1^) / tbtu32(var2^); btS32: tbtsingle(var1^) := tbtsingle(var1^) / tbts32(var2^); {$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^); @@ -6033,6 +6316,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtcurrency(var1^) := tbtdouble(var1^) / tbtu32(var2^); btS32: tbtcurrency(var1^) := tbtcurrency(var1^) / tbts32(var2^); {$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^); @@ -6057,6 +6341,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtdouble(var1^) := tbtdouble(var1^) / tbtu32(var2^); btS32: tbtdouble(var1^) := tbtdouble(var1^) / tbts32(var2^); {$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^); @@ -6081,6 +6366,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal btU32: tbtextended(var1^) := tbtextended(var1^) / tbtu32(var2^); btS32: tbtextended(var1^) := tbtextended(var1^) / tbts32(var2^); {$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^); @@ -6134,6 +6420,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal 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^);{$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^); @@ -6156,6 +6443,7 @@ function TPSExec.DoCalc(var1, Var2: Pointer; var1Type, var2type: TPSTypeRec; Cal 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^);{$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^); @@ -6164,6 +6452,9 @@ 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: begin @@ -6193,6 +6484,9 @@ 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: begin @@ -6222,6 +6516,9 @@ 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: begin @@ -6251,6 +6548,9 @@ 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: begin @@ -6280,6 +6580,9 @@ 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: begin @@ -6309,6 +6612,9 @@ 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: begin @@ -6593,6 +6899,24 @@ function TPSExec.ReadVariable(var Dest: TPSResultData; UsePointer: Boolean): Boo Inc(FCurrentPosition, 8); end; {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: + begin + if FCurrentPosition + 7>= FDataLength then + begin + CMD_Err(erOutOfRange); + FTempVars.Pop; + Result := False; + exit; + end; + {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} + tbtu64(dest.p^) := unaligned(tbtu64((@FData^[FCurrentPosition])^)); + {$else} + tbtu64(dest.p^) := tbtu64((@FData^[FCurrentPosition])^); + {$endif} + Inc(FCurrentPosition, 8); + end; + {$ENDIF} btSingle: begin if FCurrentPosition + (Sizeof(Single)-1)>= FDataLength then @@ -7011,6 +7335,9 @@ function TPSExec.DoMinus(Dta: Pointer; aType: TPSTypeRec): Boolean; {$IFNDEF PS_NOINT64} bts64: tbts64(dta^) := -tbts64(dta^); {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: tbtu64(dta^) := -tbtu64(dta^); + {$ENDIF} btSingle: tbtsingle(dta^) := -tbtsingle(dta^); btDouble: tbtdouble(dta^) := -tbtdouble(dta^); btExtended: tbtextended(dta^) := -tbtextended(dta^); @@ -7047,6 +7374,9 @@ function TPSExec.DoBooleanNot(Dta: Pointer; aType: TPSTypeRec): Boolean; {$IFNDEF PS_NOINT64} bts64: tbts64(dta^) := tbts64(tbts64(dta^) = 0); {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: tbtu64(dta^) := tbtu64(tbtu64(dta^) = 0); + {$ENDIF} btVariant: begin try @@ -7591,6 +7921,9 @@ function TPSExec.DoIntegerNot(Dta: Pointer; aType: TPSTypeRec): Boolean; {$IFNDEF PS_NOINT64} bts64: tbts64(dta^) := not tbts64(dta^); {$ENDIF} + {$IFNDEF PS_NOUINT64} + btu64: tbtu64(dta^) := not tbtu64(dta^); + {$ENDIF} btVariant: begin try @@ -8727,6 +9060,9 @@ function TPSExec.RunScript: Boolean; bts32: dec(tbts32(vd.P^)); {$IFNDEF PS_NOINT64} bts64: dec(tbts64(vd.P^)); +{$ENDIF} +{$IFNDEF PS_NOUINT64} + btu64: dec(tbtu64(vd.P^)); {$ENDIF} else begin @@ -8758,6 +9094,9 @@ function TPSExec.RunScript: Boolean; bts32: Inc(tbts32(vd.P^)); {$IFNDEF PS_NOINT64} bts64: Inc(tbts64(vd.P^)); +{$ENDIF} +{$IFNDEF PS_NOUINT64} + btu64: Inc(tbtu64(vd.P^)); {$ENDIF} else begin @@ -9349,6 +9688,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)))); // StrToInt64 + 46: Stack.SetAnsiString(-1, tbtstring(SysUtils.IntToStr(Stack.GetUInt64(-2))));// Int64ToStr + 47: Stack.SetUInt64(-1, StrToUInt64Def(string(Stack.GetAnsiString(-2)), Stack.GetUInt64(-3))); // StrToInt64Def {$ENDIF} else begin @@ -9459,6 +9803,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 @@ -9509,6 +9861,11 @@ function Low_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): {$IFNDEF PS_NOINT64} btS64 : Stack.SetInt64(-1,Low(Int64)); //Int64: -9223372036854775808 {$ENDIF} +{$IFNDEF PS_NOINT64} + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + btU64 : Stack.SetUInt64(-1, UInt64( 0 ) ); //UInt64: 0 + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 +{$ENDIF} else Result:=false; end; end; @@ -9531,6 +9888,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 +{$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; @@ -9551,6 +9915,11 @@ 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 < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + btU64 : Stack.SetUInt64(-1,Tbtu64(arr.dta^)-1); + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 {$ENDIF} else Result:=false; end; @@ -9571,6 +9940,11 @@ 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 < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + btU64 : Stack.SetUInt64(-1,Tbtu64(arr.dta^)+1); + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 {$ENDIF} else Result:=false; end; @@ -9645,6 +10019,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); @@ -9711,6 +10086,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; @@ -9782,6 +10164,9 @@ function IntPIFVariantToVariant(Src: pointer; aType: TPSTypeRec; var Dest: Varia btPChar: Dest := ToString(PansiChar(Src^)); {$IFNDEF PS_NOINT64} {$IFDEF DELPHI6UP} btS64: Dest := tbts64(Src^); {$ELSE} 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^)); {$IFNDEF PS_NOWIDESTRING} @@ -9950,6 +10335,13 @@ function CreateOpenArray(VarParam: Boolean; Sender: TPSExec; val: PPSVariantIFC) tvarrec(p^).VInt64^ := tbts64(cp^); end; {$ENDIF} + {$IFNDEF PS_NOUINT64} + btU64: begin + tvarrec(p^).VType := vtInt64; + New(tvarrec(p^).VInt64); + tvarrec(p^).VInt64^ := tbtu64(cp^); + end; + {$ENDIF} btString: begin tvarrec(p^).VType := vtAnsiString; tbtString(TVarRec(p^).VAnsiString) := tbtstring(cp^); @@ -10051,6 +10443,13 @@ procedure DestroyOpenArray(Sender: TPSExec; V: POpenArray); dispose(tvarrec(p^).VInt64); end; {$ENDIF} + {$IFNDEF PS_NOUINT64} + btU64: begin + if v^.VarParam then + tbtu64(cp^) := tbtu64( tvarrec(p^).vInt64^ ); + dispose(tvarrec(p^).vInt64); + end; + {$ENDIF} {$IFNDEF PS_NOWIDESTRING} btWideChar: begin if v^.varParam then @@ -10114,6 +10513,7 @@ procedure DestroyOpenArray(Sender: TPSExec; V: POpenArray); {$ENDIF} {$IFDEF USEINVOKECALL} + {$DEFINE RTTI_InvokeFix} {$include InvokeCall.inc} {$DEFINE _INVOKECALL_INC_} {$ELSE} @@ -10128,7 +10528,7 @@ procedure DestroyOpenArray(Sender: TPSExec; V: POpenArray); {$ENDIF} {$ENDIF} {$ELSE} - + {$IFDEF USEINVOKECALL} {$include InvokeCall.inc} {$DEFINE _INVOKECALL_INC_} @@ -10282,12 +10682,16 @@ 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 < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 if (IPointer(p^[I]) > IPointer(p)) and ((IPointer(p^[I]) - IPointer(p)) + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 div //PointerSize < Ret.FEndOfVMT) then PointerSize < Cardinal(Ret.FEndOfVMT)) then begin + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 Ret.FEndOfVMT := (IPointer(p^[I]) - IPointer(p)) div SizeOf(Pointer); + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 end; end; end; @@ -11692,11 +12096,14 @@ destructor TPSRuntimeClass.Destroy; I: Longint; P: PClassItem; begin - for i:= FClassItems.Count -1 downto 0 do - begin - P := FClassItems[I]; - Dispose(p); - end; + if ( FClassItems.Count > 0 ) then + begin + for i:= FClassItems.Count -1 downto 0 do + begin + P := FClassItems[I]; + Dispose(p); + end; + end; FClassItems.Free; inherited Destroy; end; @@ -11997,6 +12404,9 @@ function ResultAsRegister(b: TPSTypeRec): Boolean; {$ENDIF} {$IFNDEF PS_NOINT64} bts64, +{$ENDIF} +{$IFNDEF PS_NOUINT64} + btU64, {$ENDIF} btPChar, {$IFNDEF PS_NOWIDESTRING} @@ -12417,6 +12827,9 @@ function MyAllMethodsHandler2(Self: PScriptMethodInfo; const Stack: PPointer; _E begin {$IFNDEF PS_NOINT64} 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; @@ -12446,15 +12859,18 @@ function TPSRuntimeClassImporter.FindClass(const Name: tbtString): TPSRuntimeCla begin lName := FastUpperCase(Name); h := MakeHash(lName); - for i := FClasses.Count -1 downto 0 do - begin - p := FClasses[i]; - if (p.FClassNameHash = h) and (p.FClassName = lName) then + if ( FClasses.Count > 0 ) then begin - Result := P; - exit; + for i := FClasses.Count -1 downto 0 do + begin + p := FClasses[i]; + if (p.FClassNameHash = h) and (p.FClassName = lName) then + begin + Result := P; + exit; + end; + end; end; - end; Result := nil; end; @@ -12610,8 +13026,11 @@ destructor TPSRuntimeAttributes.Destroy; var i: Longint; begin - for i := FAttributes.Count -1 downto 0 do - TPSRuntimeAttribute(FAttributes[i]).Free; + if ( FAttributes.Count > 0 ) then + begin + for i := FAttributes.Count -1 downto 0 do + TPSRuntimeAttribute(FAttributes[i]).Free; + end; FAttributes.Free; inherited Destroy; end; @@ -12706,12 +13125,15 @@ procedure TPSStack.Clear; v: Pointer; i: Longint; begin - for i := Count -1 downto 0 do - begin - v := Data[i]; - if TPSTypeRec(v^).BaseType in NeedFinalization then - FinalizeVariant(Pointer(IPointer(v)+PointerSize), TPSTypeRec(v^)); - end; + if ( Count > 0 ) then + begin + for i := Count -1 downto 0 do + begin + v := Data[i]; + if TPSTypeRec(v^).BaseType in NeedFinalization then + FinalizeVariant(Pointer(IPointer(v)+PointerSize), TPSTypeRec(v^)); + end; + end; inherited Clear; FLength := 0; SetCapacity(0); @@ -12730,12 +13152,15 @@ destructor TPSStack.Destroy; v: Pointer; i: Longint; begin - for i := Count -1 downto 0 do - begin - v := Data[i]; - if TPSTypeRec(v^).BaseType in NeedFinalization then - FinalizeVariant(Pointer(IPointer(v)+PointerSize), Pointer(v^)); - end; + if ( Count > 0 ) then + begin + for i := Count -1 downto 0 do + begin + v := Data[i]; + if TPSTypeRec(v^).BaseType in NeedFinalization then + FinalizeVariant(Pointer(IPointer(v)+PointerSize), Pointer(v^)); + end; + end; FreeMem(FDataPtr, FCapacity); inherited Destroy; end; @@ -12797,6 +13222,19 @@ function TPSStack.GetInt64(ItemNo: Longint): Int64; end; {$ENDIF} +{$IFNDEF PS_NOUINT64} +function TPSStack.GetUInt64(ItemNo: Longint): UInt64; +var + val: PPSVariant; +begin + if ItemNo < 0 then + val := items[Longint(ItemNo) + Longint(Count)] + else + val := items[ItemNo]; + Result := PSGetUInt64(@PPSVariantData(val).Data, val.FType); +end; +{$ENDIF} + function TPSStack.GetItem(I: Longint): PPSVariant; begin if Cardinal(I) >= Cardinal(Count) then @@ -13021,6 +13459,22 @@ procedure TPSStack.SetInt64(ItemNo: Longint; const Data: Int64); end; {$ENDIF} +{$IFNDEF PS_NOUINT64} +procedure TPSStack.SetUInt64(ItemNo: Longint; const Data: UInt64); +var + val: PPSVariant; + ok: Boolean; +begin + if ItemNo < 0 then + val := items[Longint(ItemNo) + Longint(Count)] + else + val := items[ItemNo]; + ok := true; + PSSetUInt64(@PPSVariantData(val).Data, val.FType, ok, Data); + if not ok then raise Exception.Create(RPS_TypeMismatch); +end; +{$ENDIF} + procedure TPSStack.SetReal(ItemNo: Longint; const Data: Extended); var val: PPSVariant; diff --git a/Source/uPSUtils.pas b/Source/uPSUtils.pas index f36b0544..94451255 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}; @@ -69,29 +74,33 @@ interface btS64 = 17; {$ENDIF} - btChar = 18; +{$IFNDEF PS_NOUINT64} + btu64 = 18; +{$ENDIF} + + btChar = 19; {$IFNDEF PS_NOWIDESTRING} - btWideString = 19; + btWideString = 20; - btWideChar = 20; + btWideChar = 21; {$ENDIF} - btProcPtr = 21; + btProcPtr = 22; - btStaticArray = 22; + btStaticArray = 23; - btSet = 23; + btSet = 24; - btCurrency = 24; + btCurrency = 25; - btClass = 25; + btClass = 26; - btInterface = 26; + btInterface = 27; - btNotificationVariant = 27; + btNotificationVariant = 28; - btUnicodeString = 28; + btUnicodeString = 29; btType = 130; @@ -302,11 +311,15 @@ function MakeHash(const s: TbtString): Longint; tbtCurrency = Currency; {$IFNDEF PS_NOINT64} - tbts64 = int64; {$ENDIF} +{$IFNDEF PS_NOUINT64} + tbtu64 = uint64; +{$ENDIF} + tbtchar = {$IFDEF DELPHI4UP}AnsiChar{$ELSE}CHAR{$ENDIF}; + tbtansichar = AnsiChar; {$IFNDEF PS_NOWIDESTRING} tbtwidestring = widestring; @@ -318,7 +331,7 @@ function MakeHash(const s: TbtString): Longint; {$IFDEF FPC} IPointer = PtrUInt; {$ELSE} - {$IFDEF DELPHI2009UP} + {$IFDEF DELPHIXE2UP} IPointer = NativeUInt; {$ELSE} IPointer = Cardinal; @@ -426,9 +439,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 @@ -586,6 +599,7 @@ TPSPascalParser = class(TObject) property OriginalToken: TbtString read FOriginalToken; property CurrTokenPos: Cardinal read FRealPosition; + property CurrTokenLength: Cardinal read FTokenLength; property CurrTokenID: TPSPasToken read FTokenId; @@ -628,8 +642,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 } @@ -1222,7 +1248,7 @@ procedure TPSPascalParser.Next; while p^<>#0 do begin if p^ in [#97..#122] then - Dec(Byte(p^), 32); + Dec(p^, 32); inc(p); end; if not CheckReserved(FLastUpToken, CurrTokenId) then @@ -1727,8 +1753,33 @@ procedure TPSUnit.SetUnitName(const Value: TbtString); fUnitName := FastUpperCase(Value); end; +{$IF CompilerVersion < 23} +{$RANGECHECKS OFF} +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; +{$RANGECHECKS ON} +{$IFEND} +end. diff --git a/Source/x64.inc b/Source/x64.inc index f5f1f63a..bfdde03e 100644 --- a/Source/x64.inc +++ b/Source/x64.inc @@ -519,7 +519,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{$ENDIF}: + {$IFNDEF PS_NOINT64}, bts64{$ENDIF} + {$IFNDEF PS_NOUINT64}, btu64{$ENDIF}: begin Varptr := fvar.Dta; end; diff --git a/Source/x86.inc b/Source/x86.inc index 957524de..9754096f 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{$ENDIF}: + {$IFNDEF PS_NOINT64}, bts64{$ENDIF} + {$IFNDEF PS_NOUINT64}, btu64{$ENDIF}: begin Varptr := fvar.Dta; end; @@ -482,6 +483,14 @@ var Int64((@TempStr[1])^) := int64(fvar^.dta^); UseReg := False; end;{$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: + begin + TempStr:= StringOfChar(AnsiChar(#0),8); + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + UInt64((@TempStr[1])^) := uint64(fvar^.dta^); + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 + UseReg := False; + end;{$ENDIF} end; {case} if UseReg then begin @@ -607,6 +616,14 @@ begin tbts64(res.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); end; {$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: + begin + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + 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 < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 + end; + {$ENDIF} btCurrency: tbtCurrency(res.Dta^) := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4) / 10000; btInterface, btVariant, @@ -665,6 +682,14 @@ begin tbts64(res^.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); end; {$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: + begin + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX); + tbtu64(res^.dta^) := UInt64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 + end; + {$ENDIF} btVariant, btInterface, btrecord, btstring: RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil); else @@ -724,6 +749,14 @@ begin tbts64(res^.Dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); end; {$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: + begin + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + 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 < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 + end; + {$ENDIF} btVariant, {$IFNDEF PS_NOWIDESTRING}btUnicodeString, btWideString, {$ENDIF} btInterface, btArray, btrecord, btstring: begin GetPtr(res); RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil); end; @@ -759,6 +792,14 @@ begin tbts64(res^.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX); end; {$ENDIF} + {$IFNDEF PS_NOUINT64}btu64: + begin + {$IF CompilerVersion < 23}{$RANGECHECKS OFF}{$IFEND} // RangeCheck might cause Internal-Error C1118 + EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX); + tbtu64(res^.dta^) := UInt64(Cardinal(EDX)) shl 32 or Cardinal(EAX); + {$IF CompilerVersion < 23}{$RANGECHECKS ON}{$IFEND} // RangeCheck might cause Internal-Error C1118 + end; + {$ENDIF} btVariant, {$IFNDEF PS_NOWIDESTRING}btUnicodeString, btWideString, {$ENDIF} btInterface, btArray, btrecord, btstring: begin GetPtr(res); RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil); end; else 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/Main.pas b/unit-importing/Main.pas index 8474813f..119e7bf1 100644 --- a/unit-importing/Main.pas +++ b/unit-importing/Main.pas @@ -6,7 +6,7 @@ interface Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, SynEditHighlighter, SynHighlighterPas, SynEdit, Menus, ExtCtrls, StdCtrls, SynEditMiscClasses, inifiles, ComCtrls, ImgList, ToolWin, - SynEditSearch, SynEditTypes; + SynEditSearch, SynEditTypes, System.ImageList, SynEditCodeFolding; type TfrmMain = class(TForm) 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 := '';