diff --git a/CORE/Packages/Delphi/RESTDWCore.dpk b/CORE/Packages/Delphi/RESTDWCore.dpk index dcff8691..6c795f19 100644 --- a/CORE/Packages/Delphi/RESTDWCore.dpk +++ b/CORE/Packages/Delphi/RESTDWCore.dpk @@ -29,6 +29,11 @@ package RESTDWCore; {$RUNONLY} {$IMPLICITBUILD OFF} +requires + rtl, + soaprtl, + dbrtl; + contains uRESTDWBasic in '..\..\Source\Basic\uRESTDWBasic.pas', uRESTDWBasicDB in '..\..\Source\Basic\uRESTDWBasicDB.pas', diff --git a/CORE/Source/Basic/uRESTDWProtoTypes.pas b/CORE/Source/Basic/uRESTDWProtoTypes.pas index 19b497bb..2acf1966 100644 --- a/CORE/Source/Basic/uRESTDWProtoTypes.pas +++ b/CORE/Source/Basic/uRESTDWProtoTypes.pas @@ -69,6 +69,7 @@ interface dwftGuid = Integer(DB.ftGuid); dwftTimeStamp = Integer(DB.ftTimeStamp); dwftFMTBcd = Integer(DB.ftFMTBcd); + dwftSingle = Integer(DB.ftFloat); {$IFDEF DELPHI2006UP} dwftFixedWideChar = Integer(DB.ftFixedWideChar); dwftWideMemo = Integer(DB.ftWideMemo); @@ -84,18 +85,17 @@ interface dwftLongWord = Integer(DB.ftLongWord); //42 dwftShortint = Integer(DB.ftShortint); //43 dwftByte = Integer(DB.ftByte); //44 - dwftExtended = Integer(DB.ftFloat); //45 + dwftExtended = Integer(DB.ftExtended); //45 dwftStream = Integer(DB.ftStream); //48 dwftTimeStampOffset = Integer(DB.ftTimeStampOffset); //49 - dwftSingle = Integer(DB.ftSingle); //51 {$ELSE} dwftLongWord = Integer(42); dwftShortint = Integer(43); dwftByte = Integer(44); - dwftExtended = Integer(45); + dwftExtended = Integer(ftFMTBcd); dwftStream = Integer(48); dwftTimeStampOffset = Integer(49); - dwftSingle = Integer(51); +// dwftSingle = Integer(51); {$ENDIF} {Unsupported types} dwftUnknown = Integer(DB.ftUnknown); diff --git a/CORE/Source/Basic/uRESTDWStorageBin.pas b/CORE/Source/Basic/uRESTDWStorageBin.pas index c68559ca..f903afbd 100644 --- a/CORE/Source/Basic/uRESTDWStorageBin.pas +++ b/CORE/Source/Basic/uRESTDWStorageBin.pas @@ -1,4 +1,4 @@ -unit uRESTDWStorageBin; +unit uRESTDWStorageBin; {$I ..\Includes\uRESTDW.inc} @@ -248,15 +248,23 @@ interface If (Not (Assigned(DataSet.FindField(FFieldNames[Index]))) And Not(FindDef(FFieldNames[Index]))) Then Begin - VFDef := DataSet.FieldDefs.AddFieldDef; - VFDef.Name := FFieldNames[Index]; - VFDef.DataType := DWFieldTypeToFieldType(FFieldTypes[Index]); - VFDef.Size := FFieldSize[Index]; + If FFieldTypes[Index] = {$IFDEF FPC}45{$ELSE}dwftExtended{$ENDIF} Then + Begin + DataSet.FieldDefs.Add(FFieldNames[Index], DWFieldTypeToFieldType(FFieldTypes[Index])); + VFDef := DataSet.FieldDefs[DataSet.FieldDefs.Count -1]; + End + Else + Begin + VFDef := DataSet.FieldDefs.AddFieldDef; + VFDef.Name := FFieldNames[Index]; + VFDef.DataType := DWFieldTypeToFieldType(FFieldTypes[Index]); + End; + If FFieldTypes[Index] <> dwftExtended Then + VFDef.Size := FFieldSize[Index]; VFDef.Required := FFieldAttrs[Index] and 1 > 0; Case FFieldTypes[Index] of dwftFloat, - dwftCurrency, - dwftSingle : VFDef.Precision := FFieldPrecision[Index]; + dwftCurrency : VFDef.Precision := FFieldPrecision[Index]; dwftBCD, dwftFMTBcd : Begin {$IFNDEF FPC} @@ -327,26 +335,22 @@ interface FFieldNames[I] := vFieldName; // field type AStream.Read(vFieldType, SizeOf(vFieldType)); - FFieldTypes[I] := vFieldType; + If vFieldType in [{$IFDEF FPC}45, {$ENDIF}dwftExtended] Then + FFieldTypes[I] := {$IFDEF FPC}Integer(ftFMTBcd){$ELSE}Integer(ftExtended){$ENDIF} + Else + FFieldTypes[I] := vFieldType; // field size AStream.Read(vFieldSize, SizeOf(vFieldSize)); FFieldSize[I] := vFieldSize; // field precision AStream.Read(vFieldPrecision, SizeOf(vFieldPrecision)); {$IFDEF FPC} - If vFieldType in [dwftSingle, dwftFloat, dwftFMTBcd, dwftBCD] Then - If vFieldType in [dwftFloat, dwftFMTBcd, dwftBCD] Then - Begin - If (vFieldPrecision < 12) Or - (FFieldPrecision[I] = 0) Then - FFieldPrecision[I] := 12; - End - Else - Begin - If (vFieldPrecision < 8) Or - (FFieldPrecision[I] = 0) Then - FFieldPrecision[I] := 8; - End; + If vFieldType in [dwftFloat, dwftFMTBcd, dwftBCD] Then + Begin + If (vFieldPrecision < 12) Or + (FFieldPrecision[I] = 0) Then + FFieldPrecision[I] := 12; + End; {$ELSE} FFieldPrecision[I] := vFieldPrecision; If vFieldType in [dwftSingle] Then @@ -425,6 +429,7 @@ interface vInt64 : DWInt64; vSingle : DWSingle; vDouble : DWDouble; + vExtended : DWLongDouble; vWord : DWWord; vCurrency : DWCurrency; vTimeStamp : {$IFDEF FPC} TTimeStamp {$ELSE} TSQLTimeStamp {$ENDIF}; @@ -469,12 +474,12 @@ interface dwftSmallint, dwftWord, dwftInteger, - dwftSingle, +// dwftSingle, dwftExtended, dwftFloat, dwftOraTimeStamp, dwftBCD, - dwftFMTBcd, +// dwftFMTBcd, dwftCurrency, dwftDate, dwftTime, @@ -653,22 +658,22 @@ interface Move(vVarBytes[0], PData^, Sizeof(Boolean) + Sizeof(vInt)); End; End; - // 4 - Bytes - Flutuantes - dwftSingle :Begin // Gledston - vLength := SizeOf(vDouble); - stream.Read(vDouble, vLength); - If aField <> Nil Then - Begin - //Move(vSingle,PData^,Sizeof(vSingle)); - SetLength(vVarBytes, Sizeof(Boolean) + Sizeof(vDouble)); - //Move Null para Bytes - Move(vBoolean, vVarBytes[0], Sizeof(Boolean)); - //Move Bytes do Dado para Bytes - Move(vDouble, vVarBytes[1], Sizeof(vDouble)); - //Move Bytes para Buffer - Move(vVarBytes[0], PData^, Length(vVarBytes)); - End; - End; +// // 4 - Bytes - Flutuantes +// dwftSingle :Begin // Gledston +// vLength := SizeOf(vDouble); +// stream.Read(vDouble, vLength); +// If aField <> Nil Then +// Begin +// //Move(vSingle,PData^,Sizeof(vSingle)); +// SetLength(vVarBytes, Sizeof(Boolean) + Sizeof(vDouble)); +// //Move Null para Bytes +// Move(vBoolean, vVarBytes[0], Sizeof(Boolean)); +// //Move Bytes do Dado para Bytes +// Move(vDouble, vVarBytes[1], Sizeof(vDouble)); +// //Move Bytes para Buffer +// Move(vVarBytes[0], PData^, Length(vVarBytes)); +// End; +// End; // 8 - Bytes - Inteiros dwftLargeint, dwftAutoInc, @@ -686,7 +691,13 @@ interface End; End; // 8 - Bytes - Flutuantes - dwftFloat :Begin + dwftFloat + {$IFDEF FPC} + , 45 //Extended + {$ENDIF} + , dwftExtended + + :Begin stream.Read(vDouble, SizeOf(vDouble)); If aField <> Nil Then Begin @@ -699,23 +710,23 @@ interface Move(vVarBytes[0], PData^, Length(vVarBytes)); End; End; - //dwftExtended :Begin - // stream.Read(vDouble, SizeOf(Extended)); - // If aField <> Nil Then - // Begin - // SetLength(vVarBytes, Sizeof(Boolean) + Sizeof(Extended)); - // //Move Null para Bytes - // Move(vBoolean, vVarBytes[0], Sizeof(Boolean)); - // //Move Bytes do Dado para Bytes - // Move(vDouble, vVarBytes[1], Sizeof(Extended)); - // //Move Bytes para Buffer - // {$IFDEF FPC} - // PRESTDWBytes(pData)^ := vVarBytes; - // {$ELSE} - // Move(vVarBytes[0], PData^, Sizeof(Boolean) + Sizeof(vDouble)); - // {$ENDIF} - // End; - // End; +// dwftExtended :Begin +// stream.Read(vExtended, SizeOf(vExtended)); +// If aField <> Nil Then +// Begin +// SetLength(vVarBytes, Sizeof(Boolean) + Sizeof(vExtended)); +// //Move Null para Bytes +// Move(vBoolean, vVarBytes[0], Sizeof(Boolean)); +// //Move Bytes do Dado para Bytes +// Move(vExtended, vVarBytes[1], Sizeof(vExtended)); +// //Move Bytes para Buffer +// {$IFDEF FPC} +// PRESTDWBytes(pData)^ := vVarBytes; +// {$ELSE} +// Move(vVarBytes[0], PData^, Sizeof(Boolean) + Sizeof(vExtended)); +// {$ENDIF} +// End; +// End; // 8 - Bytes - Date, Time, DateTime, TimeStamp dwftDate, dwftTime, @@ -822,7 +833,7 @@ interface End; End; // 8 - Bytes - Currency - dwftFMTBcd :Begin + {$IFNDEF FPC}dwftFMTBcd : Begin stream.Read(vCurrency, SizeOf(vCurrency)); {$IFDEF FPC} vBCD := CurrToBcd(vCurrency); @@ -841,6 +852,7 @@ interface //Move Bytes para Buffer Move(vVarBytes[0], PData^, Sizeof(Boolean) + Sizeof(vBCD)); End; + {$ENDIF} //N Bytes - String Blobs dwftWideMemo, dwftFmtMemo, @@ -1340,6 +1352,7 @@ interface vSingle : DWSingle; vDouble : DWDouble; vCurrency : DWCurrency; + vExtended : DWLongDouble; vBCD : DWBCD; vMemoryStream : TMemoryStream; vBoolean : Boolean; @@ -1456,11 +1469,11 @@ interface Move(PData^, vInt, Sizeof(vInt)); Stream.Write(vByte, Sizeof(vInt)); End; - // 4 - Bytes - Flutuantes - dwftSingle : Begin - Move(PData^, vDouble, Sizeof(vDouble)); - Stream.Write(vDouble, Sizeof(vDouble)); - End; +// // 4 - Bytes - Flutuantes +// dwftSingle : Begin +// Move(PData^, vDouble, Sizeof(vDouble)); +// Stream.Write(vDouble, Sizeof(vDouble)); +// End; // 8 - Bytes - Inteiros dwftLargeint, dwftAutoInc, @@ -1506,6 +1519,10 @@ interface Move(PData^, vCurrency, Sizeof(vCurrency)); Stream.Write(vCurrency, Sizeof(vCurrency)); End; + dwftExtended : Begin + Move(PData^, vExtended, Sizeof(vExtended)); + Stream.Write(vExtended, Sizeof(vExtended)); + End; // 8 - Bytes - Currency dwftBCD : Begin {$IFDEF FPC} @@ -1520,6 +1537,7 @@ interface {$ENDIF} Stream.Write(vCurrency, Sizeof(vCurrency)); End; + {$IFNDEF FPC} // 8 - Bytes - Currency dwftFMTBcd : Begin Move(PData^, vBCD, Sizeof(vBCD)); @@ -1534,6 +1552,7 @@ interface {$ENDIF} Stream.Write(vCurrency, Sizeof(vCurrency)); End; + {$ENDIF} // N Bytes - Blobs // dwftWideMemo, // dwftFmtMemo, @@ -1601,6 +1620,7 @@ interface vInt : DWInteger; vDouble : DWDouble; vWord : DWWord; + vExtended : DWLongDouble; vSingle : DWSingle; vCurrency : DWCurrency; vMemoryStream : TMemoryStream; @@ -1674,10 +1694,10 @@ interface AStream.Write(vInt, Sizeof(vInt)); End; // 4 - Bytes - Flutuantes - dwftSingle : Begin - vSingle := ADataset.Fields[i].Value; - AStream.Write(vSingle, SizeOf(vSingle)); - End; +// dwftSingle : Begin +// vSingle := ADataset.Fields[i].Value; +// AStream.Write(vSingle, SizeOf(vSingle)); +// End; // 8 - Bytes - Inteiros dwftLargeint, dwftAutoInc, @@ -1690,10 +1710,19 @@ interface AStream.Write(vInt64, Sizeof(vInt64)); End; // 8 - Bytes - Flutuantes - dwftFloat : Begin - vDouble := ADataset.Fields[i].AsFloat; - AStream.Write(vDouble, Sizeof(vDouble)); - End; + dwftFloat + {$IFDEF FPC} + , 45, dwftExtended + {$ENDIF} : Begin + vDouble := ADataset.Fields[i].AsFloat; + AStream.Write(vDouble, Sizeof(vDouble)); + End; + {$IFNDEF FPC} + dwftExtended : Begin + vExtended := ADataset.Fields[i]{$IFNDEF FPC}.AsExtended{$ELSE}.AsFloat{$ENDIF}; + AStream.Write(vExtended, Sizeof(vExtended)); + End; + {$ENDIF} // 8 - Bytes - Date, Time, DateTime, TimeStamp dwftDate, dwftTime, @@ -1717,8 +1746,10 @@ interface {$ENDIF} // 8 - Bytes - Currency dwftCurrency, - dwftBCD, - dwftFMTBcd : Begin + dwftBCD + {$IFNDEF FPC} + , dwftFMTBcd + {$ENDIF} : Begin {$IFDEF FPC} If ADataset.Fields[i].Isnull Then vCurrency := 0 diff --git a/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas b/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas index e80da5ea..87987b1e 100644 --- a/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas +++ b/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas @@ -563,7 +563,7 @@ procedure TRESTDWDrvDataset.ImportParams(DWParams: TRESTDWParams); else vParam.Clear; end - else if vParam.RESTDWDataTypeParam in [dwftFloat,dwftBCD,dwftFMTBcd,dwftSingle,dwftExtended] then begin + else if vParam.RESTDWDataTypeParam in [dwftFloat,dwftBCD,dwftFMTBcd{$IFNDEF FPC},dwftExtended{$ENDIF}] then begin if (Trim(DWParams[I].Value) <> '') and (not DWParams[I].IsNull) then vParam.Value := StrToFloat(BuildFloatString(DWParams[I].Value)) else @@ -1323,7 +1323,7 @@ procedure TRESTDWDriverBase.SetUpdateBuffer(var Query: TRESTDWDrvQuery; End; End; end - else if vParam.RESTDWDataTypeParam in [dwftFloat, dwftCurrency, dwftBCD, dwftFMTBcd, dwftSingle] then begin + else if vParam.RESTDWDataTypeParam in [dwftFloat, dwftCurrency, dwftBCD, dwftFMTBcd] then begin if (not (MassiveDataset.AtualRec.PrimaryValues[X].IsNull)) then vParam.AsFloat := StrToFloat(BuildFloatString(MassiveDataset.AtualRec.PrimaryValues[X].Value)); end @@ -1393,7 +1393,7 @@ procedure TRESTDWDriverBase.SetUpdateBuffer(var Query: TRESTDWDrvQuery; else vParam.Clear; end - else if vParam.RESTDWDataTypeParam in [dwftFloat, dwftCurrency, dwftBCD, dwftFMTBcd, dwftSingle] then begin + else if vParam.RESTDWDataTypeParam in [dwftFloat, dwftCurrency, dwftBCD, dwftFMTBcd] then begin if (not (MassiveDataset.Fields.FieldByName(vParam.Name).IsNull)) then vParam.AsFloat := StrToFloat(BuildFloatString(MassiveDataset.Fields.FieldByName(vParam.Name).Value)) else @@ -4179,7 +4179,7 @@ procedure TRESTDWDriverBase.PrepareDataQuery(var Query: TRESTDWDrvQuery; else vParam.Clear; end - else if vParam.RESTDWDataTypeParam in [dwftFloat, dwftCurrency, dwftBCD, dwftFMTBcd,dwftSingle] then begin + else if vParam.RESTDWDataTypeParam in [dwftFloat, dwftCurrency, dwftBCD, dwftFMTBcd] then begin if (not (MassiveDataset.Params.ItemsString[vParam.Name].IsNull)) then vParam.AsFloat := StrToFloat(BuildFloatString(MassiveDataset.Params.ItemsString[vParam.Name].Value)) else @@ -4268,7 +4268,7 @@ procedure TRESTDWDriverBase.PrepareDataQuery(var Query: TRESTDWDrvQuery; else vParam.Clear; end - else if vParam.RESTDWDataTypeParam in [dwftFloat, dwftCurrency, dwftBCD, dwftFMTBcd, dwftSingle] then begin + else if vParam.RESTDWDataTypeParam in [dwftFloat, dwftCurrency, dwftBCD, dwftFMTBcd] then begin if (not (MassiveDataset.Fields.FieldByName(vParam.Name).IsNull)) then vParam.AsFloat := StrToFloat(BuildFloatString(MassiveDataset.Fields.FieldByName(vParam.Name).Value)) else diff --git a/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas b/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas index 4d81535e..5ffde630 100644 --- a/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas +++ b/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas @@ -43,7 +43,7 @@ {$IFNDEF FPC} {$IF CompilerVersion >= 20} ftOraTimestamp, ftFixedWideChar, ftTimeStampOffset, - ftLongWord, ftShortint, ftByte, ftExtended, ftSingle, + ftLongWord, ftShortint, ftByte, ftSingle, ftExtended, {$IFEND} {$ELSE} ftFixedWideChar, @@ -67,14 +67,14 @@ size : Integer; options : TLocateOptions) : Int64; TDBCompareRec = Record - CompareFunc : TCompareFunc; - Off : Int64; - NullBOff : Int64; - FieldInd : longint; - Size : integer; - Options : TLocateOptions; - Desc : Boolean; - end; + CompareFunc : TCompareFunc; + Off : Int64; + NullBOff : Int64; + FieldInd : longint; + Size : integer; + Options : TLocateOptions; + Desc : Boolean; + End; TDBCompareStruct = array of TDBCompareRec; Type @@ -158,6 +158,37 @@ BookmarkFlag : TBookmarkFlag; End; + { + TStreamField = Class(TBlobField) + Private + FStream : TStream; + Function GetAsStream : TStream; + Public + Constructor Create(AOwner : TComponent); Override; + Destructor Destroy; Override; + Procedure Put; + Property Value : TStream Read GetAsStream; + End; + + TdwcolorOptions = Set Of (dwcoAllowedSharp, dwcoShowWebSharp, dwcoSysColors); + TColorField = class(TIntegerField) + Private + FOptions : TdwcolorOptions; + Protected + Function GetIdentText (AValue : Integer; + Var Text : String) : Boolean; Virtual;Overload; + Procedure GetText (Var Text : String; + DisplayText : Boolean); Override; + Function SetAsIdentString(Const AValue : String) : Boolean; Virtual; + Procedure SetAsString (Const AValue : String); Override; + Public + Constructor Create (AOwner : TComponent); Override; + Published + Property MaxValue Stored False; + Property MinValue Stored False; + Property Options : TdwcolorOptions Read FOptions Write FOptions Default [dwcoAllowedSharp]; + End; +} IRESTDWMemTable = Interface Function GetRecordCount : Integer; Function GetMemoryRecord (Index : Integer) : TRESTDWMTMemoryRecord; @@ -427,7 +458,6 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) End; { TRESTDWMemTable } - TRESTDWMemTable = Class(TDataset, IRESTDWMemTable) Private FSaveLoadState : TSaveLoadState; @@ -465,6 +495,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) FDataSetClosed, FLoadStructure, FLoadRecords : Boolean; + FDsgnFieldName, FIndexFieldNames, FIndexName, FStatusName, @@ -474,6 +505,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) FAfterApply : TApplyEvent; FBeforeApplyRecord, FAfterApplyRecord : TApplyRecordEvent; + FFieldName : Array Of String; FNullmaskSize : Byte; FFilterParser : TExprParser; FStorageDataType : TRESTDWStorageBase; @@ -481,6 +513,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) FIndexes : TRESTDWDataSetIndexDefs; FDefaultIndex, FCurrentIndexDef : TRESTDWDatasetIndex; + FFieldDefClass : TFieldClass; {$IFDEF FPC} vDatabaseCharSet : TDatabaseCharSet; Procedure SetDatabaseCharSet(Value : TDatabaseCharSet); @@ -525,6 +558,9 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Buffer : Pointer; Const ValidateBuffer : TRESTDWMTValueBuffer); Protected + Function IsLookup (Index : Integer): Boolean; + Function GetFieldDef (Index : Integer): Integer; + Function GetFieldIndex (Const aName : String) : Integer; Function FindFieldIndex (Field : TField) : Integer; Function FindFieldData (Buffer : Pointer; Field : TField) : Pointer; @@ -532,6 +568,10 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Data2 : Pointer; FieldType : TFieldType; CaseInsensitive : Boolean): Integer; Virtual; + Function GetFieldClass (FieldType : TFieldType) : TFieldClass; Override; + Procedure DesignNotify (Const AFieldName : String; + Dummy : Integer); + // Delphi 2006+ has support for DWWideString {$IF DEFINED(FPC) OR DEFINED(RESTDWVCL)} Procedure DataConvert (Field : TField; @@ -539,11 +579,12 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Dest : Pointer; ToNative : Boolean); Override; {$IFEND} - Procedure AssignMemoryRecord(Rec : TRESTDWMTMemoryRecord; +// Procedure DefChanged (Sender : TObject); Override; + Procedure AssignMemoryRecord (Rec : TRESTDWMTMemoryRecord; Buffer : PRESTDWMTMemBuffer); - Function GetActiveRecBuf (Var RecBuf : PRESTDWMTMemBuffer) : Boolean; Virtual; - Procedure InitFieldDefsFromFields; - Procedure RecordToBuffer (Rec : TRESTDWMTMemoryRecord; + Function GetActiveRecBuf (Var RecBuf : PRESTDWMTMemBuffer) : Boolean; Virtual; + Procedure InitFieldDefsFromFields; + Procedure RecordToBuffer (Rec : TRESTDWMTMemoryRecord; Buffer : PRESTDWMTMemBuffer); Procedure SetMemoryRecordData(Buffer : PRESTDWMTMemBuffer; Pos : Integer); Virtual; @@ -798,6 +839,74 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Property OnPostError; End; +{$IFNDEF FPC} + {$IF CompilerVersion > 24} + TExtendedField = Class(TNumericField) + Protected + Function GetAsExtended : Extended; + Function GetAsString : String; Override; + Function GetAsVariant : Variant; Override; + Procedure SetAsExtended(Const AValue : Extended); + Procedure SetAsString (Const AValue : String); Override; + Procedure SetVarValue (Const AValue : Variant); Override; + Private + vSize, + vPrecision : Integer; + Public + Constructor Create(AOwner: TComponent); override; + {$IFNDEF SUPPORTS_CLASS_HELPERS} + Property AsExtended : Extended Read GetAsExtended Write SetAsExtended; + {$ENDIF} + Property Value : Extended Read GetAsExtended Write SetAsExtended; + Property Size : Integer Read vSize Write vSize; + Published + Property Precision : Integer Read vPrecision Write vPrecision; + End; + {$ELSE} + TExtendedField = Class(TNumericField) + Protected + {$IFDEF COMPILER17_UP} + Function GetAsExtended : Extended; Override; + {$ENDIF} + Function GetAsVariant : Variant; Override; + End; + {$IFEND} +{$ELSE} +TExtendedField = Class(TNumericField) +Private + vSize, + vPrecision : Integer; +Protected + Function GetAsString : String; Override; + Function GetAsVariant : Variant; Override; +Public + Constructor Create(AOwner: TComponent); override; + Property Size : Integer Read vSize Write vSize; +Published + Property Precision : Integer Read vPrecision Write vPrecision; +End; +{$ENDIF} + +{$IFNDEF FPC} + TSQLTimeStampOffsetField = Class(TSQLTimeStampField) + Protected + {$IF CompilerVersion < 25} + Procedure GetText (Var Text : String; + DisplayText : Boolean); Override; + {$IFEND} + {$IFDEF FPC} + Procedure SetAsString(const Value: string); override; + {$ELSE} + {$IF CompilerVersion < 25} + Procedure SetAsString(const Value: string); override; + {$ELSE} + Procedure SetAsString(Const AValue : String); Override; + {$IFEND} + {$ENDIF} + End; +{$ENDIF} + + TRESTDWMTMemBlobStream = Class(TStream) Private FField : TBlobField; @@ -893,6 +1002,74 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Property RecordCount : Integer Read GetFilteredRecordCount; End; +Var + DefaultFieldClasses : Array[TFieldType] Of TFieldClass = (nil, { ftUnknown } + TStringField, { ftString } + TSmallintField, { ftSmallint } + TIntegerField, { ftInteger } + TWordField, { ftWord } + TBooleanField, { ftBoolean } + TFloatField, { ftFloat } + TCurrencyField, { ftCurrency } + TBCDField, { ftBCD } + TDateField, { ftDate } + TTimeField, { ftTime } + TDateTimeField, { ftDateTime } + TBytesField, { ftBytes } + TVarBytesField, { ftVarBytes } + TAutoIncField, { ftAutoInc } + TBlobField, { ftBlob } + TMemoField, { ftMemo } + TGraphicField, { ftGraphic } + TBlobField, { ftFmtMemo } + TBlobField, { ftParadoxOle } + TBlobField, { ftDBaseOle } + TBlobField, { ftTypedBinary } + nil, { ftCursor } + TStringField, { ftFixedChar } + TWideStringField, { ftWideString } + TLargeIntField, { ftLargeInt } + {$IFNDEF FPC}TADTField,{ ftADT }{$ELSE}Nil,{$ENDIF} + {$IFNDEF FPC}TArrayField,{ ftArray }{$ELSE}Nil,{$ENDIF} + {$IFNDEF FPC}TReferenceField,{ ftReference }{$ELSE}Nil,{$ENDIF} + {$IFNDEF FPC}TDataSetField,{ ftDataSet }{$ELSE}Nil,{$ENDIF} + TBlobField, { ftOraBlob } + TMemoField, { ftOraClob } + TVariantField, { ftVariant } + {$IFNDEF FPC}TInterfaceField,{ ftInterface }{$ELSE}Nil,{$ENDIF} + {$IFNDEF FPC}TIDispatchField,{ ftIDispatch }{$ELSE}Nil,{$ENDIF} + TGuidField,{ ftGuid } + {$IFNDEF FPC}TSQLTimeStampField, { ftTimeStamp }{$ELSE}Nil,{$ENDIF} + TExtendedField{ ftFMTBcd } +// {$IFNDEF FPC}TFMTBcdField{$ELSE}TExtendedField{$ENDIF}{ ftFMTBcd } + {$IFNDEF FPC} + {$IFDEF DELPHI2010UP}, + TWideStringField, { ftFixedWideChar } + TWideMemoField, { ftWideMemo } + TSQLTimeStampField, { ftOraTimeStamp } + TStringField { ftOraInterval } + {$ENDIF} + {$ELSE}, + TStringField { ftOraInterval } + {$ENDIF} + {$IFNDEF FPC} + {$IFDEF DELPHIXEUP}, + TLongWordField, { ftLongWord } + TShortintField, { ftShortint } + TByteField, { ftByte } + TExtendedField, + nil, { ftConnection } + nil, { ftParams } + TBlobField { ftStream } + {$ENDIF} + {$ELSE}, + TBlobField { ftStream } + {$ENDIF} + {$IFDEF DELPHIXE2UP}, + TSQLTimeStampOffsetField, { ftTimeStampOffset } + nil, { ftObject } + TSingleField { ftSingle }{$ENDIF}); + Implementation @@ -999,14 +1176,17 @@ TMemBookmarkInfo = record dwftInteger : Result := SizeOf(Integer); dwftWord : Result := SizeOf(Word); dwftBoolean : Result := SizeOf(Wordbool); - dwftFloat : Result := SizeOf(Double); - {$IFNDEF FPC} - {$IF CompilerVersion > 21} - dwftSingle : Result := SizeOf(Single); // + 5; - {$IFEND} - {$ELSE} - dwftSingle : Result := SizeOf(Double); - {$ENDIF} + dwftFloat + {$IFDEF FPC} + , 45 //Extended + {$ENDIF} : Result := SizeOf(Double); +// {$IFNDEF FPC} +// {$IF CompilerVersion > 21} +// dwftSingle : Result := SizeOf(Single); // + 5; +// {$IFEND} +// {$ELSE} +// dwftSingle : Result := SizeOf(Double); +// {$ENDIF} dwftCurrency : Result := SizeOf(Currency); dwftDate, dwftTime : Result := SizeOf(LongInt) + 8; @@ -1032,9 +1212,11 @@ TMemBookmarkInfo = record dwftLongWord : Result := SizeOf(LongWord); dwftShortint : Result := SizeOf(Shortint); dwftByte : Result := SizeOf(Byte); - //dwftExtended : Result := SizeOf(Double); //Gledston {$IFEND} {$ENDIF} + {$IFNDEF FPC} + dwftExtended : Result := SizeOf(DWLongDouble); + {$ENDIF} dwftADT : Result := 0; dwftFixedChar : Inc(Result); dwftWideString : Result := Result * SizeOf(WideChar); @@ -1081,6 +1263,40 @@ TMemBookmarkInfo = record DatabaseError(Msg); End; +Function RPos(Const Substr, S: String) : Integer; +Var + I, + X, + Len : Integer; +Begin + Len := Length(SubStr); + I := Length(S) - Len + 1; + if (I <= 0) or (Len = 0) then + Begin + RPos := 0; + Exit; + End + Else + Begin + While I > 0 Do + Begin + If S[I] = SubStr[InitStrPos] Then + Begin + X := InitStrPos; + While (X < Len) and (S[I + X] = SubStr[X + 1]) Do + Inc(X); + If (X = Len) Then + Begin + RPos := I; + Exit; + End; + End; + Dec(I); + End; + RPos := 0; + End; +End; + Procedure ErrorFmt(const Msg: string; const Args: array of const); Begin DatabaseErrorFmt(Msg, Args); @@ -1108,6 +1324,206 @@ TMemBookmarkInfo = record Inherited Destroy; End; +{$IFNDEF FPC} +{$IFDEF SUPPORTS_CLASS_HELPERS} +{$IFNDEF COMPILER10_UP} +Function TExtendedFieldHelper.GetAsExtendedHelper: Extended; +Begin + If Self Is TExtendedField Then + Result := TExtendedField(Self).GetAsExtended + Else + Result := Self.AsFloat; +End; + +Procedure TExtendedFieldHelper.SetAsExtendedHelper(Const Value: Extended); +Begin + If Self is TExtendedField then + TExtendedField(Self).SetAsExtended(Value) + Else + Self.AsFloat := Value; +End; +{$ENDIF} +{$ENDIF} +{$IF CompilerVersion > 24} +Function TExtendedField.GetAsExtended: Extended; +Var + Data : TValueBuffer; +Begin + {$IFNDEF FPC} + {$IF Defined(HAS_FMX)} + SetLength(Data, SizeOf(Extended)); + If not GetData(Data, True) then + Result := NaN + Else + Result := TBitConverter.InTo(Data); + {$ELSE} + If not GetData(@Result, True) then + Result := NaN; + {$IFEND} + {$ELSE} + If not GetData(@Result, True) then + Result := NaN; + {$ENDIF} +End; + +Function TExtendedField.GetAsVariant : Variant; +Begin + Result := GetAsExtended; +// Result := _RealSupportManager._VarFromReal(GetAsExtended); +End; + +Procedure TExtendedField.SetAsExtended(Const AValue : Extended); +Begin + {$IFNDEF FPC} + {$IF Defined(HAS_FMX)} + {$IF Defined(HAS_UTF8)} + SetData(TValueBuffer(@AValue), True); + {$ELSE} + SetData(@AValue, True); + {$IFEND} + {$ELSE} + SetData(@AValue, True); + {$IFEND} + {$ELSE} + SetData(@AValue, True); + {$ENDIF} +End; + +Procedure TExtendedField.SetAsString(Const AValue : String); +Var + x : Extended; +Begin + If AValue = '' Then + Clear + Else + Begin + x := StrToFloat(AValue); + SetAsExtended(x); + End; +End; + +Procedure TExtendedField.SetVarValue(Const AValue : Variant); +Begin + SetAsExtended(AValue); +End; +{$ELSE} +Function TExtendedField.GetAsVariant : Variant; +Begin + Result := Extended(Value);//_RealSupportManager._VarFromReal(Value); +End; +{$IFEND} +{$ENDIF} +Constructor TExtendedField.Create(AOwner: TComponent); +Begin + Inherited; + {$IFNDEF FPC} + SetDataType(ftExtended); + {$ELSE} + SetDataType(ftFMTBcd); + {$ENDIF} + vSize := 19; + vPrecision := 8; +End; + +Function TExtendedField.GetAsString: string; +Var + x : Extended; +{$IFDEF COMPILER17_UP} + Data: TValueBuffer; +{$ENDIF} + Function BuildMask(Value : Double; + aPrecision : Integer) : String; + Var + I : Integer; + vString : String; + Begin + vString := '#0.'; + For I := 0 To aPrecision -1 Do + vString := vString + '0'; + If aPrecision = 0 Then + vString := vString + '0'; + Result := FormatFloat(vString, Value); + End; +Begin + {$IFNDEF COMPILER17_UP} + If GetData(@x, True) then + Begin + {$ELSE} + SetLength(Data, SizeOf(Extended)); + If GetData(Data, True) then + Begin + {$IF CompilerVersion > 28} + x := TBitConverter.InTo(Data); + {$ELSE} + x := TBitConverter.ToExtended(Data); + {$IFEND} +// x := TBitConverter.InTo(Data); + {$ENDIF} + If (Length(FloatToStr(x)) > vSize) Then + Result := FloatToStrF(x, ffGeneral, vSize, vPrecision) + Else If (Length(FloatToStr(Frac(x))) > vPrecision) Then + Result := BuildMask(x, vPrecision) + Else + Result := FloatToStr(X); + If Trim(displayformat) <> '' Then + Result := FormatFloat(displayformat, x); + End + Else + Result := ''; +End; + +{$IFNDEF FPC} +{$IF CompilerVersion < 25} +Procedure TSQLTimeStampOffsetField.GetText(var Text: string; + DisplayText: Boolean); +Var + S : String; + D : TSQLTimeStamp; +Begin + If GetData(@D, False) then + Begin + If DisplayText and (DisplayFormat <> '') Then + S := DisplayFormat + Else + S := ''; + Text := SQLTimeStampToStr(S, D); + End + Else + Text := ''; +End; +{$IFEND} +{$ENDIF} + +{$IFNDEF FPC} +{$IF CompilerVersion < 25} +Procedure TSQLTimeStampOffsetField.SetAsString(Const Value: string); +{$ELSE} +Procedure TSQLTimeStampOffsetField.SetAsString(Const AValue: string); +{$IFEND} +Var + S : String; + P : Integer; +Begin + {$IF CompilerVersion < 25} + S := Value; + {$ELSE} + S := AValue; + {$IFEND} + P := RPos(' ', S); + If (P < 8) or (P = Length(S)) Then Exit; + If (Pos(S[P + 1], '-+') > 0) Then + SetLength(S, P - 1); + Inherited SetAsString(S); +End; +{$ENDIF} + +{$IFDEF FPC} +Function TExtendedField.GetAsVariant : Variant; +Begin + Result := Extended(Value); //_RealSupportManager._VarFromReal(Value); +End; +{$ENDIF} + Function TRESTDWMTMemoryRecord.GetIndex: Integer; Begin // If FMemoryData <> nil then @@ -1393,73 +1809,73 @@ function TRESTDWMemTable.GetMemoryRecord(Index: Integer): TRESTDWMTMemoryRecord; End; procedure TRESTDWMemTable.InitFieldDefsFromFields; -var - I : Integer; - Offset : Integer; - Field : TField; - vFieldType : TFieldType; - FieldDefsUpdated : Boolean; - FieldLen : Word; - Procedure CalcOffSets; - Var - I : Integer; - Begin - {$IFNDEF FPC} - If Fields.Count > 0 Then - Begin - SetLength(FOffsets, Fields.Count); - Try - For I := 0 to Fields.Count - 1 do - Begin - FOffsets[I] := Offset; - If Fields[I].datatype in ftSupported - ftBlobTypes then - Begin - FieldLen := CalcFieldLen(Fields[I].datatype, Fields[I].Size); - Inc(Offset, FieldLen); - End; - End; - Finally - End; - End - Else - Begin - {$ENDIF} - SetLength(FOffsets, FieldDefs.Count); - FieldDefs.Update; - FieldDefsUpdated := FieldDefs.Updated; - Try - FieldDefs.Updated := True; - // Performance optimization: FieldDefList.Updated returns False is FieldDefs.Updated is False - For I := 0 to FieldDefs.Count - 1 do - Begin - FOffsets[I] := Offset; - If FieldDefs[I].datatype in ftSupported - ftBlobTypes then - Begin - FieldLen := CalcFieldLen(FieldDefs[I].datatype, FieldDefs[I].Size); - Inc(Offset, FieldLen); - vFieldType := FieldDefs[I].DataType; - If vFieldType in [ftFloat, ftBCD, ftFMTBcd] then - Begin - If FieldDefs[I].Precision < 16 Then - FieldDefs[I].Precision := 16; - End; - End; - End; - Finally - FieldDefs.Updated := FieldDefsUpdated; - End; - {$IFNDEF FPC} +Var + I : Integer; + Offset : Integer; + Field : TField; + vFieldType : TFieldType; + FieldDefsUpdated : Boolean; + FieldLen : Word; + Procedure CalcOffSets; + Var + I : Integer; + Begin + {$IFNDEF FPC} + If Fields.Count > 0 Then + Begin + SetLength(FOffsets, Fields.Count); + Try + For I := 0 to Fields.Count - 1 do + Begin + FOffsets[I] := Offset; + If Fields[I].datatype in ftSupported - ftBlobTypes then + Begin + FieldLen := CalcFieldLen(Fields[I].datatype, Fields[I].Size); + Inc(Offset, FieldLen); + End; + End; + Finally End; + End + Else + Begin {$ENDIF} - End; + SetLength(FOffsets, FieldDefs.Count); + FieldDefs.Update; + FieldDefsUpdated := FieldDefs.Updated; + Try + FieldDefs.Updated := True; + // Performance optimization: FieldDefList.Updated returns False is FieldDefs.Updated is False + For I := 0 to FieldDefs.Count - 1 do + Begin + FOffsets[I] := Offset; + If FieldDefs[I].datatype in ftSupported - ftBlobTypes then + Begin + FieldLen := CalcFieldLen(FieldDefs[I].datatype, FieldDefs[I].Size); + Inc(Offset, FieldLen); + vFieldType := FieldDefs[I].DataType; + If vFieldType in [ftFloat, ftBCD, ftFMTBcd] then + Begin + If FieldDefs[I].Precision < 16 Then + FieldDefs[I].Precision := 16; + End; + End; + End; + Finally + FieldDefs.Updated := FieldDefsUpdated; + End; + {$IFNDEF FPC} + End; + {$ENDIF} + End; Begin If FieldDefs.Count = 0 then Begin - for I := 0 to FieldCount - 1 do + For I := 0 to FieldCount - 1 do Begin - Field := Fields[I]; - If (Field.FieldKind in fkStoredFields) and not(Field.datatype in ftSupported) then - ErrorFmt('Field ''%s'' is of unknown type', [Field.DisplayName]); + Field := Fields[I]; + If (Field.FieldKind in fkStoredFields) and not(Field.datatype in ftSupported) then + ErrorFmt('Field ''%s'' is of unknown type', [Field.DisplayName]); End; FreeIndexList; End; @@ -1490,7 +1906,7 @@ function TRESTDWMemTable.FindFieldData(Buffer: Pointer; Field: TField): Pointer; Index : Integer; datatype : TFieldType; Begin - Result := nil; + Result := Nil; // Index := Field.FieldNo - 1; // If Index < 0 Then Index := FindFieldIndex(Field); @@ -1685,7 +2101,7 @@ procedure TRESTDWMemTable.InitRecord(Buffer: TRecordBuffer); dwftTime, dwftDateTime, dwftTimeStamp, - dwftSingle, +// dwftSingle, dwftTimeStampOffset, dwftFloat, dwftFMTBcd, @@ -1929,8 +2345,8 @@ function TRESTDWMemTable.GetActiveRecBuf(var RecBuf: PRESTDWMTMemBuffer Result := RecBuf <> nil; End; -function TRESTDWMemTable.InternalGetFieldData(Field: TField; - var Buffer: TRESTDWMTValueBuffer): Boolean; +Function TRESTDWMemTable.InternalGetFieldData(Field : TField; + Var Buffer : TRESTDWMTValueBuffer) : Boolean; Var aNullData : Boolean; RecBuf : PRESTDWMTMemBuffer; @@ -1947,7 +2363,7 @@ function TRESTDWMemTable.InternalGetFieldData(Field: TField; vBCDA : DWLongDouble; {$ENDIF} vDouble : DWFloat; - vLongDouble : DWCurrency; + vLongDouble : DWLongDouble; vTimeStamp : TSQLTimeStamp; vTimeStampV : TTimeStamp; vDateTimeInt : DWInteger; @@ -2221,6 +2637,11 @@ function TRESTDWMemTable.InternalGetFieldData(Field: TField; End; End; End + Else If Field.datatype = ftExtended Then + Begin + Move(aDataBytes[1], Pointer(@vLongDouble)^, SizeOf(DWLongDouble)); + PExtended(Buffer)^ := vLongDouble; + End Else Begin If Length(TRESTDWBytes(Buffer)) = 0 Then @@ -2241,14 +2662,7 @@ function TRESTDWMemTable.InternalGetFieldData(Field: TField; vDataType := FieldTypeToDWFieldType(Field.DataType); If Length(TRESTDWBytes(Buffer)) = 0 Then SetLength(TRESTDWBytes(Buffer), cLen); - If vDataType = dwftSingle Then - Begin - Move(aDataBytes[1], Pointer(@vSingle)^, SizeOf(DWSingle)); - vBCD := vSingle; - cLen := SizeOf(vBCD); - Move(Pointer(@vBCD)^, Pointer(Buffer)^, cLen); - End - Else If vDataType = dwftBCD Then + If vDataType = dwftBCD Then Begin Move(aDataBytes[1], Pointer(@vLongDouble)^, SizeOf(vLongDouble)); cLen := SizeOf(vLongDouble); @@ -2420,6 +2834,54 @@ function TRESTDWMemTable.InternalGetFieldData(Field: TField; End; {$ENDIF} +Function TRESTDWMemTable.GetFieldIndex(Const aName : String) : Integer; +Var + L : Integer; +Begin + L := Length(Name); + For Result := 0 to FieldCount - 1 do + Begin + If (Length(FFieldName[Result]) = L) and + (AnsiCompareText(FFieldName[Result], Name) = 0) Then + Exit; + End; + Result := -1 +End; + +Function TRESTDWMemTable.GetFieldDef(Index: Integer): Integer; +begin + Result := -1; + If Fields.Count > 0 Then + Result := Integer(Fields[Index].DataType); +end; + +Function TRESTDWMemTable.GetFieldClass(FieldType : TFieldType): TFieldClass; +Var + I : Integer; +Begin + If (csDesigning in ComponentState) and (FDsgnFieldName <> '') Then + Begin + Result := Nil; + I := GetFieldIndex(FDsgnFieldName); + If I >= 0 Then + Begin + Case GetFieldDef(I) of + dwftExtended : Result := TExtendedField; + {$IFNDEF FPC} + dwftTimeStampOffset : Result := TSQLTimeStampOffsetField; + {$ENDIF} +// dwftColor : Result := TColorField; + End; + If Result <> nil then + Exit; + End; + end; + If FFieldDefClass = Nil then + Result := DefaultFieldClasses[FieldType] + Else + Result := FFieldDefClass; +End; + Function TRESTDWMemTable.GetFieldData(Field : TField; {$IFNDEF FPC} {$IF CompilerVersion > 21}Var{$IFEND} @@ -2434,8 +2896,9 @@ function TRESTDWMemTable.InternalGetFieldData(Field: TField; Result := InternalGetFieldData(Field, TRESTDWMTValueBuffer(aPointer^)); End; -procedure TRESTDWMemTable.InternalSetFieldData(Field: TField; Buffer: Pointer; - const ValidateBuffer: TRESTDWMTValueBuffer); +procedure TRESTDWMemTable.InternalSetFieldData(Field : TField; + Buffer : Pointer; + Const ValidateBuffer : TRESTDWMTValueBuffer); Var PActualRecord : PRESTDWMTMemBuffer; aState : TDataSetState; @@ -2551,14 +3014,17 @@ procedure TRESTDWMemTable.InternalSetFieldData(Field: TField; Buffer: Pointer; dwftAutoInc, {$IFNDEF FPC} {$IF CompilerVersion >= 20} - dwftByte, dwftShortint, dwftLongWord, dwftSingle, + dwftByte, dwftShortint, dwftLongWord, //dwftSingle, {$IFEND} {$ENDIF} + dwftExtended, dwftLargeint, dwftInteger, dwftSmallint, dwftFloat, - dwftFMTBCD, + {$IFNDEF FPC} + dwftFMTBCD, + {$ENDIF} dwftBCD, dwftCurrency, dwftBoolean : Begin @@ -2688,8 +3154,8 @@ function TRESTDWMemTable.GetBlob(aRecNo, Index: Integer): PMemBlobData; Result := @fblobs[Index]; End; -procedure TRESTDWMemTable.SetFieldData(Field: TField; - Buffer: TRESTDWMTValueBuffer); +Procedure TRESTDWMemTable.SetFieldData(Field : TField; + Buffer : TRESTDWMTValueBuffer); Begin {$IFNDEF FPC} {$IF CompilerVersion <= 22} @@ -2854,8 +3320,7 @@ procedure TRESTDWMemTable.CloseBlob(Field: TField); SetLength(FBlobs[Field.Offset], 0); End; -function TRESTDWMemTable.CreateBlobStream(Field: TField; Mode: TBlobStreamMode - ): TStream; +function TRESTDWMemTable.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; Begin Result := TRESTDWMTMemBlobStream.Create(Field as TBlobField, Mode); End; @@ -4792,6 +5257,11 @@ procedure TRESTDWMemTable.Assign(Source: TPersistent); inherited Assign(Source); End; +//Procedure TRESTDWMemTable.DefChanged(Sender : TObject); +//Begin +// Inherited; +//End; + procedure TRESTDWMemTable.AssignMemoryRecord(Rec: TRESTDWMTMemoryRecord; Buffer: PRESTDWMTMemBuffer); var @@ -5042,18 +5512,40 @@ procedure TRESTDWMemTable.InternalOpen; Procedure TRESTDWMemTable.CreateFields; Var - I : Integer; + I : Integer; + Field : TField; Begin - Inherited CreateFields; - {$IFNDEF FPC} - For I := 0 To Fields.Count -1 Do - Begin +// Inherited CreateFields; + For I := 0 To FieldDefs.Count -1 Do + Begin + If FieldDefs[I].DataType = {$IFNDEF FPC}ftExtended{$ELSE}ftFMTBcd{$ENDIF} Then + Field := TExtendedField.Create(Self) + Else + Begin + {$IFNDEF FPC} + Field := FieldDefs[I].CreateField(Self, Nil, FieldDefs[I].Name); + SetFieldProps(Field, FieldDefs[I]); + {$ELSE} + Field := FieldDefs[I].CreateField(Self); + Field.SetFieldType(FieldDefs[I].DataType); + {$ENDIF} + End; + Field.FieldName := FieldDefs[I].Name; + Field.DisplayLabel := FieldDefs[I].Name; + Field.DataSet := Self; + End; + SetLength(FFieldName, 0); + SetLength(FFieldName, Fields.Count); + For I := 0 To Fields.Count -1 Do + Begin + FFieldName[I] := Fields[I].FieldName; + {$IFNDEF FPC} {$IF CompilerVersion >= 20} If Fields[I].datatype = ftSingle Then TFloatField(Fields[I]).Precision := 17; {$IFEND} - End; - {$ENDIF} + {$ENDIF} + End; End; procedure TRESTDWMemTable.DoAfterOpen; @@ -5168,21 +5660,39 @@ procedure TRESTDWMemTable.InternalHandleException; procedure TRESTDWMemTable.InternalInitFieldDefs; Begin + If (csDesigning in ComponentState) + {$IFNDEF FPC}and Assigned(Designer){$ENDIF} Then + DesignNotify('', 102); Inherited InitFieldDefsFromFields; End; -// Procedure TRESTDWMemTable.DesignNotify(const AFieldName: string; Dummy: Integer); -// Var -// Stream: TStream; -// Begin -// If not (csDesigning in ComponentState) then Exit; -// case Dummy of -// 100: Begin -// End; -// Else -// inherited DesignNotify(AFieldName, Dummy); -// End; -// End; +Function TRESTDWMemTable.IsLookup(Index: Integer): Boolean; +Begin + Result := Fields[Index].FieldKind in [fkCalculated, fkLookup]; +End; + +Procedure TRESTDWMemTable.DesignNotify(const AFieldName: string; Dummy: Integer); +var + Field: TField; +begin + If not (csDesigning in ComponentState) then Exit; + Case Dummy of + 104 : Begin + If IsLookup(GetFieldIndex(AFieldName)) Then + Begin + Field := FieldByName(AFieldName); + Field.FieldKind := fkLookup; + End; + End; + 106 : Begin + Try + InternalInitFieldDefs; + Except + End; + End; + Else FDsgnFieldName := AFieldName; + End; +End; function TRESTDWMemTable.IsCursorOpen: Boolean; Begin diff --git a/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas b/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas index 3f5e1f71..df64f993 100644 --- a/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas +++ b/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas @@ -5413,3 +5413,4 @@ procedure TRESTDWIdProxyRequest.SetActive(Value : Boolean); End; End. + diff --git a/CORE/Source/utils/uRESTDWTools.pas b/CORE/Source/utils/uRESTDWTools.pas index 5aa9b378..ef763554 100644 --- a/CORE/Source/utils/uRESTDWTools.pas +++ b/CORE/Source/utils/uRESTDWTools.pas @@ -551,80 +551,91 @@ interface Function DWFieldTypeToFieldType(DWFieldType : Byte) : TFieldType; Begin Result := ftUnknown; - Case DWFieldType Of - dwftString : Result := ftString; - dwftSmallint : Result := ftSmallint; - dwftInteger : Result := ftInteger; - dwftWord : Result := ftWord; - dwftBoolean : Result := ftBoolean; - dwftFloat : Result := ftFloat; - dwftCurrency : Result := ftCurrency; - dwftDate : Result := ftDate; - dwftTime : Result := ftTime; - dwftDateTime : Result := ftDateTime; - dwftBytes : Result := ftBytes; - dwftVarBytes : Result := ftVarBytes; - dwftAutoInc : Result := ftAutoInc; - dwftBlob : Result := ftBlob; - dwftMemo : Result := ftMemo; - dwftGraphic : Result := ftGraphic; - dwftFmtMemo : Result := ftFmtMemo; - dwftParadoxOle : Result := ftParadoxOle; - dwftDBaseOle : Result := ftDBaseOle; - dwftTypedBinary : Result := ftTypedBinary; - dwftCursor : Result := ftCursor; - dwftFixedChar : Result := ftFixedChar; - dwftLargeint : Result := ftLargeint; - dwftADT : Result := ftADT; - dwftArray : Result := ftArray; - dwftReference : Result := ftReference; - dwftDataSet : Result := ftDataSet; - dwftOraBlob : Result := ftOraBlob; - dwftOraClob : Result := ftOraClob; - dwftVariant : Result := ftVariant; - dwftInterface : Result := ftInterface; - dwftIDispatch : Result := ftIDispatch; - dwftGuid : Result := ftGuid; - dwftBCD : Result := ftBCD; - dwftFMTBcd : Result := ftFMTBcd; - {$IFDEF DELPHI2010UP} - dwftTimeStamp : Result := ftTimeStamp; - dwftWideString : Result := ftWideString; - dwftFixedWideChar : Result := ftFixedWideChar; - dwftWideMemo : Result := ftWideMemo; - dwftOraTimeStamp : Result := ftOraTimeStamp; - dwftOraInterval : Result := ftOraInterval; - dwftLongWord : Result := ftLongWord; - dwftShortint : Result := ftShortint; - dwftByte : Result := ftByte; - //dwftExtended : Result := ftExtended; gledston - dwftConnection : Result := ftConnection; - dwftParams : Result := ftParams; - dwftStream : Result := ftStream; - dwftTimeStampOffset : Result := ftTimeStampOffset; - dwftObject : Result := ftObject; - dwftSingle : Result := ftSingle; - {$ELSE} - {$IFDEF DELPHIXEUP} - dwftFixedWideChar : Result := ftFixedWideChar; - dwftWideMemo : Result := ftWideMemo; + {$IFDEF FPC} + If DWFieldType = 45 Then //Extended come from Delphi + Result := ftFMTBcd + Else + Begin + {$ENDIF} + Case DWFieldType Of + dwftString : Result := ftString; + dwftSmallint : Result := ftSmallint; + dwftInteger : Result := ftInteger; + dwftWord : Result := ftWord; + dwftBoolean : Result := ftBoolean; + dwftFloat : Result := ftFloat; + dwftCurrency : Result := ftCurrency; + dwftDate : Result := ftDate; + dwftTime : Result := ftTime; + dwftDateTime : Result := ftDateTime; + dwftBytes : Result := ftBytes; + dwftVarBytes : Result := ftVarBytes; + dwftAutoInc : Result := ftAutoInc; + dwftBlob : Result := ftBlob; + dwftMemo : Result := ftMemo; + dwftGraphic : Result := ftGraphic; + dwftFmtMemo : Result := ftFmtMemo; + dwftParadoxOle : Result := ftParadoxOle; + dwftDBaseOle : Result := ftDBaseOle; + dwftTypedBinary : Result := ftTypedBinary; + dwftCursor : Result := ftCursor; + dwftFixedChar : Result := ftFixedChar; + dwftLargeint : Result := ftLargeint; + dwftADT : Result := ftADT; + dwftArray : Result := ftArray; + dwftReference : Result := ftReference; + dwftDataSet : Result := ftDataSet; + dwftOraBlob : Result := ftOraBlob; + dwftOraClob : Result := ftOraClob; + dwftVariant : Result := ftVariant; + dwftInterface : Result := ftInterface; + dwftIDispatch : Result := ftIDispatch; + dwftGuid : Result := ftGuid; + dwftBCD : Result := ftBCD; + dwftExtended : Result := {$IFDEF FPC}ftFMTBcd{$ELSE}ftExtended{$ENDIF}; + {$IFNDEF FPC} + dwftFMTBcd : Result := ftFMTBcd; + {$ENDIF} + {$IFDEF DELPHI2010UP} + dwftTimeStamp : Result := ftTimeStamp; + dwftWideString : Result := ftWideString; + dwftFixedWideChar : Result := ftFixedWideChar; + dwftWideMemo : Result := ftWideMemo; + dwftOraTimeStamp : Result := ftOraTimeStamp; + dwftOraInterval : Result := ftOraInterval; + dwftLongWord : Result := ftLongWord; + dwftShortint : Result := ftShortint; + dwftByte : Result := ftByte; + //dwftExtended : Result := ftExtended; gledston + dwftConnection : Result := ftConnection; + dwftParams : Result := ftParams; + dwftStream : Result := ftStream; + dwftTimeStampOffset : Result := ftTimeStampOffset; + dwftObject : Result := ftObject; + // dwftSingle : Result := ftSingle; {$ELSE} - dwftFixedWideChar : Result := ftFixedChar; - dwftWideMemo : Result := ftMemo; + {$IFDEF DELPHIXEUP} + dwftFixedWideChar : Result := ftFixedWideChar; + dwftWideMemo : Result := ftWideMemo; + {$ELSE} + dwftFixedWideChar : Result := ftFixedChar; + dwftWideMemo : Result := ftMemo; + {$ENDIF} + dwftTimeStamp : Result := ftDateTime; // ftTimeStamp nao definido 3.2.4 + dwftWideString : Result := ftWideString; + dwftOraTimeStamp : Result := ftDateTime; // ftTimeStamp nao definido 3.2.4 + dwftOraInterval : Result := ftInteger; + dwftLongWord : Result := ftWord; + dwftShortint : Result := ftInteger; + dwftByte : Result := ftTypedBinary; + dwftStream : Result := ftBlob; + dwftTimeStampOffset : Result := ftDateTime; // ftTimeStamp nao definido 3.2.4 + // dwftSingle : Result := ftFloat; {$ENDIF} - dwftTimeStamp : Result := ftDateTime; // ftTimeStamp nao definido 3.2.4 - dwftWideString : Result := ftWideString; - dwftOraTimeStamp : Result := ftDateTime; // ftTimeStamp nao definido 3.2.4 - dwftOraInterval : Result := ftInteger; - dwftLongWord : Result := ftWord; - dwftShortint : Result := ftInteger; - dwftByte : Result := ftTypedBinary; - dwftExtended : Result := ftFloat; - dwftStream : Result := ftBlob; - dwftTimeStampOffset : Result := ftDateTime; // ftTimeStamp nao definido 3.2.4 - dwftSingle : Result := ftFloat; - {$ENDIF} - End; + End; + {$IFDEF FPC} + End; + {$ENDIF} End; Function FieldTypeToDWFieldType(FieldType : TFieldType) : Byte; @@ -667,7 +678,7 @@ interface ftIDispatch : Result := dwftIDispatch; ftGuid : Result := dwftGuid; ftTimeStamp : Result := dwftTimeStamp; - ftFMTBcd : Result := dwftFMTBcd; + ftFMTBcd : Result := {$IFDEF FPC}45{$ELSE}dwftExtended{$ENDIF}; {$IFDEF DELPHI2010UP} // Delphi 2010 acima ftFixedWideChar : Result := dwftFixedWideChar; ftWideMemo : Result := dwftWideMemo;