ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBCustomDataSet.pas

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC vs.
Revision 39 by tony, Tue May 17 08:14:52 2016 UTC

#	Line 33 | Line 33
33
34		unit IBCustomDataSet;
35
36	+	{$IF FPC_FULLVERSION >= 20700 }
37	+	{$codepage UTF8}
38	+	{$DEFINE HAS_ANSISTRING_CODEPAGE}
39	+	{$DEFINE NEW_TBOOKMARK}
40	+	{$ENDIF}
41	+
42		{$R-}
43
44		{$Mode Delphi}
#	Line 120 | Line 126 | type
126
127		TIBStringField = class(TStringField)
128		private
129	<	FInitialised: boolean;
129	>	FCharacterSetName: RawByteString;
130	>	FCharacterSetSize: integer;
131		protected
132	<	procedure SetSize(AValue: Integer); override;
132	>	function GetDefaultWidth: Longint; override;
133		public
134	<	constructor create(AOwner: TComponent); override;
134	>	constructor Create(aOwner: TComponent); override;
135		class procedure CheckTypeSize(Value: Integer); override;
136		function GetAsString: string; override;
137		function GetAsVariant: Variant; override;
138		function GetValue(var Value: string): Boolean;
139		procedure SetAsString(const Value: string); override;
140	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
141	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
142	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
143	+	private
144	+	FCodePage: TSystemCodePage;
145	+	public
146	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
147	+	{$ENDIF}
148	+	end;
149	+
150	+	{ TIBWideStringField }
151	+
152	+	TIBWideStringField = class(TWideStringField)
153	+	private
154	+	FCharacterSetName: RawByteString;
155	+	FCharacterSetSize: integer;
156	+	public
157	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
158	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
159		end;
160
161		{ TIBBCDField }
#	Line 152 | Line 178 | type
178		property Size default 8;
179		end;
180
181	+	{TIBMemoField}
182	+	{Allows us to show truncated text in DBGrids and anything else that uses
183	+	DisplayText}
184	+
185	+	TIBMemoField = class(TMemoField)
186	+	private
187	+	FCharacterSetName: RawByteString;
188	+	FCharacterSetSize: integer;
189	+	FDisplayTextAsClassName: boolean;
190	+	function GetTruncatedText: string;
191	+	protected
192	+	function GetAsString: string; override;
193	+	function GetDefaultWidth: Longint; override;
194	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
195	+	procedure SetAsString(const AValue: string); override;
196	+	public
197	+	constructor Create(AOwner: TComponent); override;
198	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
199	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
200	+	published
201	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
202	+	write FDisplayTextAsClassName;
203	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
204	+	private
205	+	FCodePage: TSystemCodePage;
206	+	FFCodePage: TSystemCodePage;
207	+	public
208	+	property CodePage: TSystemCodePage read FFCodePage write FFCodePage;
209	+	{$ENDIF}
210	+	end;
211	+
212	+	{ TIBWideMemoField }
213	+
214	+	TIBWideMemoField = class(TWideMemoField)
215	+	private
216	+	FCharacterSetName: RawByteString;
217	+	FCharacterSetSize: integer;
218	+	FDisplayTextAsClassName: boolean;
219	+	function GetTruncatedText: string;
220	+	protected
221	+	function GetDefaultWidth: Longint; override;
222	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
223	+	public
224	+	constructor Create(AOwner: TComponent); override;
225	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
226	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
227	+	published
228	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
229	+	write FDisplayTextAsClassName;
230	+	end;
231	+
232		TIBDataLink = class(TDetailDataLink)
233		private
234		FDataSet: TIBCustomDataSet;
#	Line 341 | Line 418 | type
418		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
419		procedure SetUniDirectional(Value: Boolean);
420		procedure RefreshParams;
344	–	procedure SQLChanging(Sender: TObject); virtual;
421		function AdjustPosition(FCache: PChar; Offset: DWORD;
422		Origin: Integer): DWORD;
423		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
#	Line 371 | Line 447 | type
447		procedure InternalRefreshRow; virtual;
448		procedure InternalSetParamsFromCursor; virtual;
449		procedure CheckNotUniDirectional;
450	+	procedure SQLChanging(Sender: TObject); virtual;
451	+	procedure SQLChanged(Sender: TObject); virtual;
452
453		(*    { IProviderSupport }
454		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 502 | Line 580 | type
580		procedure RecordModified(Value: Boolean);
581		procedure RevertRecord;
582		procedure Undelete;
583	<	procedure ResetParser;
583	>	procedure ResetParser; virtual;
584		function HasParser: boolean;
585
586		{ TDataSet support methods }
#	Line 690 | Line 768 | DefaultFieldClasses: array[TFieldType] o
768		TVarBytesField,     { ftVarBytes }
769		TAutoIncField,      { ftAutoInc }
770		TBlobField,         { ftBlob }
771	<	TMemoField,         { ftMemo }
771	>	TIBMemoField,       { ftMemo }
772		TGraphicField,      { ftGraphic }
773		TBlobField,         { ftFmtMemo }
774		TBlobField,         { ftParadoxOle }
#	Line 698 | Line 776 | DefaultFieldClasses: array[TFieldType] o
776		TBlobField,         { ftTypedBinary }
777		nil,                { ftCursor }
778		TStringField,       { ftFixedChar }
779	<	TWideStringField,    { ftWideString }
779	>	TIBWideStringField,    { ftWideString }
780		TLargeIntField,     { ftLargeInt }
781		nil,          { ftADT }
782		nil,        { ftArray }
#	Line 713 | Line 791 | DefaultFieldClasses: array[TFieldType] o
791		TDateTimeField,    {ftTimestamp}
792		TIBBCDField,       {ftFMTBcd}
793		nil,  {ftFixedWideChar}
794	<	TWideMemoField);   {ftWideMemo}
794	>	TIBWideMemoField);   {ftWideMemo}
795		(*
796		TADTField,          { ftADT }
797		TArrayField,        { ftArray }
#	Line 730 | Line 808 | DefaultFieldClasses: array[TFieldType] o
808
809		implementation
810
811	<	uses IBIntf, Variants, FmtBCD;
811	>	uses IBIntf, Variants, FmtBCD, LazUTF8;
812
813		const FILE_BEGIN = 0;
814		FILE_CURRENT = 1;
#	Line 753 | Line 831 | type
831		NextRelation : TRelationNode;
832		end;
833
834	+	{Extended Field Def for character set info}
835	+
836	+	{ TIBFieldDef }
837	+
838	+	TIBFieldDef = class(TFieldDef)
839	+	private
840	+	FCharacterSetName: RawByteString;
841	+	FCharacterSetSize: integer;
842	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
843	+	FCodePage: TSystemCodePage;
844	+	{$ENDIF}
845	+	published
846	+	property CharacterSetName: RawByteString read FCharacterSetName write FCharacterSetName;
847	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
848	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
849	+	property CodePage: TSystemCodePage read FCodePage write FCodePage;
850	+	{$ENDIF}
851	+	end;
852	+
853	+
854	+	{  Copied from LCLProc in order to avoid LCL dependency
855	+
856	+	Ensures the covenient look of multiline string
857	+	when displaying it in the single line
858	+	* Replaces CR and LF with spaces
859	+	* Removes duplicate spaces
860	+	}
861	+	function TextToSingleLine(const AText: string): string;
862	+	var
863	+	str: string;
864	+	i, wstart, wlen: Integer;
865	+	begin
866	+	str := Trim(AText);
867	+	wstart := 0;
868	+	wlen := 0;
869	+	i := 1;
870	+	while i < Length(str) - 1 do
871	+	begin
872	+	if (str[i] in [' ', #13, #10]) then
873	+	begin
874	+	if (wstart = 0) then
875	+	begin
876	+	wstart := i;
877	+	wlen := 1;
878	+	end else
879	+	Inc(wlen);
880	+	end else
881	+	begin
882	+	if wstart > 0 then
883	+	begin
884	+	str[wstart] := ' ';
885	+	Delete(str, wstart+1, wlen-1);
886	+	Dec(i, wlen-1);
887	+	wstart := 0;
888	+	end;
889	+	end;
890	+	Inc(i);
891	+	end;
892	+	Result := str;
893	+	end;
894	+
895	+	{ TIBWideMemoField }
896	+
897	+	function TIBWideMemoField.GetTruncatedText: string;
898	+	begin
899	+	Result := GetAsString;
900	+
901	+	if Result <> '' then
902	+	if DisplayWidth = 0 then
903	+	Result := TextToSingleLine(Result)
904	+	else
905	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
906	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
907	+	end;
908	+
909	+	function TIBWideMemoField.GetDefaultWidth: Longint;
910	+	begin
911	+	Result := 128;
912	+	end;
913	+
914	+	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
915	+	begin
916	+	if ADisplayText then
917	+	begin
918	+	if not DisplayTextAsClassName and (CharacterSetName<> '') then
919	+	AText := GetTruncatedText
920	+	else
921	+	inherited GetText(AText, ADisplayText);
922	+	end
923	+	else
924	+	AText := GetAsString;
925	+	end;
926	+
927	+	constructor TIBWideMemoField.Create(AOwner: TComponent);
928	+	begin
929	+	inherited Create(AOwner);
930	+	BlobType := ftWideMemo;
931	+	end;
932	+
933	+	{ TIBMemoField }
934	+
935	+	function TIBMemoField.GetTruncatedText: string;
936	+	begin
937	+	Result := GetAsString;
938	+
939	+	if Result <> '' then
940	+	begin
941	+	case CharacterSetSize of
942	+	1:
943	+	if DisplayWidth = 0 then
944	+	Result := TextToSingleLine(Result)
945	+	else
946	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
947	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
948	+
949	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
950	+
951	+	3, {Assume UNICODE_FSS is really UTF8}
952	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
953	+	if DisplayWidth = 0 then
954	+	Result := ValidUTF8String(TextToSingleLine(Result))
955	+	else
956	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
957	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
958	+	end;
959	+	end
960	+	end;
961	+
962	+	function TIBMemoField.GetAsString: string;
963	+	var s: RawByteString;
964	+	begin
965	+	s := inherited GetAsString;
966	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
967	+	SetCodePage(s,CodePage,false);
968	+	{$ENDIF}
969	+	Result := s;
970	+	end;
971	+
972	+	function TIBMemoField.GetDefaultWidth: Longint;
973	+	begin
974	+	if DisplayTextAsClassName then
975	+	Result := inherited
976	+	else
977	+	Result := 128;
978	+	end;
979	+
980	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
981	+	begin
982	+	if ADisplayText then
983	+	begin
984	+	if not DisplayTextAsClassName and (CharacterSetName <> '') then
985	+	AText := GetTruncatedText
986	+	else
987	+	inherited GetText(AText, ADisplayText);
988	+	end
989	+	else
990	+	AText := GetAsString;
991	+	end;
992	+
993	+	procedure TIBMemoField.SetAsString(const AValue: string);
994	+	var s: RawByteString;
995	+	begin
996	+	s := AValue;
997	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
998	+	if StringCodePage(Value) <> CodePage then
999	+	SetCodePage(s,CodePage,true);
1000	+	{$ENDIF}
1001	+	inherited SetAsString(s);
1002	+	end;
1003	+
1004	+	constructor TIBMemoField.Create(AOwner: TComponent);
1005	+	begin
1006	+	inherited Create(AOwner);
1007	+	BlobType := ftMemo;
1008	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1009	+	FCodePage := CP_NONE;
1010	+	{$ENDIF}
1011	+	end;
1012	+
1013		{ TIBControlLink }
1014
1015		destructor TIBControlLink.Destroy;
#	Line 784 | Line 1041 | end;
1041
1042		{ TIBStringField}
1043
1044	<	constructor TIBStringField.create(AOwner: TComponent);
1044	>	function TIBStringField.GetDefaultWidth: Longint;
1045		begin
1046	<	inherited Create(AOwner);
1046	>	Result := Size div CharacterSetSize;
1047	>	end;
1048	>
1049	>	constructor TIBStringField.Create(aOwner: TComponent);
1050	>	begin
1051	>	inherited Create(aOwner);
1052	>	FCharacterSetSize := 1;
1053	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1054	>	FCodePage := CP_NONE;
1055	>	{$ENDIF}
1056		end;
1057
1058		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 809 | Line 1075 | end;
1075		function TIBStringField.GetValue(var Value: string): Boolean;
1076		var
1077		Buffer: PChar;
1078	+	s: RawByteString;
1079		begin
1080		Buffer := nil;
1081		IBAlloc(Buffer, 0, Size + 1);
#	Line 816 | Line 1083 | begin
1083		Result := GetData(Buffer);
1084		if Result then
1085		begin
1086	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1087	+	s := string(Buffer);
1088	+	SetCodePage(s,CodePage,false);
1089	+	Value := s;
1090	+	//      writeln(FieldName,': ', StringCodePage(Value),', ',Value);
1091	+	{$ELSE}
1092		Value := string(Buffer);
1093	+	{$ENDIF}
1094		if Transliterate and (Value <> '') then
1095		DataSet.Translate(PChar(Value), PChar(Value), False);
1096		end
#	Line 828 | Line 1102 | end;
1102		procedure TIBStringField.SetAsString(const Value: string);
1103		var
1104		Buffer: PChar;
1105	+	s: RawByteString;
1106		begin
1107		Buffer := nil;
1108		IBAlloc(Buffer, 0, Size + 1);
1109		try
1110	<	StrLCopy(Buffer, PChar(Value), Size);
1110	>	s := Value;
1111	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1112	>	if StringCodePage(s) <> CodePage then
1113	>	SetCodePage(s,CodePage,true);
1114	>	{$ENDIF}
1115	>	StrLCopy(Buffer, PChar(s), Size);
1116		if Transliterate then
1117		DataSet.Translate(Buffer, Buffer, True);
1118		SetData(Buffer);
#	Line 841 | Line 1121 | begin
1121		end;
1122		end;
1123
844	–	procedure TIBStringField.SetSize(AValue: Integer);
845	–	var FieldSize: integer;
846	–	begin
847	–	if csLoading in ComponentState then
848	–	FInitialised := true;
849	–	if FInitialised then
850	–	inherited SetSize(AValue)
851	–	else
852	–	begin
853	–	{IBCustomDataSet encodes the CharWidth size in the size}
854	–	FieldSize := AValue div 4;
855	–	inherited SetSize(FieldSize);
856	–	DisplayWidth := FieldSize div ((AValue mod 4) + 1);
857	–	FInitialised := true;
858	–	end;
859	–	end;
1124
1125		{ TIBBCDField }
1126
#	Line 974 | Line 1238 | begin
1238		FQRefresh.GoToFirstRecordOnExecute := False;
1239		FQSelect := TIBSQL.Create(Self);
1240		FQSelect.OnSQLChanging := SQLChanging;
1241	+	FQSelect.OnSQLChanged := SQLChanged;
1242		FQSelect.GoToFirstRecordOnExecute := False;
1243		FQModify := TIBSQL.Create(Self);
1244		FQModify.OnSQLChanging := SQLChanging;
#	Line 1063 | Line 1328 | end;
1328
1329		procedure TIBCustomDataSet.ApplyUpdates;
1330		var
1331	<	{$IF FPC_FULLVERSION >= 20700 }
1331	>	{$IFDEF NEW_TBOOKMARK }
1332		CurBookmark: TBookmark;
1333		{$ELSE}
1334		CurBookmark: string;
#	Line 1798 | Line 2063 | function TIBCustomDataSet.InternalLocate
2063		const KeyValues: Variant; Options: TLocateOptions): Boolean;
2064		var
2065		keyFieldList: TList;
2066	<	{$IF FPC_FULLVERSION >= 20700 }
2066	>	{$IFDEF NEW_TBOOKMARK }
2067		CurBookmark: TBookmark;
2068		{$ELSE}
2069		CurBookmark: string;
#	Line 2057 | Line 2322 | begin
2322		FBase.CheckDatabase;
2323		FBase.CheckTransaction;
2324		if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2325	<	FQSelect.SQL.Text := FParser.SQLText;
2325	>	begin
2326	>	FQSelect.OnSQLChanged := nil; {Do not react to change}
2327	>	try
2328	>	FQSelect.SQL.Text := FParser.SQLText;
2329	>	finally
2330	>	FQSelect.OnSQLChanged := SQLChanged;
2331	>	end;
2332	>	end;
2333		//   writeln( FQSelect.SQL.Text);
2334		if FQSelect.SQL.Text <> '' then
2335		begin
#	Line 2304 | Line 2576 | begin
2576		begin
2577		Disconnect;
2578		FQSelect.SQL.Assign(Value);
2307	–	FBaseSQLSelect.assign(Value);
2579		end;
2580		end;
2581
#	Line 2383 | Line 2654 | begin
2654		FieldDefs.Updated := false;
2655		end;
2656
2657	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2658	+	begin
2659	+	FBaseSQLSelect.assign(FQSelect.SQL);
2660	+	end;
2661	+
2662		{ I can "undelete" uninserted records (make them "inserted" again).
2663		I can "undelete" cached deleted (the deletion hasn't yet occurred) }
2664		procedure TIBCustomDataSet.Undelete;
#	Line 2729 | Line 3005 | end;
3005
3006		procedure TIBCustomDataSet.FetchAll;
3007		var
3008	<	{$IF FPC_FULLVERSION >= 20700 }
3008	>	{$IFDEF NEW_TBOOKMARK }
3009		CurBookmark: TBookmark;
3010		{$ELSE}
3011		CurBookmark: string;
#	Line 3078 | Line 3354 | begin
3354		FreeMem(FOldBufferCache);
3355		FOldBufferCache := nil;
3356		BindFields(False);
3357	+	ResetParser;
3358		if DefaultFields then DestroyFields;
3359		end;
3360
#	Line 3151 | Line 3428 | const
3428		var
3429		FieldType: TFieldType;
3430		FieldSize: Word;
3431	+	charSetID: short;
3432		CharSetSize: integer;
3433	+	CharSetName: RawByteString;
3434	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3435	+	FieldCodePage: TSystemCodePage;
3436	+	{$ENDIF}
3437		FieldNullable : Boolean;
3438		i, FieldPosition, FieldPrecision: Integer;
3439		FieldAliasName, DBAliasName: string;
#	Line 3282 | Line 3564 | begin
3564		FieldSize := 0;
3565		FieldPrecision := 0;
3566		FieldNullable := SourceQuery.Current[i].IsNullable;
3567	+	CharSetSize := 0;
3568	+	CharSetName := '';
3569	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3570	+	FieldCodePage := CP_NONE;
3571	+	{$ENDIF}
3572		case sqltype and not 1 of
3573		{ All VARCHAR's must be converted to strings before recording
3574		their values }
3575		SQL_VARYING, SQL_TEXT:
3576		begin
3577		CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3578	+	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3579	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3580	+	FieldCodePage := FBase.GetCodePage(sqlsubtype and $FF);
3581	+	{$ENDIF}
3582		{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3583	<	FieldSize := sqllen * 4 + (CharSetSize - 1);
3584	<	FieldType := ftString;
3583	>	FieldSize := sqllen;
3584	>	if CharSetSize = 2 then
3585	>	FieldType := ftWideString
3586	>	else
3587	>	FieldType := ftString;
3588		end;
3589		{ All Doubles/Floats should be cast to doubles }
3590		SQL_DOUBLE, SQL_FLOAT:
#	Line 3349 | Line 3643 | begin
3643		begin
3644		FieldSize := sizeof (TISC_QUAD);
3645		if (sqlsubtype = 1) then
3646	<	FieldType := ftmemo
3646	>	begin
3647	>	if FBase.GetDefaultCharSetName <> '' then
3648	>	begin
3649	>	CharSetSize := FBase.GetDefaultCharSetSize;
3650	>	CharSetName := FBase.GetDefaultCharSetName;
3651	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3652	>	FieldCodePage := FBase.GetDefaultCodePage;
3653	>	{$ENDIF}
3654	>	end
3655	>	else
3656	>	if strpas(sqlname) <> '' then
3657	>	begin
3658	>	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3659	>	@relname,@sqlname);
3660	>	CharSetSize := FBase.GetCharSetSize(charSetID);
3661	>	CharSetName := FBase.GetCharSetName(charSetID);
3662	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3663	>	FieldCodePage := FBase.GetCodePage(charSetID);
3664	>	{$ENDIF}
3665	>	end
3666	>	else  {Complex SQL with no identifiable column and no connection default}
3667	>	begin
3668	>	CharSetName := '';
3669	>	CharSetSize := 1;
3670	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3671	>	FieldCodePage := CP_NONE;
3672	>	{$ENDIF}
3673	>	end;
3674	>	if CharSetSize = 2 then
3675	>	FieldType := ftWideMemo
3676	>	else
3677	>	FieldType := ftMemo;
3678	>	end
3679		else
3680		FieldType := ftBlob;
3681		end;
#	Line 3368 | Line 3694 | begin
3694		begin
3695		FMappedFieldPosition[FieldIndex] := FieldPosition;
3696		Inc(FieldIndex);
3697	<	with FieldDefs.AddFieldDef do
3697	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3698		begin
3699		Name := FieldAliasName;
3700		FAliasNameMap[FieldNo-1] := DBAliasName;
3375	–	DataType := FieldType;
3701		Size := FieldSize;
3702		Precision := FieldPrecision;
3703		Required := not FieldNullable;
3704		InternalCalcField := False;
3705	+	CharacterSetSize := CharSetSize;
3706	+	CharacterSetName := CharSetName;
3707	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3708	+	CodePage := FieldCodePage;
3709	+	{$ENDIF}
3710		if (FieldName <> '') and (RelationName <> '') then
3711		begin
3712		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3517 | Line 3847 | procedure TIBCustomDataSet.InternalOpen;
3847		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3848		end;
3849
3850	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3851	+	var i: integer;
3852	+	begin
3853	+	Result := nil;
3854	+	for i := 0 to FieldDefs.Count - 1 do
3855	+	if FieldDefs[i].FieldNo = aFieldNo then
3856	+	begin
3857	+	Result := TIBFieldDef(FieldDefs[i]);
3858	+	break;
3859	+	end;
3860	+	end;
3861	+
3862	+	procedure SetExtendedProperties;
3863	+	var i: integer;
3864	+	IBFieldDef: TIBFieldDef;
3865	+	begin
3866	+	for i := 0 to Fields.Count - 1 do
3867	+	if Fields[i].FieldNo > 0 then
3868	+	begin
3869	+	if(Fields[i] is TIBStringField) then
3870	+	with TIBStringField(Fields[i]) do
3871	+	begin
3872	+	IBFieldDef := GetFieldDef(FieldNo);
3873	+	if IBFieldDef <> nil then
3874	+	begin
3875	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3876	+	CharacterSetName := IBFieldDef.CharacterSetName;
3877	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3878	+	CodePage := IBFieldDef.CodePage;
3879	+	{$ENDIF}
3880	+	end;
3881	+	end
3882	+	else
3883	+	if(Fields[i] is TIBWideStringField) then
3884	+	with TIBWideStringField(Fields[i]) do
3885	+	begin
3886	+	IBFieldDef := GetFieldDef(FieldNo);
3887	+	if IBFieldDef <> nil then
3888	+	begin
3889	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3890	+	CharacterSetName := IBFieldDef.CharacterSetName;
3891	+	end;
3892	+	end
3893	+	else
3894	+	if(Fields[i] is TIBMemoField) then
3895	+	with TIBMemoField(Fields[i]) do
3896	+	begin
3897	+	IBFieldDef := GetFieldDef(FieldNo);
3898	+	if IBFieldDef <> nil then
3899	+	begin
3900	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3901	+	CharacterSetName := IBFieldDef.CharacterSetName;
3902	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
3903	+	CodePage := IBFieldDef.CodePage;
3904	+	{$ENDIF}
3905	+	end;
3906	+	end
3907	+	else
3908	+	if(Fields[i] is TIBWideMemoField) then
3909	+	with TIBWideMemoField(Fields[i]) do
3910	+	begin
3911	+	IBFieldDef := GetFieldDef(FieldNo);
3912	+	if IBFieldDef <> nil then
3913	+	begin
3914	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3915	+	CharacterSetName := IBFieldDef.CharacterSetName;
3916	+	end;
3917	+	end
3918	+	end
3919	+	end;
3920	+
3921		begin
3922		FBase.SetCursor;
3923		try
#	Line 3531 | Line 3932 | begin
3932		if DefaultFields then
3933		CreateFields;
3934		BindFields(True);
3935	+	SetExtendedProperties;
3936		FCurrentRecord := -1;
3937		FQSelect.ExecQuery;
3938		FOpen := FQSelect.Open;
#	Line 3669 | Line 4071 | end;
4071		function TIBCustomDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
4072		Options: TLocateOptions): Boolean;
4073		var
4074	<	{$IF FPC_FULLVERSION >= 20700 }
4074	>	{$IFDEF NEW_TBOOKMARK }
4075		CurBookmark: TBookmark;
4076		{$ELSE}
4077		CurBookmark: string;
#	Line 3691 | Line 4093 | function TIBCustomDataSet.Lookup(const K
4093		const ResultFields: string): Variant;
4094		var
4095		fl: TList;
4096	<	{$IF FPC_FULLVERSION >= 20700 }
4096	>	{$IFDEF NEW_TBOOKMARK }
4097		CurBookmark: TBookmark;
4098		{$ELSE}
4099		CurBookmark: string;
#	Line 3931 | Line 4333 | begin
4333		begin
4334		FParser.Free;
4335		FParser := nil;
4336	<	SQLChanging(nil)
4336	>	FQSelect.OnSQLChanged := nil; {Do not react to change}
4337	>	try
4338	>	FQSelect.SQL.Assign(FBaseSQLSelect);
4339	>	finally
4340	>	FQSelect.OnSQLChanged := SQLChanged;
4341	>	end;
4342		end;
4343		end;
4344
#	Line 4364 | Line 4771 | begin
4771		Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4772		end;
4773
4774	+
4775		end.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines