mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-19 13:00:31 +01:00
fcl-db: base:
- Add new properties for TField: .AsAnsiString, AsUnicodeString, AsUTF8String TParam: .AsAnsiString, AsUnicodeString, AsUTF8String - Add CodePage to TStringField and TMemoField (so character fields are now CodePage aware, like AnsiString; default CodePage is CP_ACP=0) git-svn-id: trunk@34098 -
This commit is contained in:
lacak
parent
9115dc2521
commit
d2c53d48e9
@ -2149,9 +2149,9 @@ begin
|
||||
ftUnknown : result := 0;
|
||||
ftString,
|
||||
ftGuid,
|
||||
ftFixedChar: result := FieldDef.Size + 1;
|
||||
ftFixedChar: result := FieldDef.Size*FieldDef.CharSize + 1;
|
||||
ftFixedWideChar,
|
||||
ftWideString:result := (FieldDef.Size + 1)*2;
|
||||
ftWideString:result := (FieldDef.Size + 1)*FieldDef.CharSize;
|
||||
ftSmallint,
|
||||
ftInteger,
|
||||
ftAutoInc,
|
||||
|
||||
@ -83,6 +83,8 @@ end;
|
||||
procedure TDataSet.BindFields(Binding: Boolean);
|
||||
|
||||
var i, FieldIndex: Integer;
|
||||
FieldDef: TFieldDef;
|
||||
Field: TField;
|
||||
|
||||
begin
|
||||
{ FieldNo is set to -1 for calculated/lookup fields, to 0 for unbound field
|
||||
@ -90,38 +92,44 @@ begin
|
||||
FCalcFieldsSize := 0;
|
||||
FBlobFieldCount := 0;
|
||||
for i := 0 to Fields.Count - 1 do
|
||||
with Fields[i] do
|
||||
begin
|
||||
FFieldDef:=Nil;
|
||||
Field := Fields[i];
|
||||
Field.FFieldDef := Nil;
|
||||
if not Binding then
|
||||
FFieldNo := 0
|
||||
else if FieldKind in [fkCalculated, fkLookup] then
|
||||
Field.FFieldNo := 0
|
||||
else if Field.FieldKind in [fkCalculated, fkLookup] then
|
||||
begin
|
||||
FFieldNo := -1;
|
||||
FOffset := FCalcFieldsSize;
|
||||
Inc(FCalcFieldsSize, DataSize + 1);
|
||||
Field.FFieldNo := -1;
|
||||
Field.FOffset := FCalcFieldsSize;
|
||||
Inc(FCalcFieldsSize, Field.DataSize + 1);
|
||||
end
|
||||
else
|
||||
begin
|
||||
FFieldDef := nil;
|
||||
FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName);
|
||||
FieldIndex := FieldDefs.IndexOf(Field.FieldName);
|
||||
if FieldIndex = -1 then
|
||||
DatabaseErrorFmt(SFieldNotFound,[Fields[i].FieldName],Self)
|
||||
DatabaseErrorFmt(SFieldNotFound,[Field.FieldName],Self)
|
||||
else
|
||||
begin
|
||||
FFieldDef := FieldDefs[FieldIndex];
|
||||
FFieldNo := FFieldDef.FieldNo;
|
||||
FieldDef := FieldDefs[FieldIndex];
|
||||
Field.FFieldDef := FieldDef;
|
||||
Field.FFieldNo := FieldDef.FieldNo;
|
||||
if FieldDef.InternalCalcField then
|
||||
FInternalCalcFields := True;
|
||||
if IsBlob then
|
||||
if Field.IsBlob then
|
||||
begin
|
||||
FSize := FFieldDef.Size;
|
||||
FOffset := FBlobFieldCount;
|
||||
Field.FSize := FieldDef.Size;
|
||||
Field.FOffset := FBlobFieldCount;
|
||||
Inc(FBlobFieldCount);
|
||||
end;
|
||||
end
|
||||
// synchronize CodePage between TFieldDef and TField
|
||||
// character data in record buffer and field buffer should have same CodePage
|
||||
if Field is TStringField then
|
||||
TStringField(Field).FCodePage := FieldDef.FCodePage
|
||||
else if Field is TMemoField then
|
||||
TMemoField(Field).FCodePage := FieldDef.FCodePage;
|
||||
end;
|
||||
Bind(Binding);
|
||||
end;
|
||||
Field.Bind(Binding);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -215,8 +223,8 @@ begin
|
||||
For I:=0 to FieldDefs.Count-1 do
|
||||
Writeln('Def ',I,' : ',Fielddefs.items[i].Name,'(',Fielddefs.items[i].FieldNo,')');
|
||||
{$endif}
|
||||
For I:=0 to fielddefs.Count-1 do
|
||||
With Fielddefs.Items[I] do
|
||||
For I:=0 to FieldDefs.Count-1 do
|
||||
With FieldDefs.Items[I] do
|
||||
If DataType<>ftUnknown then
|
||||
begin
|
||||
{$ifdef DSDebug}
|
||||
|
||||
@ -42,7 +42,7 @@ type
|
||||
PLargeInt= ^LargeInt;
|
||||
|
||||
{ Auxiliary type }
|
||||
TStringFieldBuffer = Array[0..dsMaxStringSize] of Char;
|
||||
TStringFieldBuffer = Array[0..dsMaxStringSize] of AnsiChar;
|
||||
|
||||
{ Misc Dataset types }
|
||||
|
||||
@ -164,13 +164,15 @@ type
|
||||
|
||||
TFieldDef = class(TNamedItem)
|
||||
Private
|
||||
FAttributes : TFieldAttributes;
|
||||
FCodePage : TSystemCodePage;
|
||||
FDataType : TFieldType;
|
||||
FFieldNo : Longint;
|
||||
FInternalCalcField : Boolean;
|
||||
FPrecision : Longint;
|
||||
FRequired : Boolean;
|
||||
FSize : Integer;
|
||||
FAttributes : TFieldAttributes;
|
||||
function GetCharSize: Word;
|
||||
Function GetFieldClass : TFieldClass;
|
||||
procedure SetAttributes(AValue: TFieldAttributes);
|
||||
procedure SetDataType(AValue: TFieldType);
|
||||
@ -180,12 +182,14 @@ type
|
||||
public
|
||||
constructor Create(ACollection : TCollection); override;
|
||||
constructor Create(AOwner: TFieldDefs; const AName: string;
|
||||
ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint); overload;
|
||||
ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint;
|
||||
ACodePage: TSystemCodePage = CP_ACP); overload;
|
||||
destructor Destroy; override;
|
||||
procedure Assign(APersistent: TPersistent); override;
|
||||
function CreateField(AOwner: TComponent): TField;
|
||||
property FieldClass: TFieldClass read GetFieldClass;
|
||||
property FieldNo: Longint read FFieldNo;
|
||||
property CharSize: Word read GetCharSize;
|
||||
property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
|
||||
property Required: Boolean read FRequired write SetRequired;
|
||||
Published
|
||||
@ -208,6 +212,7 @@ type
|
||||
public
|
||||
constructor Create(ADataSet: TDataSet);
|
||||
// destructor Destroy; override;
|
||||
Function Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo : Integer; ACodePage:TSystemCodePage) : TFieldDef; overload;
|
||||
Function Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo : Integer) : TFieldDef; overload;
|
||||
procedure Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean); overload;
|
||||
procedure Add(const AName: string; ADataType: TFieldType; ASize: Word); overload;
|
||||
@ -338,6 +343,9 @@ type
|
||||
function GetAsVariant: variant; virtual;
|
||||
function GetOldValue: variant; virtual;
|
||||
function GetAsString: string; virtual;
|
||||
function GetAsAnsiString: AnsiString; virtual;
|
||||
function GetAsUnicodeString: UnicodeString; virtual;
|
||||
function GetAsUTF8String: UTF8String; virtual;
|
||||
function GetAsWideString: WideString; virtual;
|
||||
function GetCanModify: Boolean; virtual;
|
||||
function GetClassDesc: String; virtual;
|
||||
@ -364,6 +372,9 @@ type
|
||||
procedure SetAsLargeInt(AValue: Largeint); virtual;
|
||||
procedure SetAsVariant(const AValue: variant); virtual;
|
||||
procedure SetAsString(const AValue: string); virtual;
|
||||
procedure SetAsAnsiString(const AValue: AnsiString); virtual;
|
||||
procedure SetAsUnicodeString(const AValue: UnicodeString); virtual;
|
||||
procedure SetAsUTF8String(const AValue: UTF8String); virtual;
|
||||
procedure SetAsWideString(const AValue: WideString); virtual;
|
||||
procedure SetDataset(AValue : TDataset); virtual;
|
||||
procedure SetDataType(AValue: TFieldType);
|
||||
@ -398,6 +409,9 @@ type
|
||||
property AsLargeInt: LargeInt read GetAsLargeInt write SetAsLargeInt;
|
||||
property AsInteger: Longint read GetAsInteger write SetAsInteger;
|
||||
property AsString: string read GetAsString write SetAsString;
|
||||
property AsAnsiString: AnsiString read GetAsAnsiString write SetAsAnsiString;
|
||||
property AsUnicodeString: UnicodeString read GetAsUnicodeString write SetAsUnicodeString;
|
||||
property AsUTF8String: UTF8String read GetAsUTF8String write SetAsUTF8String;
|
||||
property AsWideString: WideString read GetAsWideString write SetAsWideString;
|
||||
property AsVariant: variant read GetAsVariant write SetAsVariant;
|
||||
property AttributeSet: string read FAttributeSet write FAttributeSet;
|
||||
@ -456,6 +470,7 @@ type
|
||||
|
||||
TStringField = class(TField)
|
||||
private
|
||||
FCodePage : TSystemCodePage;
|
||||
FFixedChar : boolean;
|
||||
FTransliterate : Boolean;
|
||||
protected
|
||||
@ -465,22 +480,28 @@ type
|
||||
function GetAsFloat: Double; override;
|
||||
function GetAsInteger: Longint; override;
|
||||
function GetAsLargeInt: Largeint; override;
|
||||
function GetAsString: string; override;
|
||||
function GetAsString: String; override;
|
||||
function GetAsAnsiString: AnsiString; override;
|
||||
function GetAsUTF8String: UTF8String; override;
|
||||
function GetAsVariant: variant; override;
|
||||
function GetDataSize: Integer; override;
|
||||
function GetDefaultWidth: Longint; override;
|
||||
procedure GetText(var AText: string; ADisplayText: Boolean); override;
|
||||
function GetValue(var AValue: string): Boolean;
|
||||
function GetValue(out AValue: RawByteString): Boolean;
|
||||
procedure SetAsBoolean(AValue: Boolean); override;
|
||||
procedure SetAsDateTime(AValue: TDateTime); override;
|
||||
procedure SetAsFloat(AValue: Double); override;
|
||||
procedure SetAsInteger(AValue: Longint); override;
|
||||
procedure SetAsLargeInt(AValue: Largeint); override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
procedure SetAsString(const AValue: String); override;
|
||||
procedure SetAsAnsiString(const AValue: AnsiString); override;
|
||||
procedure SetAsUTF8String(const AValue: UTF8String); override;
|
||||
procedure SetVarValue(const AValue: Variant); override;
|
||||
procedure SetValue(AValue: RawByteString);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure SetFieldType(AValue: TFieldType); override;
|
||||
property CodePage : TSystemCodePage read FCodePage;
|
||||
property FixedChar : Boolean read FFixedChar write FFixedChar;
|
||||
property Transliterate: Boolean read FTransliterate write FTransliterate;
|
||||
property Value: String read GetAsString write SetAsString;
|
||||
@ -495,7 +516,7 @@ type
|
||||
protected
|
||||
class procedure CheckTypeSize(AValue: Integer); override;
|
||||
|
||||
function GetValue(var AValue: WideString): Boolean;
|
||||
function GetValue(out AValue: UnicodeString): Boolean;
|
||||
|
||||
function GetAsString: string; override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
@ -506,9 +527,15 @@ type
|
||||
function GetAsWideString: WideString; override;
|
||||
procedure SetAsWideString(const AValue: WideString); override;
|
||||
|
||||
function GetAsUnicodeString: UnicodeString; override;
|
||||
procedure SetAsUnicodeString(const AValue: UnicodeString); override;
|
||||
|
||||
function GetAsUTF8String: UTF8String; override;
|
||||
procedure SetAsUTF8String(const AValue: UTF8String); override;
|
||||
|
||||
function GetDataSize: Integer; override;
|
||||
public
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure SetFieldType(AValue: TFieldType); override;
|
||||
property Value: WideString read GetAsWideString write SetAsWideString;
|
||||
end;
|
||||
@ -646,7 +673,7 @@ type
|
||||
function GetAsVariant: variant; override;
|
||||
function GetAsString: string; override;
|
||||
function GetDataSize: Integer; override;
|
||||
procedure GetText(var theText: string; ADisplayText: Boolean); override;
|
||||
procedure GetText(var AText: string; ADisplayText: Boolean); override;
|
||||
procedure SetAsBCD(const AValue: TBCD); override;
|
||||
procedure SetAsFloat(AValue: Double); override;
|
||||
procedure SetAsLargeInt(AValue: LargeInt); override;
|
||||
@ -712,7 +739,7 @@ type
|
||||
function GetAsString: string; override;
|
||||
function GetAsVariant: variant; override;
|
||||
function GetDataSize: Integer; override;
|
||||
procedure GetText(var theText: string; ADisplayText: Boolean); override;
|
||||
procedure GetText(var AText: string; ADisplayText: Boolean); override;
|
||||
procedure SetAsDateTime(AValue: TDateTime); override;
|
||||
procedure SetAsFloat(AValue: Double); override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
@ -749,11 +776,9 @@ type
|
||||
function GetAsBytes: TBytes; override;
|
||||
function GetAsString: string; override;
|
||||
function GetAsVariant: Variant; override;
|
||||
procedure GetText(var TheText: string; ADisplayText: Boolean); override;
|
||||
function GetValue(var AValue: TBytes): Boolean;
|
||||
procedure SetAsBytes(const AValue: TBytes); override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
procedure SetText(const AValue: string); override;
|
||||
procedure SetVarValue(const AValue: Variant); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
@ -798,7 +823,7 @@ type
|
||||
function GetAsVariant: variant; override;
|
||||
function GetDataSize: Integer; override;
|
||||
function GetDefaultWidth: Longint; override;
|
||||
procedure GetText(var TheText: string; ADisplayText: Boolean); override;
|
||||
procedure GetText(var AText: string; ADisplayText: Boolean); override;
|
||||
procedure SetAsBCD(const AValue: TBCD); override;
|
||||
procedure SetAsFloat(AValue: Double); override;
|
||||
procedure SetAsInteger(AValue: Longint); override;
|
||||
@ -840,7 +865,7 @@ type
|
||||
function GetAsVariant: variant; override;
|
||||
function GetDataSize: Integer; override;
|
||||
function GetDefaultWidth: Longint; override;
|
||||
procedure GetText(var TheText: string; ADisplayText: Boolean); override;
|
||||
procedure GetText(var AText: string; ADisplayText: Boolean); override;
|
||||
procedure SetAsBCD(const AValue: TBCD); override;
|
||||
procedure SetAsFloat(AValue: Double); override;
|
||||
procedure SetAsLargeInt(AValue: LargeInt); override;
|
||||
@ -881,16 +906,17 @@ type
|
||||
procedure FreeBuffers; override;
|
||||
function GetAsBytes: TBytes; override;
|
||||
function GetAsString: string; override;
|
||||
function GetAsAnsiString: AnsiString; override;
|
||||
function GetAsUnicodeString: UnicodeString; override;
|
||||
function GetAsVariant: Variant; override;
|
||||
function GetAsWideString: WideString; override;
|
||||
function GetBlobSize: Longint; virtual;
|
||||
function GetIsNull: Boolean; override;
|
||||
procedure GetText(var TheText: string; ADisplayText: Boolean); override;
|
||||
procedure GetText(var AText: string; ADisplayText: Boolean); override;
|
||||
procedure SetAsBytes(const AValue: TBytes); override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
procedure SetText(const AValue: string); override;
|
||||
procedure SetAsAnsiString(const AValue: AnsiString); override;
|
||||
procedure SetAsUnicodeString(const AValue: UnicodeString); override;
|
||||
procedure SetVarValue(const AValue: Variant); override;
|
||||
procedure SetAsWideString(const AValue: WideString); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure Clear; override;
|
||||
@ -912,9 +938,15 @@ type
|
||||
{ TMemoField }
|
||||
|
||||
TMemoField = class(TBlobField)
|
||||
private
|
||||
FCodePage: TSystemCodePage;
|
||||
protected
|
||||
function GetAsWideString: WideString; override;
|
||||
procedure SetAsWideString(const AValue: WideString); override;
|
||||
function GetAsAnsiString: AnsiString; override;
|
||||
procedure SetAsAnsiString(const AValue: AnsiString); override;
|
||||
function GetAsUnicodeString: UnicodeString; override;
|
||||
procedure SetAsUnicodeString(const AValue: UnicodeString); override;
|
||||
function GetAsUTF8String: UTF8String; override;
|
||||
procedure SetAsUTF8String(const AValue: UTF8String); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
@ -927,9 +959,12 @@ type
|
||||
protected
|
||||
function GetAsVariant: Variant; override;
|
||||
procedure SetVarValue(const AValue: Variant); override;
|
||||
|
||||
function GetAsString: string; override;
|
||||
procedure SetAsString(const AValue: string); override;
|
||||
function GetAsAnsiString: AnsiString; override;
|
||||
procedure SetAsAnsiString(const AValue: AnsiString); override;
|
||||
function GetAsUTF8String: UTF8String; override;
|
||||
procedure SetAsUTF8String(const AValue: UTF8String); override;
|
||||
public
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
property Value: WideString read GetAsWideString write SetAsWideString;
|
||||
@ -1163,6 +1198,10 @@ type
|
||||
Function GetAsLargeInt: LargeInt;
|
||||
Function GetAsMemo: string;
|
||||
Function GetAsString: string;
|
||||
Function GetAsAnsiString: AnsiString;
|
||||
Function GetAsUnicodeString: UnicodeString;
|
||||
Function GetAsUTF8String: UTF8String;
|
||||
Function GetAsWideString: WideString;
|
||||
Function GetAsVariant: Variant;
|
||||
Function GetAsFMTBCD: TBCD;
|
||||
Function GetDisplayName: string; override;
|
||||
@ -1181,14 +1220,16 @@ type
|
||||
Procedure SetAsMemo(const AValue: string);
|
||||
Procedure SetAsSmallInt(AValue: LongInt);
|
||||
Procedure SetAsString(const AValue: string);
|
||||
Procedure SetAsAnsiString(const AValue: AnsiString);
|
||||
Procedure SetAsUTF8String(const AValue: UTF8String);
|
||||
Procedure SetAsUnicodeString(const AValue: UnicodeString);
|
||||
Procedure SetAsWideString(const AValue: WideString);
|
||||
Procedure SetAsTime(const AValue: TDateTime);
|
||||
Procedure SetAsVariant(const AValue: Variant);
|
||||
Procedure SetAsWord(AValue: LongInt);
|
||||
Procedure SetAsFMTBCD(const AValue: TBCD);
|
||||
Procedure SetDataType(AValue: TFieldType);
|
||||
Procedure SetText(const AValue: string);
|
||||
function GetAsWideString: WideString;
|
||||
procedure SetAsWideString(const AValue: WideString);
|
||||
public
|
||||
constructor Create(ACollection: TCollection); overload; override;
|
||||
constructor Create(AParams: TParams; AParamType: TParamType); reintroduce; overload;
|
||||
@ -1196,7 +1237,7 @@ type
|
||||
Procedure AssignField(Field: TField);
|
||||
Procedure AssignToField(Field: TField);
|
||||
Procedure AssignFieldValue(Field: TField; const AValue: Variant);
|
||||
procedure AssignFromField(Field : TField);
|
||||
Procedure AssignFromField(Field : TField);
|
||||
Procedure Clear;
|
||||
Procedure GetData(Buffer: Pointer);
|
||||
Function GetDataSize: Integer;
|
||||
@ -1217,6 +1258,9 @@ type
|
||||
Property AsMemo : string read GetAsMemo write SetAsMemo;
|
||||
Property AsSmallInt : LongInt read GetAsInteger write SetAsSmallInt;
|
||||
Property AsString : string read GetAsString write SetAsString;
|
||||
Property AsAnsiString : AnsiString read GetAsAnsiString write SetAsAnsiString;
|
||||
Property AsUTF8String: UTF8String read GetAsUTF8String write SetAsUTF8String;
|
||||
Property AsUnicodeString: UnicodeString read GetAsUnicodeString write SetAsUnicodeString;
|
||||
Property AsTime : TDateTime read GetAsDateTime write SetAsTime;
|
||||
Property AsWord : LongInt read GetAsInteger write SetAsWord;
|
||||
Property AsFMTBCD: TBCD read GetAsFMTBCD write SetAsFMTBCD;
|
||||
|
||||
@ -528,7 +528,7 @@ begin
|
||||
Result:=FValue;
|
||||
end;
|
||||
|
||||
function TParam.GetAsBytes: TBytes;
|
||||
Function TParam.GetAsBytes: TBytes;
|
||||
begin
|
||||
if IsNull then
|
||||
Result:=nil
|
||||
@ -607,7 +607,28 @@ begin
|
||||
Result:=FValue;
|
||||
end;
|
||||
|
||||
function TParam.GetAsWideString: WideString;
|
||||
Function TParam.GetAsAnsiString: AnsiString;
|
||||
begin
|
||||
Result := GetAsString;
|
||||
end;
|
||||
|
||||
Function TParam.GetAsUnicodeString: UnicodeString;
|
||||
begin
|
||||
if IsNull then
|
||||
Result := ''
|
||||
else
|
||||
Result := FValue;
|
||||
end;
|
||||
|
||||
Function TParam.GetAsUTF8String: UTF8String;
|
||||
begin
|
||||
if IsNull then
|
||||
Result := ''
|
||||
else
|
||||
Result := FValue;
|
||||
end;
|
||||
|
||||
Function TParam.GetAsWideString: WideString;
|
||||
begin
|
||||
if IsNull then
|
||||
Result := ''
|
||||
@ -623,7 +644,7 @@ begin
|
||||
Result:=FValue;
|
||||
end;
|
||||
|
||||
function TParam.GetAsFMTBCD: TBCD;
|
||||
Function TParam.GetAsFMTBCD: TBCD;
|
||||
begin
|
||||
If IsNull then
|
||||
Result:=0
|
||||
@ -655,7 +676,7 @@ begin
|
||||
and (FValue=AValue.FValue);
|
||||
end;
|
||||
|
||||
procedure TParam.SetAsBCD(const AValue: Currency);
|
||||
Procedure TParam.SetAsBCD(const AValue: Currency);
|
||||
begin
|
||||
FDataType:=ftBCD;
|
||||
Value:=AValue;
|
||||
@ -673,7 +694,7 @@ begin
|
||||
Value:=AValue;
|
||||
end;
|
||||
|
||||
procedure TParam.SetAsBytes(const AValue: TBytes);
|
||||
Procedure TParam.SetAsBytes(const AValue: TBytes);
|
||||
begin
|
||||
FDataType:=ftVarBytes;
|
||||
Value:=AValue;
|
||||
@ -735,11 +756,32 @@ begin
|
||||
Value:=AValue;
|
||||
end;
|
||||
|
||||
procedure TParam.SetAsWideString(const aValue: WideString);
|
||||
Procedure TParam.SetAsAnsiString(const AValue: AnsiString);
|
||||
begin
|
||||
if FDataType <> ftFixedChar then
|
||||
FDataType := ftString;
|
||||
Value:=AValue;
|
||||
end;
|
||||
|
||||
Procedure TParam.SetAsUTF8String(const AValue: UTF8String);
|
||||
begin
|
||||
if FDataType <> ftFixedChar then
|
||||
FDataType := ftString;
|
||||
Value:=AValue;
|
||||
end;
|
||||
|
||||
Procedure TParam.SetAsUnicodeString(const AValue: UnicodeString);
|
||||
begin
|
||||
if FDataType <> ftFixedWideChar then
|
||||
FDataType := ftWideString;
|
||||
Value := aValue;
|
||||
Value := AValue;
|
||||
end;
|
||||
|
||||
Procedure TParam.SetAsWideString(const AValue: WideString);
|
||||
begin
|
||||
if FDataType <> ftFixedWideChar then
|
||||
FDataType := ftWideString;
|
||||
Value := AValue;
|
||||
end;
|
||||
|
||||
|
||||
@ -786,7 +828,7 @@ begin
|
||||
Value:=AValue;
|
||||
end;
|
||||
|
||||
procedure TParam.SetAsFMTBCD(const AValue: TBCD);
|
||||
Procedure TParam.SetAsFMTBCD(const AValue: TBCD);
|
||||
begin
|
||||
FDataType:=ftFMTBcd;
|
||||
FValue:=VarFmtBCDCreate(AValue);
|
||||
@ -859,7 +901,7 @@ begin
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TParam.AssignToField(Field : TField);
|
||||
Procedure TParam.AssignToField(Field : TField);
|
||||
|
||||
begin
|
||||
if Assigned(Field) then
|
||||
@ -888,13 +930,15 @@ begin
|
||||
ftBytes,
|
||||
ftVarBytes : Field.AsVariant:=Value;
|
||||
ftFmtBCD : Field.AsBCD:=AsFMTBCD;
|
||||
ftFixedWideChar,
|
||||
ftWideString: Field.AsWideString:=AsWideString;
|
||||
else
|
||||
If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
|
||||
DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParam.AssignFromField(Field : TField);
|
||||
Procedure TParam.AssignFromField(Field : TField);
|
||||
|
||||
begin
|
||||
if Assigned(Field) then
|
||||
@ -926,6 +970,8 @@ begin
|
||||
ftBytes,
|
||||
ftVarBytes : Value:=Field.AsVariant;
|
||||
ftFmtBCD : AsFMTBCD:=Field.AsBCD;
|
||||
ftFixedWideChar,
|
||||
ftWideString: AsWideString:=Field.AsWideString;
|
||||
else
|
||||
If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
|
||||
DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
|
||||
@ -989,7 +1035,7 @@ begin
|
||||
ftFixedChar:
|
||||
begin
|
||||
S:=AsString;
|
||||
StrMove(PChar(Buffer),Pchar(S),Length(S)+1);
|
||||
StrMove(PChar(Buffer),PChar(S),Length(S)+1);
|
||||
end;
|
||||
ftWideString,
|
||||
ftWideMemo: begin
|
||||
|
||||
@ -28,15 +28,16 @@ end;}
|
||||
TFieldDef
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Constructor TFieldDef.Create(ACollection : TCollection);
|
||||
constructor TFieldDef.Create(ACollection: TCollection);
|
||||
|
||||
begin
|
||||
Inherited Create(ACollection);
|
||||
FFieldNo:=Index+1;
|
||||
end;
|
||||
|
||||
Constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string;
|
||||
ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint);
|
||||
constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string;
|
||||
ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint;
|
||||
ACodePage: TSystemCodePage);
|
||||
|
||||
begin
|
||||
{$ifdef dsdebug }
|
||||
@ -49,9 +50,17 @@ begin
|
||||
FRequired:=ARequired;
|
||||
FPrecision:=-1;
|
||||
FFieldNo:=AFieldNo;
|
||||
case FDataType of
|
||||
ftString, ftFixedChar, ftMemo:
|
||||
FCodePage := ACodePage;
|
||||
ftWideString, ftFixedWideChar, ftWideMemo:
|
||||
FCodePage := CP_UTF16;
|
||||
else
|
||||
FCodePage := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
Destructor TFieldDef.Destroy;
|
||||
destructor TFieldDef.Destroy;
|
||||
|
||||
begin
|
||||
Inherited destroy;
|
||||
@ -71,14 +80,16 @@ begin
|
||||
Size := fd.Size;
|
||||
Precision := fd.Precision;
|
||||
FRequired := fd.Required;
|
||||
FCodePage := fd.FCodePage;
|
||||
finally
|
||||
Collection.EndUpdate;
|
||||
end;
|
||||
end else
|
||||
end
|
||||
else
|
||||
inherited Assign(APersistent);
|
||||
end;
|
||||
|
||||
Function TFieldDef.CreateField(AOwner: TComponent): TField;
|
||||
function TFieldDef.CreateField(AOwner: TComponent): TField;
|
||||
|
||||
var TheField : TFieldClass;
|
||||
|
||||
@ -104,11 +115,15 @@ begin
|
||||
Writeln ('TFieldDef.CreateField : Trying to set dataset');
|
||||
{$endif dsdebug}
|
||||
Result.Dataset:=TFieldDefs(Collection).Dataset;
|
||||
If (Result is TFloatField) then
|
||||
TFloatField(Result).Precision:=FPrecision;
|
||||
if (Result is TBCDField) then
|
||||
TBCDField(Result).Precision:=FPrecision;
|
||||
if (Result is TFmtBCDField) then
|
||||
if (Result is TStringField) then
|
||||
TStringField(Result).FCodePage := FCodePage
|
||||
else if (Result is TMemoField) then
|
||||
TMemoField(Result).FCodePage := FCodePage
|
||||
else if (Result is TFloatField) then
|
||||
TFloatField(Result).Precision := FPrecision
|
||||
else if (Result is TBCDField) then
|
||||
TBCDField(Result).Precision := FPrecision
|
||||
else if (Result is TFmtBCDField) then
|
||||
TFmtBCDField(Result).Precision := FPrecision;
|
||||
except
|
||||
Result.Free;
|
||||
@ -146,7 +161,7 @@ begin
|
||||
Changed(False);
|
||||
end;
|
||||
|
||||
Function TFieldDef.GetFieldClass : TFieldClass;
|
||||
function TFieldDef.GetFieldClass: TFieldClass;
|
||||
|
||||
begin
|
||||
//!! Should be owner as tdataset but that doesn't work ??
|
||||
@ -159,6 +174,21 @@ begin
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
function TFieldDef.GetCharSize: Word;
|
||||
begin
|
||||
case FDataType of
|
||||
ftString, ftFixedChar:
|
||||
case FCodePage of
|
||||
CP_UTF8: Result := 4;
|
||||
else Result := 1;
|
||||
end;
|
||||
ftWideString, ftFixedWideChar:
|
||||
Result := 2;
|
||||
else
|
||||
Result := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TFieldDefs
|
||||
---------------------------------------------------------------------}
|
||||
@ -222,9 +252,14 @@ begin
|
||||
Inherited Create(ADataset, Owner, FieldDefClass);
|
||||
end;
|
||||
|
||||
function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Integer; ACodePage: TSystemCodePage): TFieldDef;
|
||||
begin
|
||||
Result:=FieldDefClass.Create(Self,AName,ADataType,ASize,ARequired,AFieldNo,ACodePage);
|
||||
end;
|
||||
|
||||
function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Integer): TFieldDef;
|
||||
begin
|
||||
Result:=FieldDefClass.create(Self,AName,ADataType,ASize,ARequired,AFieldNo);
|
||||
Result:=FieldDefClass.Create(Self,AName,ADataType,ASize,ARequired,AFieldNo);
|
||||
end;
|
||||
|
||||
procedure TFieldDefs.Assign(FieldDefs: TFieldDefs);
|
||||
@ -367,12 +402,14 @@ begin
|
||||
Assign(TPersistent(VObject))
|
||||
else
|
||||
Error;
|
||||
vtAnsiString:
|
||||
AsString := string(VAnsiString);
|
||||
vtCurrency:
|
||||
AsCurrency := VCurrency^;
|
||||
vtVariant:
|
||||
if not VarIsClear(VVariant^) then Self.Value := VVariant^;
|
||||
vtAnsiString:
|
||||
AsAnsiString := AnsiString(VAnsiString);
|
||||
vtUnicodeString:
|
||||
AsUnicodeString := UnicodeString(VUnicodeString);
|
||||
vtWideString:
|
||||
AsWideString := WideString(VWideString);
|
||||
vtInt64:
|
||||
@ -457,6 +494,11 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TField.GetAsCurrency: Currency;
|
||||
begin
|
||||
Result := GetAsFloat;
|
||||
end;
|
||||
|
||||
function TField.GetAsDateTime: TDateTime;
|
||||
|
||||
begin
|
||||
@ -469,6 +511,11 @@ begin
|
||||
raise AccessError(SDateTime);
|
||||
end;
|
||||
|
||||
function TField.GetAsLargeInt: Largeint;
|
||||
begin
|
||||
Raise AccessError(SLargeInt);
|
||||
end;
|
||||
|
||||
function TField.GetAsLongint: Longint;
|
||||
|
||||
begin
|
||||
@ -489,14 +536,28 @@ end;
|
||||
|
||||
|
||||
function TField.GetAsString: string;
|
||||
|
||||
begin
|
||||
Result := GetClassDesc;
|
||||
Result := GetClassDesc
|
||||
end;
|
||||
|
||||
function TField.GetAsAnsiString: AnsiString;
|
||||
begin
|
||||
Result := GetAsString;
|
||||
end;
|
||||
|
||||
function TField.GetAsUnicodeString: UnicodeString;
|
||||
begin
|
||||
Result := GetAsString;
|
||||
end;
|
||||
|
||||
function TField.GetAsUTF8String: UTF8String;
|
||||
begin
|
||||
Result := GetAsString;
|
||||
end;
|
||||
|
||||
function TField.GetAsWideString: WideString;
|
||||
begin
|
||||
Result := GetAsString;
|
||||
Result := GetAsUnicodeString;
|
||||
end;
|
||||
|
||||
function TField.GetOldValue: variant;
|
||||
@ -629,7 +690,7 @@ begin
|
||||
Result:=(DisplayLabel<>FieldName);
|
||||
end;
|
||||
|
||||
Function TField.IsDisplayWidthStored : Boolean;
|
||||
function TField.IsDisplayWidthStored: Boolean;
|
||||
|
||||
begin
|
||||
Result:=(FDisplayWidth<>0);
|
||||
@ -664,16 +725,6 @@ begin
|
||||
Result := FieldKind = fkLookup;
|
||||
end;
|
||||
|
||||
function TField.GetAsLargeInt: LargeInt;
|
||||
begin
|
||||
Raise AccessError(SLargeInt);
|
||||
end;
|
||||
|
||||
function TField.GetAsCurrency: Currency;
|
||||
begin
|
||||
Result := GetAsFloat;
|
||||
end;
|
||||
|
||||
procedure TField.SetAlignment(const AValue: TAlignMent);
|
||||
begin
|
||||
if FAlignment <> AValue then
|
||||
@ -844,11 +895,26 @@ begin
|
||||
Raise AccessError(SString);
|
||||
end;
|
||||
|
||||
procedure TField.SetAsWideString(const AValue: WideString);
|
||||
procedure TField.SetAsAnsiString(const AValue: AnsiString);
|
||||
begin
|
||||
SetAsString(AValue);
|
||||
end;
|
||||
|
||||
procedure TField.SetAsUnicodeString(const AValue: UnicodeString);
|
||||
begin
|
||||
SetAsString(AValue);
|
||||
end;
|
||||
|
||||
procedure TField.SetAsUTF8String(const AValue: UTF8String);
|
||||
begin
|
||||
SetAsString(AValue);
|
||||
end;
|
||||
|
||||
procedure TField.SetAsWideString(const AValue: WideString);
|
||||
begin
|
||||
SetAsUnicodeString(AValue);
|
||||
end;
|
||||
|
||||
|
||||
procedure TField.SetData(Buffer: Pointer);
|
||||
|
||||
@ -914,7 +980,7 @@ end;
|
||||
procedure TField.SetText(const AValue: string);
|
||||
|
||||
begin
|
||||
AsString:=AValue;
|
||||
SetAsString(AValue);
|
||||
end;
|
||||
|
||||
procedure TField.SetVarValue(const AValue: Variant);
|
||||
@ -1040,6 +1106,7 @@ constructor TStringField.Create(AOwner: TComponent);
|
||||
begin
|
||||
Inherited Create(AOwner);
|
||||
SetDataType(ftString);
|
||||
FCodePage := CP_ACP;
|
||||
FFixedChar := False;
|
||||
FTransliterate := False;
|
||||
FSize := 20;
|
||||
@ -1058,7 +1125,7 @@ begin
|
||||
// a query like: 'select '' as fieldname from table' which
|
||||
// results in a string with size 0.
|
||||
If (AValue<0) Then
|
||||
databaseErrorFmt(SInvalidFieldSize,[AValue])
|
||||
DatabaseErrorFmt(SInvalidFieldSize,[AValue])
|
||||
end;
|
||||
|
||||
function TStringField.GetAsBoolean: Boolean;
|
||||
@ -1094,16 +1161,37 @@ begin
|
||||
Result:=StrToInt64(GetAsString);
|
||||
end;
|
||||
|
||||
function TStringField.GetAsString: string;
|
||||
|
||||
function TStringField.GetAsString: String;
|
||||
begin
|
||||
If Not GetValue(Result) then
|
||||
{$IFDEF UNICODE}
|
||||
Result := GetAsAnsiString;
|
||||
{$ELSE}
|
||||
if GetValue(RawByteString(Result)) then
|
||||
SetCodePage(RawByteString(Result), CP_ACP, True)
|
||||
else
|
||||
Result:='';
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TStringField.GetAsAnsiString: AnsiString;
|
||||
begin
|
||||
if GetValue(RawByteString(Result)) then
|
||||
SetCodePage(RawByteString(Result), CP_ACP, True)
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
function TStringField.GetAsVariant: Variant;
|
||||
function TStringField.GetAsUTF8String: UTF8String;
|
||||
begin
|
||||
if GetValue(RawByteString(Result)) then
|
||||
SetCodePage(RawByteString(Result), CP_UTF8, True)
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
var s : string;
|
||||
function TStringField.GetAsVariant: variant;
|
||||
|
||||
var s : rawbytestring;
|
||||
|
||||
begin
|
||||
If GetValue(s) then
|
||||
@ -1116,7 +1204,10 @@ end;
|
||||
function TStringField.GetDataSize: Integer;
|
||||
|
||||
begin
|
||||
Result:=Size+1;
|
||||
case FCodePage of
|
||||
CP_UTF8: Result := 4*Size+1;
|
||||
else Result := Size+1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TStringField.GetDefaultWidth: Longint;
|
||||
@ -1125,22 +1216,22 @@ begin
|
||||
result:=Size;
|
||||
end;
|
||||
|
||||
Procedure TStringField.GetText(var AText: string; ADisplayText: Boolean);
|
||||
procedure TStringField.GetText(var AText: string; ADisplayText: Boolean);
|
||||
|
||||
begin
|
||||
AText:=GetAsString;
|
||||
end;
|
||||
|
||||
function TStringField.GetValue(var AValue: string): Boolean;
|
||||
function TStringField.GetValue(out AValue: RawByteString): Boolean;
|
||||
|
||||
var Buf, TBuf : TStringFieldBuffer;
|
||||
DynBuf, TDynBuf : Array of char;
|
||||
DynBuf, TDynBuf : Array of AnsiChar;
|
||||
|
||||
begin
|
||||
if DataSize <= dsMaxStringSize then
|
||||
begin
|
||||
Result:=GetData(@Buf);
|
||||
Buf[Size]:=#0; //limit string to Size
|
||||
Buf[DataSize-1]:=#0; //limit string to Size
|
||||
If Result then
|
||||
begin
|
||||
if Transliterate then
|
||||
@ -1156,19 +1247,20 @@ begin
|
||||
begin
|
||||
SetLength(DynBuf,DataSize);
|
||||
Result:=GetData(@DynBuf[0]);
|
||||
DynBuf[Size]:=#0; //limit string to Size
|
||||
DynBuf[DataSize-1]:=#0; //limit string to Size
|
||||
If Result then
|
||||
begin
|
||||
if Transliterate then
|
||||
begin
|
||||
SetLength(TDynBuf,DataSize);
|
||||
DataSet.Translate(@DynBuf[0],@TDynBuf[0],False);
|
||||
AValue:=pchar(TDynBuf);
|
||||
AValue:=PAnsiChar(TDynBuf);
|
||||
end
|
||||
else
|
||||
AValue:=pchar(DynBuf);
|
||||
AValue:=PAnsiChar(DynBuf);
|
||||
end
|
||||
end;
|
||||
SetCodePage(AValue, FCodePage, False);
|
||||
end;
|
||||
|
||||
procedure TStringField.SetAsBoolean(AValue: Boolean);
|
||||
@ -1204,27 +1296,29 @@ begin
|
||||
SetAsString(IntToStr(AValue));
|
||||
end;
|
||||
|
||||
procedure TStringField.SetAsString(const AValue: string);
|
||||
|
||||
procedure TStringField.SetValue(AValue: RawByteString);
|
||||
var Buf : TStringFieldBuffer;
|
||||
DynBuf : array of char;
|
||||
|
||||
DynBuf : array of AnsiChar;
|
||||
begin
|
||||
if Length(AValue)=0 then
|
||||
if AValue='' then
|
||||
begin
|
||||
Buf := #0;
|
||||
SetData(@Buf);
|
||||
end
|
||||
else if DataSize <= dsMaxStringSize then
|
||||
else
|
||||
begin
|
||||
if StringCodePage(AValue) <> FCodePage then
|
||||
SetCodePage(AValue, FCodePage, True);
|
||||
if DataSize <= dsMaxStringSize then
|
||||
begin
|
||||
if FTransliterate then
|
||||
DataSet.Translate(@AValue[1],Buf,True)
|
||||
else
|
||||
// The data is copied into the buffer, since some TDataset descendents copy
|
||||
// the whole buffer-length in SetData. (See bug 8477)
|
||||
StrPLCopy(PChar(Buf), AValue, Size);
|
||||
StrPLCopy(PAnsiChar(Buf), AValue, DataSize-1);
|
||||
// If length(AValue) > Size the buffer isn't terminated properly ?
|
||||
Buf[Size] := #0;
|
||||
Buf[DataSize-1] := #0;
|
||||
SetData(@Buf);
|
||||
end
|
||||
else
|
||||
@ -1233,9 +1327,29 @@ begin
|
||||
if FTransliterate then
|
||||
DataSet.Translate(@AValue[1],@DynBuf[0],True)
|
||||
else
|
||||
StrPLCopy(PChar(DynBuf), AValue, Size);
|
||||
StrPLCopy(PAnsiChar(DynBuf), AValue, DataSize-1);
|
||||
SetData(@DynBuf[0]);
|
||||
end
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TStringField.SetAsString(const AValue: String);
|
||||
begin
|
||||
{$IFDEF UNICODE}
|
||||
SetAsAnsiString(AValue);
|
||||
{$ELSE}
|
||||
SetValue(AValue);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TStringField.SetAsAnsiString(const AValue: AnsiString);
|
||||
begin
|
||||
SetValue(AValue);
|
||||
end;
|
||||
|
||||
procedure TStringField.SetAsUTF8String(const AValue: UTF8String);
|
||||
begin
|
||||
SetValue(AValue);
|
||||
end;
|
||||
|
||||
procedure TStringField.SetVarValue(const AValue: Variant);
|
||||
@ -1243,6 +1357,7 @@ begin
|
||||
SetAsString(AValue);
|
||||
end;
|
||||
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TWideStringField
|
||||
---------------------------------------------------------------------}
|
||||
@ -1253,13 +1368,14 @@ begin
|
||||
// a query like: 'select '' as fieldname from table' which
|
||||
// results in a string with size 0.
|
||||
If (AValue<0) Then
|
||||
databaseErrorFmt(SInvalidFieldSize,[AValue]);
|
||||
DatabaseErrorFmt(SInvalidFieldSize,[AValue]);
|
||||
end;
|
||||
|
||||
constructor TWideStringField.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
SetDataType(ftWideString);
|
||||
FCodePage := CP_UTF16;
|
||||
end;
|
||||
|
||||
procedure TWideStringField.SetFieldType(AValue: TFieldType);
|
||||
@ -1268,11 +1384,11 @@ begin
|
||||
SetDataType(AValue);
|
||||
end;
|
||||
|
||||
function TWideStringField.GetValue(var AValue: WideString): Boolean;
|
||||
function TWideStringField.GetValue(out AValue: UnicodeString): Boolean;
|
||||
var
|
||||
FixBuffer : array[0..dsMaxStringSize div 2] of WideChar;
|
||||
DynBuffer : array of WideChar;
|
||||
Buffer : PWideChar;
|
||||
FixBuffer : array[0..dsMaxStringSize div 2] of UnicodeChar;
|
||||
DynBuffer : array of UnicodeChar;
|
||||
Buffer : PUnicodeChar;
|
||||
begin
|
||||
if DataSize <= dsMaxStringSize then begin
|
||||
Result := GetData(@FixBuffer, False);
|
||||
@ -1280,7 +1396,7 @@ begin
|
||||
AValue := FixBuffer;
|
||||
end else begin
|
||||
SetLength(DynBuffer, Succ(Size));
|
||||
Buffer := PWideChar(DynBuffer);
|
||||
Buffer := PUnicodeChar(DynBuffer);
|
||||
Result := GetData(Buffer, False);
|
||||
Buffer[Size]:=#0; //limit string to Size
|
||||
if Result then
|
||||
@ -1290,20 +1406,43 @@ end;
|
||||
|
||||
function TWideStringField.GetAsString: string;
|
||||
begin
|
||||
Result := GetAsWideString;
|
||||
{$IFDEF UNICODE}
|
||||
if not GetValue(Result) then
|
||||
Result := '';
|
||||
{$ELSE}
|
||||
Result := GetAsUnicodeString;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TWideStringField.SetAsString(const AValue: string);
|
||||
begin
|
||||
SetAsWideString(AValue);
|
||||
SetAsUnicodeString(AValue);
|
||||
end;
|
||||
|
||||
function TWideStringField.GetAsUnicodeString: UnicodeString;
|
||||
begin
|
||||
if not GetValue(Result) then
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
procedure TWideStringField.SetAsUnicodeString(const AValue: UnicodeString);
|
||||
const
|
||||
NullUnicodeChar : UnicodeChar = #0;
|
||||
var
|
||||
Buffer : PUnicodeChar;
|
||||
begin
|
||||
if Length(AValue)>0 then
|
||||
Buffer := PUnicodeChar(@AValue[1])
|
||||
else
|
||||
Buffer := @NullUnicodeChar;
|
||||
SetData(Buffer, False);
|
||||
end;
|
||||
|
||||
function TWideStringField.GetAsVariant: Variant;
|
||||
var
|
||||
ws: WideString;
|
||||
var us: UnicodeString;
|
||||
begin
|
||||
if GetValue(ws) then
|
||||
Result := ws
|
||||
if GetValue(us) then
|
||||
Result := us
|
||||
else
|
||||
Result := Null;
|
||||
end;
|
||||
@ -1314,28 +1453,32 @@ begin
|
||||
end;
|
||||
|
||||
function TWideStringField.GetAsWideString: WideString;
|
||||
var us: UnicodeString;
|
||||
begin
|
||||
if not GetValue(Result) then
|
||||
if GetValue(us) then
|
||||
Result := us
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
procedure TWideStringField.SetAsWideString(const AValue: WideString);
|
||||
const
|
||||
NullWideChar : WideChar = #0;
|
||||
var
|
||||
Buffer : PWideChar;
|
||||
begin
|
||||
if Length(AValue)>0 then
|
||||
Buffer := PWideChar(@AValue[1])
|
||||
else
|
||||
Buffer := @NullWideChar;
|
||||
SetData(Buffer, False);
|
||||
SetAsUnicodeString(AValue);
|
||||
end;
|
||||
|
||||
function TWideStringField.GetAsUTF8String: UTF8String;
|
||||
begin
|
||||
Result := GetAsUnicodeString;
|
||||
end;
|
||||
|
||||
procedure TWideStringField.SetAsUTF8String(const AValue: UTF8String);
|
||||
begin
|
||||
SetAsUnicodeString(AValue);
|
||||
end;
|
||||
|
||||
function TWideStringField.GetDataSize: Integer;
|
||||
begin
|
||||
Result :=
|
||||
(Size + 1) * 2;
|
||||
Result := (Size + 1) * 2;
|
||||
end;
|
||||
|
||||
|
||||
@ -1852,7 +1995,7 @@ begin
|
||||
Result:=SizeOf(Double);
|
||||
end;
|
||||
|
||||
procedure TFloatField.GetText(var TheText: string; ADisplayText: Boolean);
|
||||
procedure TFloatField.GetText(var AText: string; ADisplayText: Boolean);
|
||||
|
||||
Var
|
||||
fmt : string;
|
||||
@ -1861,7 +2004,7 @@ Var
|
||||
ff: TFloatFormat;
|
||||
|
||||
begin
|
||||
TheText:='';
|
||||
AText:='';
|
||||
If Not GetData(@E) then exit;
|
||||
If ADisplayText or (Length(FEditFormat) = 0) Then
|
||||
Fmt:=FDisplayFormat
|
||||
@ -1882,9 +2025,9 @@ begin
|
||||
|
||||
|
||||
If fmt<>'' then
|
||||
TheText:=FormatFloat(fmt,E)
|
||||
AText:=FormatFloat(fmt,E)
|
||||
else
|
||||
TheText:=FloatToStrF(E,ff,FPrecision,Digits);
|
||||
AText:=FloatToStrF(E,ff,FPrecision,Digits);
|
||||
end;
|
||||
|
||||
procedure TFloatField.SetAsBCD(const AValue: TBCD);
|
||||
@ -2132,14 +2275,14 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TDateTimeField.GetText(var TheText: string; ADisplayText: Boolean);
|
||||
procedure TDateTimeField.GetText(var AText: string; ADisplayText: Boolean);
|
||||
|
||||
var R : TDateTime;
|
||||
F : String;
|
||||
|
||||
begin
|
||||
If Not GetData(@R,False) then
|
||||
TheText:=''
|
||||
AText:=''
|
||||
else
|
||||
begin
|
||||
If (ADisplayText) and (Length(FDisplayFormat)<>0) then
|
||||
@ -2151,7 +2294,7 @@ begin
|
||||
else
|
||||
F:='c'
|
||||
end;
|
||||
TheText:=FormatDateTime(F,R);
|
||||
AText:=FormatDateTime(F,R);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -2273,13 +2416,6 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TBinaryField.GetText(var TheText: string; ADisplayText: Boolean);
|
||||
|
||||
begin
|
||||
TheText:=GetAsString;
|
||||
end;
|
||||
|
||||
|
||||
function TBinaryField.GetValue(var AValue: TBytes): Boolean;
|
||||
var B: TBytes;
|
||||
begin
|
||||
@ -2340,12 +2476,6 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TBinaryField.SetText(const AValue: string);
|
||||
|
||||
begin
|
||||
SetAsString(AValue);
|
||||
end;
|
||||
|
||||
procedure TBinaryField.SetVarValue(const AValue: Variant);
|
||||
var P: Pointer;
|
||||
B: TBytes;
|
||||
@ -2494,27 +2624,27 @@ begin
|
||||
else Result := 10;
|
||||
end;
|
||||
|
||||
procedure TBCDField.GetText(var TheText: string; ADisplayText: Boolean);
|
||||
procedure TBCDField.GetText(var AText: string; ADisplayText: Boolean);
|
||||
var
|
||||
c : system.currency;
|
||||
fmt: String;
|
||||
begin
|
||||
if GetData(@C) then begin
|
||||
if aDisplayText or (FEditFormat='') then
|
||||
if ADisplayText or (FEditFormat='') then
|
||||
fmt := FDisplayFormat
|
||||
else
|
||||
fmt := FEditFormat;
|
||||
if fmt<>'' then
|
||||
TheText := FormatFloat(fmt,C)
|
||||
AText := FormatFloat(fmt,C)
|
||||
else if fCurrency then begin
|
||||
if aDisplayText then
|
||||
TheText := FloatToStrF(C, ffCurrency, FPrecision, 2{digits?})
|
||||
if ADisplayText then
|
||||
AText := FloatToStrF(C, ffCurrency, FPrecision, 2{digits?})
|
||||
else
|
||||
TheText := FloatToStrF(C, ffFixed, FPrecision, 2{digits?});
|
||||
AText := FloatToStrF(C, ffFixed, FPrecision, 2{digits?});
|
||||
end else
|
||||
TheText := FloatToStrF(C, ffGeneral, FPrecision, 0{digits?});
|
||||
AText := FloatToStrF(C, ffGeneral, FPrecision, 0{digits?});
|
||||
end else
|
||||
TheText := '';
|
||||
AText := '';
|
||||
end;
|
||||
|
||||
procedure TBCDField.SetAsBCD(const AValue: TBCD);
|
||||
@ -2672,27 +2802,27 @@ begin
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
procedure TFMTBCDField.GetText(var TheText: string; ADisplayText: Boolean);
|
||||
procedure TFMTBCDField.GetText(var AText: string; ADisplayText: Boolean);
|
||||
var
|
||||
bcd: TBCD;
|
||||
fmt: String;
|
||||
begin
|
||||
if GetData(@bcd) then begin
|
||||
if aDisplayText or (FEditFormat='') then
|
||||
if ADisplayText or (FEditFormat='') then
|
||||
fmt := FDisplayFormat
|
||||
else
|
||||
fmt := FEditFormat;
|
||||
if fmt<>'' then
|
||||
TheText := FormatBCD(fmt,bcd)
|
||||
AText := FormatBCD(fmt,bcd)
|
||||
else if fCurrency then begin
|
||||
if aDisplayText then
|
||||
TheText := BcdToStrF(bcd, ffCurrency, FPrecision, 2)
|
||||
if ADisplayText then
|
||||
AText := BcdToStrF(bcd, ffCurrency, FPrecision, 2)
|
||||
else
|
||||
TheText := BcdToStrF(bcd, ffFixed, FPrecision, 2);
|
||||
AText := BcdToStrF(bcd, ffFixed, FPrecision, 2);
|
||||
end else
|
||||
TheText := BcdToStrF(bcd, ffGeneral, FPrecision, FSize);
|
||||
AText := BcdToStrF(bcd, ffGeneral, FPrecision, FSize);
|
||||
end else
|
||||
TheText := '';
|
||||
AText := '';
|
||||
end;
|
||||
|
||||
function TFMTBCDField.GetMaxValue: string;
|
||||
@ -2769,6 +2899,14 @@ end;
|
||||
|
||||
{ TBlobField }
|
||||
|
||||
constructor TBlobField.Create(AOwner: TComponent);
|
||||
|
||||
begin
|
||||
Inherited Create(AOwner);
|
||||
SetDataType(ftBlob);
|
||||
end;
|
||||
|
||||
|
||||
function TBlobField.GetBlobStream(Mode: TBlobStreamMode): TStream;
|
||||
|
||||
begin
|
||||
@ -2777,7 +2915,7 @@ end;
|
||||
|
||||
function TBlobField.GetBlobType: TBlobType;
|
||||
begin
|
||||
result:= TBlobType(DataType);
|
||||
Result:= TBlobType(DataType);
|
||||
end;
|
||||
|
||||
procedure TBlobField.SetBlobType(AValue: TBlobType);
|
||||
@ -2786,7 +2924,6 @@ begin
|
||||
end;
|
||||
|
||||
procedure TBlobField.FreeBuffers;
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
@ -2810,11 +2947,19 @@ begin
|
||||
end;
|
||||
|
||||
function TBlobField.GetAsString: string;
|
||||
begin
|
||||
{$IFDEF UNICODE}
|
||||
Result := GetAsUnicodeString;
|
||||
{$ELSE}
|
||||
Result := GetAsAnsiString;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TBlobField.GetAsAnsiString: AnsiString;
|
||||
var
|
||||
Stream : TStream;
|
||||
Len : Integer;
|
||||
S : String;
|
||||
|
||||
S : AnsiString;
|
||||
begin
|
||||
Stream := GetBlobStream(bmRead);
|
||||
if Stream <> nil then
|
||||
@ -2842,7 +2987,7 @@ begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TBlobField.GetAsWideString: WideString;
|
||||
function TBlobField.GetAsUnicodeString: UnicodeString;
|
||||
var
|
||||
Stream : TStream;
|
||||
Len : Integer;
|
||||
@ -2863,15 +3008,11 @@ begin
|
||||
end;
|
||||
|
||||
function TBlobField.GetAsVariant: Variant;
|
||||
var s : string;
|
||||
begin
|
||||
if not GetIsNull then
|
||||
begin
|
||||
s := GetAsString;
|
||||
result := s;
|
||||
end
|
||||
Result := GetAsString
|
||||
else
|
||||
result := Null;
|
||||
Result := Null;
|
||||
end;
|
||||
|
||||
|
||||
@ -2906,13 +3047,12 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TBlobField.GetText(var TheText: string; ADisplayText: Boolean);
|
||||
|
||||
procedure TBlobField.GetText(var AText: string; ADisplayText: Boolean);
|
||||
begin
|
||||
TheText:=inherited GetAsString;
|
||||
AText := inherited GetAsString;
|
||||
end;
|
||||
|
||||
|
||||
procedure TBlobField.SetAsBytes(const AValue: TBytes);
|
||||
var
|
||||
Len : Integer;
|
||||
@ -2929,10 +3069,18 @@ end;
|
||||
|
||||
|
||||
procedure TBlobField.SetAsString(const AValue: string);
|
||||
begin
|
||||
{$IFDEF UNICODE}
|
||||
SetAsUnicodeString(AValue);
|
||||
{$ELSE}
|
||||
SetAsAnsiString(AValue);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TBlobField.SetAsAnsiString(const AValue: AnsiString);
|
||||
var
|
||||
Len : Integer;
|
||||
S : String;
|
||||
|
||||
S : AnsiString;
|
||||
begin
|
||||
with GetBlobStream(bmWrite) do
|
||||
try
|
||||
@ -2953,13 +3101,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBlobField.SetAsWideString(const AValue: WideString);
|
||||
procedure TBlobField.SetAsUnicodeString(const AValue: UnicodeString);
|
||||
var
|
||||
Len : Integer;
|
||||
begin
|
||||
with GetBlobStream(bmWrite) do
|
||||
try
|
||||
Len := Length(AValue) * 2;
|
||||
Len := Length(AValue) * SizeOf(UnicodeChar);
|
||||
if Len > 0 then
|
||||
WriteBuffer(AValue[1], Len);
|
||||
finally
|
||||
@ -2968,26 +3116,12 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TBlobField.SetText(const AValue: string);
|
||||
|
||||
begin
|
||||
SetAsString(AValue);
|
||||
end;
|
||||
|
||||
procedure TBlobField.SetVarValue(const AValue: Variant);
|
||||
begin
|
||||
SetAsString(AValue);
|
||||
end;
|
||||
|
||||
|
||||
constructor TBlobField.Create(AOwner: TComponent);
|
||||
|
||||
begin
|
||||
Inherited Create(AOWner);
|
||||
SetDataType(ftBlob);
|
||||
end;
|
||||
|
||||
|
||||
procedure TBlobField.Clear;
|
||||
|
||||
begin
|
||||
@ -3059,20 +3193,46 @@ end;
|
||||
{ TMemoField }
|
||||
|
||||
constructor TMemoField.Create(AOwner: TComponent);
|
||||
|
||||
begin
|
||||
Inherited Create(AOwner);
|
||||
inherited Create(AOwner);
|
||||
SetDataType(ftMemo);
|
||||
end;
|
||||
|
||||
function TMemoField.GetAsWideString: WideString;
|
||||
function TMemoField.GetAsAnsiString: AnsiString;
|
||||
begin
|
||||
Result := GetAsString;
|
||||
Result := inherited GetAsAnsiString;
|
||||
SetCodePage(RawByteString(Result), FCodePage, False);
|
||||
SetCodePage(RawByteString(Result), CP_ACP, True);
|
||||
end;
|
||||
|
||||
procedure TMemoField.SetAsWideString(const AValue: WideString);
|
||||
procedure TMemoField.SetAsAnsiString(const AValue: AnsiString);
|
||||
var s: RawByteString;
|
||||
begin
|
||||
SetAsString(AValue);
|
||||
s := AValue;
|
||||
SetCodePage(s, FCodePage, True);
|
||||
inherited SetAsAnsiString(s);
|
||||
end;
|
||||
|
||||
function TMemoField.GetAsUnicodeString: UnicodeString;
|
||||
begin
|
||||
Result:=GetAsAnsiString;
|
||||
end;
|
||||
|
||||
procedure TMemoField.SetAsUnicodeString(const AValue: UnicodeString);
|
||||
begin
|
||||
SetAsAnsiString(AValue);
|
||||
end;
|
||||
|
||||
function TMemoField.GetAsUTF8String: UTF8String;
|
||||
begin
|
||||
Result := inherited GetAsAnsiString;
|
||||
SetCodePage(RawByteString(Result), FCodePage, False);
|
||||
SetCodePage(RawByteString(Result), CP_UTF8, True);
|
||||
end;
|
||||
|
||||
procedure TMemoField.SetAsUTF8String(const AValue: UTF8String);
|
||||
begin
|
||||
SetAsAnsiString(AValue);
|
||||
end;
|
||||
|
||||
{ TWideMemoField }
|
||||
@ -3085,28 +3245,45 @@ end;
|
||||
|
||||
function TWideMemoField.GetAsString: string;
|
||||
begin
|
||||
Result := GetAsWideString;
|
||||
Result := GetAsUnicodeString;
|
||||
end;
|
||||
|
||||
procedure TWideMemoField.SetAsString(const AValue: string);
|
||||
begin
|
||||
SetAsWideString(AValue);
|
||||
SetAsUnicodeString(AValue);
|
||||
end;
|
||||
|
||||
function TWideMemoField.GetAsAnsiString: AnsiString;
|
||||
begin
|
||||
Result := GetAsUnicodeString;
|
||||
end;
|
||||
|
||||
procedure TWideMemoField.SetAsAnsiString(const AValue: AnsiString);
|
||||
begin
|
||||
SetAsUnicodeString(AValue);
|
||||
end;
|
||||
|
||||
function TWideMemoField.GetAsUTF8String: UTF8String;
|
||||
begin
|
||||
Result := GetAsUnicodeString;
|
||||
end;
|
||||
|
||||
procedure TWideMemoField.SetAsUTF8String(const AValue: UTF8String);
|
||||
begin
|
||||
SetAsUnicodeString(AValue);
|
||||
end;
|
||||
|
||||
function TWideMemoField.GetAsVariant: Variant;
|
||||
var s : string;
|
||||
begin
|
||||
if not GetIsNull then
|
||||
begin
|
||||
s := GetAsWideString;
|
||||
result := s;
|
||||
end
|
||||
else result := Null;
|
||||
Result := GetAsUnicodeString
|
||||
else
|
||||
Result := Null;
|
||||
end;
|
||||
|
||||
procedure TWideMemoField.SetVarValue(const AValue: Variant);
|
||||
begin
|
||||
SetAsWideString(AValue);
|
||||
SetAsUnicodeString(AValue);
|
||||
end;
|
||||
|
||||
{ TGraphicField }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user