ViewVC Help

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

root/public/ibx/trunk/design/IBDBReg.pas

Comparing ibx/trunk/design/IBDBReg.pas (file contents):
Revision 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC

#	Line 54 | Line 54 | unit IBDBReg;
54
55		interface
56
57	<	uses {Windows,} SysUtils, Classes, Graphics, Dialogs, Controls, Forms, TypInfo,
57	>	uses SysUtils, Classes, Graphics, Dialogs, Controls, Forms, TypInfo,
58		DB, IBTable, IBDatabase,  IBEventsEditor,  LazarusPackageIntf,
59	<	IBUpdateSQL, IBXConst, ComponentEditors, PropEdits, DBPropEdits, FieldsEditor;
59	>	IBUpdateSQL, IBXConst, ComponentEditors, PropEdits, DBPropEdits, FieldsEditor,
60	>	dbFieldLinkPropEditor, dbFieldListPropEditor, IBDialogs;
61
62		type
63
#	Line 92 | Line 93 | type
93		procedure GetValues(Proc: TGetStrProc); override;
94		end;
95
96	+	{ TDBStringProperty }
97	+
98		TDBStringProperty = class(TStringProperty)
99	+	private
100	+	function ConnecttoDB: boolean;
101		public
102		function GetAttributes: TPropertyAttributes; override;
103		procedure GetValueList(List: TStrings); virtual;
104		procedure GetValues(Proc: TGetStrProc); override;
105	+	procedure Edit; override;
106		end;
107
108	+	{ TIBIndexFieldNamesProperty }
109	+
110		TIBIndexFieldNamesProperty = class(TDBStringProperty)
111		public
112		procedure GetValueList(List: TStrings); override;
#	Line 184 | Line 192 | type
192		public
193		procedure Edit; override;
194		end;
195	<	(*
195	>
196	>	{ TIBTableFieldLinkProperty }
197	>
198		TIBTableFieldLinkProperty = class(TFieldLinkProperty)
199		private
200		FTable: TIBTable;
201		protected
202	+	function GetIndexDefs: TIndexDefs; override;
203		function GetIndexFieldNames: string; override;
204		function GetMasterFields: string; override;
205		procedure SetIndexFieldNames(const Value: string); override;
#	Line 196 | Line 207 | type
207		public
208		procedure Edit; override;
209		end;
210	<	*)
210	>
211		{ TSQLPropertyEditor }
212
213		TSQLPropertyEditor = class(TStringsPropertyEditor)
#	Line 314 | Line 325 | type
325		procedure Edit; override;
326		end;
327
328	+	{ TDBDynamicGridFieldProperty }
329	+
330	+	TDBDynamicGridFieldProperty = class(TFieldProperty)
331	+	public
332	+	procedure FillValues(const Values: TStringList); override;
333	+	end;
334	+
335	+	{ TDBLookupPropertiesGridFieldProperty }
336	+
337	+	TDBLookupPropertiesGridFieldProperty = class(TFieldProperty)
338	+	public
339	+	procedure FillValues(const Values: TStringList); override;
340	+	end;
341	+
342	+	{ TIBTreeViewFieldProperty }
343	+
344	+	TIBTreeViewFieldProperty = class(TFieldProperty)
345	+	public
346	+	procedure FillValues(const Values: TStringList); override;
347	+	end;
348	+
349	+	{ TIBDynamicGridIndexNamesProperty }
350	+
351	+	TIBDynamicGridIndexNamesProperty = class(TIndexFieldNamesProperty)
352	+	protected
353	+	function GetFieldDefs: TFieldDefs; override;
354	+	function GetIndexFieldNames: string; override;
355	+	procedure SetIndexFieldNames(const Value: string); override;
356	+	end;
357	+
358	+
359	+
360		procedure Register;
361
362		implementation
#	Line 321 | Line 364 | implementation
364		uses IB, IBQuery, IBStoredProc, IBCustomDataSet,
365		IBIntf, IBSQL, IBSQLMonitor, IBDatabaseInfo, IBEvents,
366		IBServices, IBDatabaseEdit, IBTransactionEdit,
367	<	IBBatchMove, DBLoginDlg, IBExtract,LResources, IBSelectSQLEditor,
367	>	IBBatchMove, IBExtract,LResources, IBSelectSQLEditor,
368		IBModifySQLEditor,IBDeleteSQLEditor,IBRefreshSQLEditor,
369		IBInsertSQLEditor, IBGeneratorEditor, IBUpdateSQLEditor, IBDataSetEditor,
370	<	IBSQLEditor, ibserviceeditor;
370	>	IBSQLEditor, ibserviceeditor, LCLVersion, IBDynamicGrid, IBLookupComboEditBox,
371	>	IBTreeView, DBControlGrid;
372
373
374
375		procedure Register;
376		begin
377	<	if not TryIBLoad then Exit;
377	>	if not TryIBLoad then
378	>	begin
379	>	MessageDlg('IBX is unable to locate the Firebird Library - have you remembered to install it?',mtError,[mbOK],0);
380	>	Exit;
381	>	end;
382
383		RegisterNoIcon([TIBStringField, TIBBCDField]);
384	+	{$if lcl_fullversion < 01010000}
385	+	{see http://bugs.freepascal.org/view.php?id=19035 }
386		RegisterNoIcon([TIntegerField]);
387	+	{$endif}
388		RegisterComponents(IBPalette1, [ TIBQuery, TIBDataSet,
389		TIBDatabase, TIBTransaction, TIBUpdateSQL, TIBEvents,
390		TIBSQL, TIBDatabaseInfo, TIBSQLMonitor,
#	Line 342 | Line 393 | begin
393		RegisterComponents(IBPalette2, [TIBConfigService, TIBBackupService,
394		TIBRestoreService, TIBValidationService, TIBStatisticalService,
395		TIBLogService, TIBSecurityService, TIBServerProperties]);
396	+
397	+
398	+	RegisterComponents(IBPalette3,[TIBLookupComboEditBox,TIBDynamicGrid,TIBTreeView,TDBControlGrid]);
399		RegisterPropertyEditor(TypeInfo(TIBFileName), TIBDatabase, 'DatabaseName', TIBFileNameProperty); {do not localize}
400		RegisterPropertyEditor(TypeInfo(string), TIBStoredProc, 'StoredProcName', TIBStoredProcNameProperty); {do not localize}
401		RegisterPropertyEditor(TypeInfo(TParams), TIBStoredProc, 'Params', TIBStoredProcParamsProperty);
402		RegisterPropertyEditor(TypeInfo(string), TIBTable, 'TableName', TIBTableNameProperty); {do not localize}
403		RegisterPropertyEditor(TypeInfo(string), TIBTable, 'IndexName', TIBIndexNameProperty); {do not localize}
404		RegisterPropertyEditor(TypeInfo(string), TIBTable, 'IndexFieldNames', TIBIndexFieldNamesProperty); {do not localize}
405	<	//  RegisterPropertyEditor(TypeInfo(string), TIBTable, 'MasterFields', TIBTableFieldLinkProperty); {do not localize}
405	>	RegisterPropertyEditor(TypeInfo(string), TIBTable, 'MasterFields', TIBTableFieldLinkProperty); {do not localize}
406		RegisterPropertyEditor(TypeInfo(TStrings), TIBQuery, 'SQL', TIBQuerySQLProperty); {do not localize}
407		RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'SelectSQL', TIBDatasetSQLProperty); {do not localize}
408		RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'ModifySQL', TIBUpdateSQLProperty); {do not localize}
#	Line 372 | Line 426 | begin
426		RegisterComponentEditor(TIBStoredProc, TIBStoredProcEditor);
427		RegisterComponentEditor(TIBSQL, TIBSQLEditor);
428		RegisterComponentEditor(TIBCustomService, TIBServiceEditor);
429	+
430	+
431	+	{Firebird Data Access Controls}
432	+	RegisterPropertyEditor(TypeInfo(string), TDBLookupProperties, 'KeyField', TDBDynamicGridFieldProperty);
433	+	RegisterPropertyEditor(TypeInfo(string), TDBLookupProperties, 'ListField', TDBDynamicGridFieldProperty);
434	+	RegisterPropertyEditor(TypeInfo(string), TIBDynamicGrid, 'IndexFieldNames', TIBDynamicGridIndexNamesProperty);
435	+	RegisterPropertyEditor(TypeInfo(string), TDBLookupProperties, 'DataFieldName', TDBLookupPropertiesGridFieldProperty);
436	+	RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'KeyField', TIBTreeViewFieldProperty);
437	+	RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'TextField', TIBTreeViewFieldProperty);
438	+	RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'ParentField', TIBTreeViewFieldProperty);
439	+	RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'HasChildField', TIBTreeViewFieldProperty);
440	+
441	+	end;
442	+
443	+	procedure LoadDataSourceFields(DataSource: TDataSource; List: TStrings);
444	+	var
445	+	DataSet: TDataSet;
446	+	i: Integer;
447	+	begin
448	+	if Assigned(DataSource) then
449	+	begin
450	+	DataSet := DataSource.DataSet;
451	+	if Assigned(DataSet) then
452	+	begin
453	+	if DataSet.Fields.Count > 0 then
454	+	DataSet.GetFieldNames(List)
455	+	else
456	+	begin
457	+	DataSet.FieldDefs.Update;
458	+	for i := 0 to DataSet.FieldDefs.Count - 1 do
459	+	List.Add(DataSet.FieldDefs[i].Name);
460	+	end;
461	+	end;
462	+	end;
463	+	end;
464	+
465	+	{ TDBLookupPropertiesGridFieldProperty }
466	+
467	+	procedure TDBLookupPropertiesGridFieldProperty.FillValues(
468	+	const Values: TStringList);
469	+	var
470	+	P: TDBLookupProperties;
471	+	begin
472	+	P :=TDBLookupProperties(GetComponent(0));
473	+	if not (P is TDBLookupProperties) then exit;
474	+	LoadDataSourceFields(TIBDynamicGrid(P.Owner.Grid).DataSource, Values);
475	+	end;
476	+
477	+	{ TIBTreeViewFieldProperty }
478	+
479	+	procedure TIBTreeViewFieldProperty.FillValues(const Values: TStringList);
480	+	var ListSource: TDataSource;
481	+	begin
482	+	ListSource :=  TIBTreeView(GetComponent(0)).DataSource;
483	+	LoadDataSourceFields(ListSource, Values);
484	+	end;
485	+
486	+	{ TIBDynamicGridIndexNamesProperty }
487	+
488	+	function TIBDynamicGridIndexNamesProperty.GetFieldDefs: TFieldDefs;
489	+	var Grid: TIBDynamicGrid;
490	+	begin
491	+	Result := nil;
492	+	Grid := TIBDynamicGrid(GetComponent(0));
493	+	if assigned(Grid.DataSource) and assigned(Grid.DataSource.DataSet) then
494	+	Result := Grid.DataSource.DataSet.FieldDefs
495	+	end;
496	+
497	+	function TIBDynamicGridIndexNamesProperty.GetIndexFieldNames: string;
498	+	var Grid: TIBDynamicGrid;
499	+	begin
500	+	Grid := TIBDynamicGrid(GetComponent(0));
501	+	Result := Grid.IndexFieldNames
502	+	end;
503	+
504	+	procedure TIBDynamicGridIndexNamesProperty.SetIndexFieldNames(
505	+	const Value: string);
506	+	var Grid: TIBDynamicGrid;
507	+	begin
508	+	Grid := TIBDynamicGrid(GetComponent(0));
509	+	Grid.IndexFieldNames := Value
510	+	end;
511	+
512	+	{ TDBDynamicGridFieldProperty }
513	+
514	+	procedure TDBDynamicGridFieldProperty.FillValues(const Values: TStringList);
515	+	var
516	+	P: TDBLookupProperties;
517	+	begin
518	+	P :=TDBLookupProperties(GetComponent(0));
519	+	if not (P is TDBLookupProperties) then exit;
520	+	LoadDataSourceFields(P.ListSource, Values);
521		end;
522
523		{ TIBServiceEditor }
#	Line 456 | Line 602 | end;
602
603		procedure TIBTableNameProperty.GetValues(Proc: TGetStrProc);
604		var
605	<	TableName : TIBTable;
605	>	Table : TIBTable;
606		i : integer;
607		begin
608	<	TableName := GetComponent(0) as TIBTable;
609	<	with TableName do
608	>	Table := GetComponent(0) as TIBTable;
609	>	if Table.Database = nil then
610	>	Exit;
611	>	with Table do
612		for I := 0 to TableNames.Count - 1 do
613		Proc (TableNames[i]);
614		end;
615
616		{ TDBStringProperty }
617
618	+	function TDBStringProperty.ConnecttoDB: boolean;
619	+	var DataSet: TIBCustomDataSet;
620	+	begin
621	+	Result := false;
622	+	DataSet := (GetComponent(0) as TIBCustomDataSet);
623	+	if assigned(Dataset.Database) then
624	+	begin
625	+	try
626	+	DataSet.Database.Connected := true;
627	+	except on E: Exception do
628	+	ShowMessage(E.Message)
629	+	end;
630	+	Result := DataSet.Database.Connected
631	+	end;
632	+	end;
633	+
634		function TDBStringProperty.GetAttributes: TPropertyAttributes;
635		begin
636		Result := [paValueList, paSortList, paMultiSelect];
#	Line 481 | Line 645 | var
645		I: Integer;
646		Values: TStringList;
647		begin
648	+	if not ConnecttoDB then Exit;
649		Values := TStringList.Create;
650		try
651		GetValueList(Values);
#	Line 490 | Line 655 | begin
655		end;
656		end;
657
658	+	procedure TDBStringProperty.Edit;
659	+	begin
660	+	if ConnecttoDB then
661	+	inherited Edit;
662	+	end;
663	+
664		{ Utility Functions }
665
666		function GetPropertyValue(Instance: TPersistent; const PropName: string): TPersistent;
#	Line 551 | Line 722 | var
722		Query: TIBQuery;
723		begin
724		Query := GetComponent(0) as TIBQuery;
725	<	if IBSelectSQLEditor.EditSQL(Query.Database,Query.SQL) then Modified;
725	>	if IBSelectSQLEditor.EditSQL(Query,Query.SQL) then Modified;
726		end;
727
728		{ TIBDatasetSQLProperty }
#	Line 561 | Line 732 | var
732		IBDataset: TIBDataset;
733		begin
734		IBDataset := GetComponent(0) as TIBDataset;
735	<	if IBSelectSQLEditor.EditSQL(IBDataSet.Database,IBDataSet.SelectSQL) then Modified;
735	>	if IBSelectSQLEditor.EditSQL(IBDataSet,IBDataSet.SelectSQL) then Modified;
736		end;
737
738		{ TIBSQLProperty }
#	Line 571 | Line 742 | var
742		IBSQL: TIBSQL;
743		begin
744		IBSQL := GetComponent(0) as TIBSQL;
745	<	if IBSelectSQLEditor.EditSQL(IBSQL.Database,IBSQL.SQL) then Modified;
745	>	if IBSQLEditor.EditIBSQL(IBSQL) then Modified;
746		end;
747
748		{ TIBUpdateSQLEditor }
#	Line 724 | Line 895 | begin
895		Dec(Index, inherited GetVerbCount);
896		case Index of
897		0: Query.ExecSQL;
898	<	1: if ibselectsqleditor.EditSQL(Query.Database,Query.SQL) then Designer.Modified;
898	>	1: if ibselectsqleditor.EditSQL(Query,Query.SQL) then Designer.Modified;
899		end;
900		end;
901		end;
#	Line 794 | Line 965 | begin
965		end;
966		inherited Edit;
967		end;
968	<	(*
968	>
969		{ TIBTableFieldLinkProperty }
970
971		procedure TIBTableFieldLinkProperty.Edit;
972		begin
973		FTable := DataSet as TIBTable;
974	+	if assigned(FTable.Database) then
975	+	FTable.Database.Connected := true;
976		inherited Edit;
977		end;
978
979	+	function TIBTableFieldLinkProperty.GetIndexDefs: TIndexDefs;
980	+	begin
981	+	Result :=  FTable.IndexDefs
982	+	end;
983	+
984		function TIBTableFieldLinkProperty.GetIndexFieldNames: string;
985		begin
986		Result := FTable.IndexFieldNames;
#	Line 821 | Line 999 | end;
999		procedure TIBTableFieldLinkProperty.SetMasterFields(const Value: string);
1000		begin
1001		FTable.MasterFields := Value;
1002	<	end;*)
1002	>	end;
1003
1004		{ TIBUpdateSQLProperty }
1005
#	Line 830 | Line 1008 | var
1008		IBDataset: TIBDataset;
1009		begin
1010		IBDataset := GetComponent(0) as TIBDataset;
1011	<	if IBModifySQLEditor.EditSQL(IBDataSet.Database,IBDataSet.ModifySQL) then Modified;
1011	>	if IBModifySQLEditor.EditSQL(IBDataSet,IBDataSet.ModifySQL) then Modified;
1012		end;
1013
1014		{ TIBUpdateSQLUpdateProperty }
#	Line 838 | Line 1016 | end;
1016		procedure TIBUpdateSQLUpdateProperty.Edit;
1017		begin
1018		GetObjects;
1019	<	if IBModifySQLEditor.EditSQL(FDatabase,FIBUpdateSQL.ModifySQL) then Modified;
1019	>	if IBModifySQLEditor.EditSQL(FIBUpdateSQL.DataSet,FIBUpdateSQL.ModifySQL) then Modified;
1020		end;
1021
1022		{ TIBRefreshSQLProperty }
#	Line 849 | Line 1027 | var
1027		aDatabase: TIBDatabase;
1028		begin
1029		IBDataset := GetComponent(0) as TIBDataset;
1030	<	if IBRefreshSQLEditor.EditSQL(IBDataSet.Database,IBDataSet.RefreshSQL) then Modified;
1030	>	if IBRefreshSQLEditor.EditSQL(IBDataSet,IBDataSet.RefreshSQL) then Modified;
1031		end;
1032
1033		{ TIBUpdateSQLRefreshSQLProperty }
#	Line 857 | Line 1035 | end;
1035		procedure TIBUpdateSQLRefreshSQLProperty.Edit;
1036		begin
1037		GetObjects;
1038	<	if IBRefreshSQLEditor.EditSQL(FDatabase,FIBUpdateSQL.RefreshSQL) then Modified;
1038	>	if IBRefreshSQLEditor.EditSQL(FIBUpdateSQL.DataSet,FIBUpdateSQL.RefreshSQL) then Modified;
1039		end;
1040
1041		{ TIBDeleteSQLProperty }
1042
1043		procedure TIBDeleteSQLProperty.Edit;
1044		var
1045	<	IBDataset: TIBDataset;
1045	>	IBDataset: TIBDataSet;
1046		begin
1047	<	IBDataset := GetComponent(0) as TIBDataset;
1048	<	if IBDeleteSQLEditor.EditSQL(IBDataSet.Database,IBDataSet.DeleteSQL) then Modified;
1047	>	IBDataset := GetComponent(0) as TIBDataSet;
1048	>	if IBDeleteSQLEditor.EditSQL(IBDataSet,IBDataSet.DeleteSQL) then Modified;
1049		end;
1050
1051		{ TIBUpdateSQLDeleteProperty }
#	Line 880 | Line 1058 | end;
1058		procedure TIBUpdateSQLDeleteProperty.Edit;
1059		begin
1060		GetObjects;
1061	<	if IBDeleteSQLEditor.EditSQL(FDatabase,FIBUpdateSQL.DeleteSQL) then Modified;
1061	>	if IBDeleteSQLEditor.EditSQL(FIBUpdateSQL.DataSet,FIBUpdateSQL.DeleteSQL) then Modified;
1062		end;
1063
1064		{ TUpdateSQLPropertyEditor }
#	Line 903 | Line 1081 | end;
1081
1082		procedure TIBInsertSQLProperty.Edit;
1083		var
1084	<	IBDataset: TIBDataset;
1084	>	IBDataset: TIBDataSet;
1085		begin
1086	<	IBDataset := GetComponent(0) as TIBDataset;
1087	<	if IBInsertSQLEditor.EditSQL(IBDataSet.Database,IBDataSet.InsertSQL) then Modified;
1086	>	IBDataset := GetComponent(0) as TIBDataSet;
1087	>	if IBInsertSQLEditor.EditSQL(IBDataSet,IBDataSet.InsertSQL) then Modified;
1088		end;
1089
1090		{ TIBUpdateSQLInsertSQLProperty }
#	Line 914 | Line 1092 | end;
1092		procedure TIBUpdateSQLInsertSQLProperty.Edit;
1093		begin
1094		GetObjects;
1095	<	if IBInsertSQLEditor.EditSQL(FDatabase,FIBUpdateSQL.InsertSQL) then Modified;
1095	>	if IBInsertSQLEditor.EditSQL(FIBUpdateSQL.Dataset,FIBUpdateSQL.InsertSQL) then Modified;
1096		end;
1097
1098		{ TIBGeneratorProperty }

Diff Legend

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