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 35 by tony, Tue Jan 26 14:38:47 2016 UTC

#	Line 120 | Line 120 | type
120
121		TIBStringField = class(TStringField)
122		private
123	<	FInitialised: boolean;
123	>	FCharacterSetName: string;
124	>	FCharacterSetSize: integer;
125		protected
126	<	procedure SetSize(AValue: Integer); override;
126	>	function GetDefaultWidth: Longint; override;
127		public
128	<	constructor create(AOwner: TComponent); override;
128	>	constructor Create(aOwner: TComponent); override;
129		class procedure CheckTypeSize(Value: Integer); override;
130		function GetAsString: string; override;
131		function GetAsVariant: Variant; override;
132		function GetValue(var Value: string): Boolean;
133		procedure SetAsString(const Value: string); override;
134	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
135	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
136	+	end;
137	+
138	+	{ TIBWideStringField }
139	+
140	+	TIBWideStringField = class(TWideStringField)
141	+	private
142	+	FCharacterSetName: string;
143	+	FCharacterSetSize: integer;
144	+	public
145	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
146	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
147		end;
148
149		{ TIBBCDField }
#	Line 152 | Line 166 | type
166		property Size default 8;
167		end;
168
169	+	{TIBMemoField}
170	+	{Allows us to show truncated text in DBGrids and anything else that uses
171	+	DisplayText}
172	+
173	+	TIBMemoField = class(TMemoField)
174	+	private
175	+	FCharacterSetName: string;
176	+	FCharacterSetSize: integer;
177	+	FDisplayTextAsClassName: boolean;
178	+	function GetTruncatedText: string;
179	+	protected
180	+	function GetDefaultWidth: Longint; override;
181	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
182	+	public
183	+	constructor Create(AOwner: TComponent); override;
184	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
185	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
186	+	published
187	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
188	+	write FDisplayTextAsClassName;
189	+	end;
190	+
191	+	{ TIBWideMemoField }
192	+
193	+	TIBWideMemoField = class(TWideMemoField)
194	+	private
195	+	FCharacterSetName: string;
196	+	FCharacterSetSize: integer;
197	+	FDisplayTextAsClassName: boolean;
198	+	function GetTruncatedText: string;
199	+	protected
200	+	function GetDefaultWidth: Longint; override;
201	+	procedure GetText(var AText: string; ADisplayText: Boolean); override;
202	+	public
203	+	constructor Create(AOwner: TComponent); override;
204	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
205	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
206	+	published
207	+	property DisplayTextAsClassName: boolean read FDisplayTextAsClassName
208	+	write FDisplayTextAsClassName;
209	+	end;
210	+
211		TIBDataLink = class(TDetailDataLink)
212		private
213		FDataSet: TIBCustomDataSet;
#	Line 341 | Line 397 | type
397		procedure SetUpdateRecordTypes(Value: TIBUpdateRecordTypes);
398		procedure SetUniDirectional(Value: Boolean);
399		procedure RefreshParams;
344	–	procedure SQLChanging(Sender: TObject); virtual;
400		function AdjustPosition(FCache: PChar; Offset: DWORD;
401		Origin: Integer): DWORD;
402		procedure ReadCache(FCache: PChar; Offset: DWORD; Origin: Integer;
#	Line 371 | Line 426 | type
426		procedure InternalRefreshRow; virtual;
427		procedure InternalSetParamsFromCursor; virtual;
428		procedure CheckNotUniDirectional;
429	+	procedure SQLChanging(Sender: TObject); virtual;
430	+	procedure SQLChanged(Sender: TObject); virtual;
431
432		(*    { IProviderSupport }
433		procedure PSEndTransaction(Commit: Boolean); override;
#	Line 502 | Line 559 | type
559		procedure RecordModified(Value: Boolean);
560		procedure RevertRecord;
561		procedure Undelete;
562	<	procedure ResetParser;
562	>	procedure ResetParser; virtual;
563		function HasParser: boolean;
564
565		{ TDataSet support methods }
#	Line 690 | Line 747 | DefaultFieldClasses: array[TFieldType] o
747		TVarBytesField,     { ftVarBytes }
748		TAutoIncField,      { ftAutoInc }
749		TBlobField,         { ftBlob }
750	<	TMemoField,         { ftMemo }
750	>	TIBMemoField,       { ftMemo }
751		TGraphicField,      { ftGraphic }
752		TBlobField,         { ftFmtMemo }
753		TBlobField,         { ftParadoxOle }
#	Line 698 | Line 755 | DefaultFieldClasses: array[TFieldType] o
755		TBlobField,         { ftTypedBinary }
756		nil,                { ftCursor }
757		TStringField,       { ftFixedChar }
758	<	TWideStringField,    { ftWideString }
758	>	TIBWideStringField,    { ftWideString }
759		TLargeIntField,     { ftLargeInt }
760		nil,          { ftADT }
761		nil,        { ftArray }
#	Line 713 | Line 770 | DefaultFieldClasses: array[TFieldType] o
770		TDateTimeField,    {ftTimestamp}
771		TIBBCDField,       {ftFMTBcd}
772		nil,  {ftFixedWideChar}
773	<	TWideMemoField);   {ftWideMemo}
773	>	TIBWideMemoField);   {ftWideMemo}
774		(*
775		TADTField,          { ftADT }
776		TArrayField,        { ftArray }
#	Line 730 | Line 787 | DefaultFieldClasses: array[TFieldType] o
787
788		implementation
789
790	<	uses IBIntf, Variants, FmtBCD;
790	>	uses IBIntf, Variants, FmtBCD, LCLProc, LazUTF8;
791
792		const FILE_BEGIN = 0;
793		FILE_CURRENT = 1;
#	Line 753 | Line 810 | type
810		NextRelation : TRelationNode;
811		end;
812
813	+	{Extended Field Def for character set info}
814	+
815	+	{ TIBFieldDef }
816	+
817	+	TIBFieldDef = class(TFieldDef)
818	+	private
819	+	FCharacterSetName: string;
820	+	FCharacterSetSize: integer;
821	+	published
822	+	property CharacterSetName: string read FCharacterSetName write FCharacterSetName;
823	+	property CharacterSetSize: integer read FCharacterSetSize write FCharacterSetSize;
824	+	end;
825	+
826	+	{ TIBWideMemoField }
827	+
828	+	function TIBWideMemoField.GetTruncatedText: string;
829	+	begin
830	+	Result := GetAsString;
831	+
832	+	if Result <> '' then
833	+	if DisplayWidth = 0 then
834	+	Result := TextToSingleLine(Result)
835	+	else
836	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
837	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
838	+	end;
839	+
840	+	function TIBWideMemoField.GetDefaultWidth: Longint;
841	+	begin
842	+	Result := 128;
843	+	end;
844	+
845	+	procedure TIBWideMemoField.GetText(var AText: string; ADisplayText: Boolean);
846	+	begin
847	+	if ADisplayText then
848	+	begin
849	+	if not DisplayTextAsClassName then
850	+	AText := GetTruncatedText
851	+	else
852	+	inherited GetText(AText, ADisplayText);
853	+	end
854	+	else
855	+	AText := GetAsString;
856	+	end;
857	+
858	+	constructor TIBWideMemoField.Create(AOwner: TComponent);
859	+	begin
860	+	inherited Create(AOwner);
861	+	BlobType := ftWideMemo;
862	+	end;
863	+
864	+	{ TIBMemoField }
865	+
866	+	function TIBMemoField.GetTruncatedText: string;
867	+	begin
868	+	Result := GetAsString;
869	+
870	+	if Result <> '' then
871	+	begin
872	+	case CharacterSetSize of
873	+	1:
874	+	if DisplayWidth = 0 then
875	+	Result := TextToSingleLine(Result)
876	+	else
877	+	if Length(Result) > DisplayWidth then {Show truncation with elipses}
878	+	Result := TextToSingleLine(system.copy(Result,1,DisplayWidth-3)) + '...';
879	+
880	+	{2: case 2 ignored. This should be handled by TIBWideMemo}
881	+
882	+	3, {Assume UNICODE_FSS is really UTF8}
883	+	4: {Include GB18030 - assuming UTF8 routine work for this codeset}
884	+	if DisplayWidth = 0 then
885	+	Result := ValidUTF8String(TextToSingleLine(Result))
886	+	else
887	+	if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses}
888	+	Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...';
889	+	end;
890	+	end
891	+	end;
892	+
893	+	function TIBMemoField.GetDefaultWidth: Longint;
894	+	begin
895	+	Result := 128;
896	+	end;
897	+
898	+	procedure TIBMemoField.GetText(var AText: string; ADisplayText: Boolean);
899	+	begin
900	+	if ADisplayText then
901	+	begin
902	+	if not DisplayTextAsClassName then
903	+	AText := GetTruncatedText
904	+	else
905	+	inherited GetText(AText, ADisplayText);
906	+	end
907	+	else
908	+	AText := GetAsString;
909	+	end;
910	+
911	+	constructor TIBMemoField.Create(AOwner: TComponent);
912	+	begin
913	+	inherited Create(AOwner);
914	+	BlobType := ftMemo;
915	+	end;
916	+
917		{ TIBControlLink }
918
919		destructor TIBControlLink.Destroy;
#	Line 784 | Line 945 | end;
945
946		{ TIBStringField}
947
948	<	constructor TIBStringField.create(AOwner: TComponent);
948	>	function TIBStringField.GetDefaultWidth: Longint;
949		begin
950	<	inherited Create(AOwner);
950	>	Result := Size div CharacterSetSize;
951	>	end;
952	>
953	>	constructor TIBStringField.Create(aOwner: TComponent);
954	>	begin
955	>	inherited Create(aOwner);
956	>	FCharacterSetSize := 1;
957		end;
958
959		class procedure TIBStringField.CheckTypeSize(Value: Integer);
#	Line 841 | Line 1008 | begin
1008		end;
1009		end;
1010
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;
1011
1012		{ TIBBCDField }
1013
#	Line 974 | Line 1125 | begin
1125		FQRefresh.GoToFirstRecordOnExecute := False;
1126		FQSelect := TIBSQL.Create(Self);
1127		FQSelect.OnSQLChanging := SQLChanging;
1128	+	FQSelect.OnSQLChanged := SQLChanged;
1129		FQSelect.GoToFirstRecordOnExecute := False;
1130		FQModify := TIBSQL.Create(Self);
1131		FQModify.OnSQLChanging := SQLChanging;
#	Line 2057 | Line 2209 | begin
2209		FBase.CheckDatabase;
2210		FBase.CheckTransaction;
2211		if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then
2212	<	FQSelect.SQL.Text := FParser.SQLText;
2212	>	begin
2213	>	FQSelect.OnSQLChanged := nil; {Do not react to change}
2214	>	try
2215	>	FQSelect.SQL.Text := FParser.SQLText;
2216	>	finally
2217	>	FQSelect.OnSQLChanged := SQLChanged;
2218	>	end;
2219	>	end;
2220		//   writeln( FQSelect.SQL.Text);
2221		if FQSelect.SQL.Text <> '' then
2222		begin
#	Line 2304 | Line 2463 | begin
2463		begin
2464		Disconnect;
2465		FQSelect.SQL.Assign(Value);
2307	–	FBaseSQLSelect.assign(Value);
2466		end;
2467		end;
2468
#	Line 2383 | Line 2541 | begin
2541		FieldDefs.Updated := false;
2542		end;
2543
2544	+	procedure TIBCustomDataSet.SQLChanged(Sender: TObject);
2545	+	begin
2546	+	FBaseSQLSelect.assign(FQSelect.SQL);
2547	+	end;
2548	+
2549		{ I can "undelete" uninserted records (make them "inserted" again).
2550		I can "undelete" cached deleted (the deletion hasn't yet occurred) }
2551		procedure TIBCustomDataSet.Undelete;
#	Line 3078 | Line 3241 | begin
3241		FreeMem(FOldBufferCache);
3242		FOldBufferCache := nil;
3243		BindFields(False);
3244	+	ResetParser;
3245		if DefaultFields then DestroyFields;
3246		end;
3247
#	Line 3151 | Line 3315 | const
3315		var
3316		FieldType: TFieldType;
3317		FieldSize: Word;
3318	+	charSetID: short;
3319		CharSetSize: integer;
3320	+	CharSetName: string;
3321		FieldNullable : Boolean;
3322		i, FieldPosition, FieldPrecision: Integer;
3323		FieldAliasName, DBAliasName: string;
#	Line 3282 | Line 3448 | begin
3448		FieldSize := 0;
3449		FieldPrecision := 0;
3450		FieldNullable := SourceQuery.Current[i].IsNullable;
3451	+	CharSetSize := 0;
3452	+	CharSetName := '';
3453		case sqltype and not 1 of
3454		{ All VARCHAR's must be converted to strings before recording
3455		their values }
3456		SQL_VARYING, SQL_TEXT:
3457		begin
3458		CharSetSize := FBase.GetCharSetSize(sqlsubtype and $FF);
3459	+	CharSetName := FBase.GetCharSetName(sqlsubtype and $FF);
3460		{FieldSize is encoded for strings - see TIBStringField.SetSize for decode}
3461	<	FieldSize := sqllen * 4 + (CharSetSize - 1);
3462	<	FieldType := ftString;
3461	>	FieldSize := sqllen;
3462	>	if CharSetSize = 2 then
3463	>	FieldType := ftWideString
3464	>	else
3465	>	FieldType := ftString;
3466		end;
3467		{ All Doubles/Floats should be cast to doubles }
3468		SQL_DOUBLE, SQL_FLOAT:
#	Line 3349 | Line 3521 | begin
3521		begin
3522		FieldSize := sizeof (TISC_QUAD);
3523		if (sqlsubtype = 1) then
3524	<	FieldType := ftmemo
3524	>	begin
3525	>	if strpas(sqlname) = '' then {Complex SQL with no identifiable column - use connection default}
3526	>	begin
3527	>	CharSetSize := FBase.GetDefaultCharSetSize;
3528	>	CharSetName := FBase.GetDefaultCharSetName;
3529	>	end
3530	>	else
3531	>	begin
3532	>	charSetID := GetBlobCharSetID(Database.Handle,Database.InternalTransaction.Handle,
3533	>	@relname,@sqlname);
3534	>	CharSetSize := FBase.GetCharSetSize(charSetID);
3535	>	CharSetName := FBase.GetCharSetName(charSetID);
3536	>	end;
3537	>	if CharSetSize = 2 then
3538	>	FieldType := ftWideMemo
3539	>	else
3540	>	FieldType := ftMemo;
3541	>	end
3542		else
3543		FieldType := ftBlob;
3544		end;
#	Line 3368 | Line 3557 | begin
3557		begin
3558		FMappedFieldPosition[FieldIndex] := FieldPosition;
3559		Inc(FieldIndex);
3560	<	with FieldDefs.AddFieldDef do
3560	>	with TIBFieldDef.Create(FieldDefs,'',FieldType,0,False,FieldDefs.Count+1) do
3561		begin
3562		Name := FieldAliasName;
3563		FAliasNameMap[FieldNo-1] := DBAliasName;
3375	–	DataType := FieldType;
3564		Size := FieldSize;
3565		Precision := FieldPrecision;
3566		Required := not FieldNullable;
3567		InternalCalcField := False;
3568	+	CharacterSetSize := CharSetSize;
3569	+	CharacterSetName := CharSetName;
3570		if (FieldName <> '') and (RelationName <> '') then
3571		begin
3572		if Has_COMPUTED_BLR(RelationName, FieldName) then
#	Line 3517 | Line 3707 | procedure TIBCustomDataSet.InternalOpen;
3707		result := SizeOf(TRecordData) + ((n - 1) * SizeOf(TFieldData));
3708		end;
3709
3710	+	function GetFieldDef(aFieldNo: integer): TIBFieldDef;
3711	+	var i: integer;
3712	+	begin
3713	+	Result := nil;
3714	+	for i := 0 to FieldDefs.Count - 1 do
3715	+	if FieldDefs[i].FieldNo = aFieldNo then
3716	+	begin
3717	+	Result := TIBFieldDef(FieldDefs[i]);
3718	+	break;
3719	+	end;
3720	+	end;
3721	+
3722	+	procedure SetExtendedProperties;
3723	+	var i: integer;
3724	+	IBFieldDef: TIBFieldDef;
3725	+	begin
3726	+	for i := 0 to Fields.Count - 1 do
3727	+	if Fields[i].FieldNo > 0 then
3728	+	begin
3729	+	if(Fields[i] is TIBStringField) then
3730	+	with TIBStringField(Fields[i]) do
3731	+	begin
3732	+	IBFieldDef := GetFieldDef(FieldNo);
3733	+	if IBFieldDef <> nil then
3734	+	begin
3735	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3736	+	CharacterSetName := IBFieldDef.CharacterSetName;
3737	+	end;
3738	+	end
3739	+	else
3740	+	if(Fields[i] is TIBWideStringField) then
3741	+	with TIBWideStringField(Fields[i]) do
3742	+	begin
3743	+	IBFieldDef := GetFieldDef(FieldNo);
3744	+	if IBFieldDef <> nil then
3745	+	begin
3746	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3747	+	CharacterSetName := IBFieldDef.CharacterSetName;
3748	+	end;
3749	+	end
3750	+	else
3751	+	if(Fields[i] is TIBMemoField) then
3752	+	with TIBMemoField(Fields[i]) do
3753	+	begin
3754	+	IBFieldDef := GetFieldDef(FieldNo);
3755	+	if IBFieldDef <> nil then
3756	+	begin
3757	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3758	+	CharacterSetName := IBFieldDef.CharacterSetName;
3759	+	end;
3760	+	end
3761	+	else
3762	+	if(Fields[i] is TIBWideMemoField) then
3763	+	with TIBWideMemoField(Fields[i]) do
3764	+	begin
3765	+	IBFieldDef := GetFieldDef(FieldNo);
3766	+	if IBFieldDef <> nil then
3767	+	begin
3768	+	CharacterSetSize := IBFieldDef.CharacterSetSize;
3769	+	CharacterSetName := IBFieldDef.CharacterSetName;
3770	+	end;
3771	+	end
3772	+	end
3773	+	end;
3774	+
3775		begin
3776		FBase.SetCursor;
3777		try
#	Line 3531 | Line 3786 | begin
3786		if DefaultFields then
3787		CreateFields;
3788		BindFields(True);
3789	+	SetExtendedProperties;
3790		FCurrentRecord := -1;
3791		FQSelect.ExecQuery;
3792		FOpen := FQSelect.Open;
#	Line 3931 | Line 4187 | begin
4187		begin
4188		FParser.Free;
4189		FParser := nil;
4190	<	SQLChanging(nil)
4190	>	FQSelect.OnSQLChanged := nil; {Do not react to change}
4191	>	try
4192	>	FQSelect.SQL.Assign(FBaseSQLSelect);
4193	>	finally
4194	>	FQSelect.OnSQLChanged := SQLChanged;
4195	>	end;
4196		end;
4197		end;
4198
#	Line 4364 | Line 4625 | begin
4625		Owner.FieldByName(FFieldName).AsInteger := GetNextValue(Owner.Database,Owner.Transaction);
4626		end;
4627
4628	+
4629		end.

Diff Legend

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