ViewVC Help

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

root/public/ibx/branches/journaling/ibcontrols/IBTreeView.pas

Comparing ibx/trunk/ibcontrols/IBTreeView.pas (file contents):
Revision 23 by tony, Fri Mar 13 10:26:52 2015 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 31 | Line 31 | interface
31
32		uses
33		Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
34	<	DB, IBSQLParser;
34	>	DB, IBSQLParser, IBCustomDataSet;
35
36		type
37		{
#	Line 52 | Line 52 | type
52		FOwner: TIBTreeView;
53		protected
54		procedure ActiveChanged; override;
55	–	procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
55		procedure DataSetChanged; override;
56		procedure RecordChanged(Field: TField); override;
57		procedure UpdateData; override;
#	Line 60 | Line 59 | type
59		constructor Create(AOwner: TIBTreeView);
60		end;
61
62	+	{ TIBTreeViewControlLink }
63	+
64	+	TIBTreeViewControlLink = class(TIBControlLink)
65	+	private
66	+	FOwner: TIBTreeView;
67	+	protected
68	+	procedure UpdateSQL(Sender: TObject); override;
69	+	procedure UpdateParams(Sender: TObject); override;
70	+	public
71	+	constructor Create(AOwner: TIBTreeView);
72	+	end;
73	+
74		{ TIBTreeNode }
75
76		TIBTreeNode = class(TTreeNode)
77		private
78		FKeyValue: variant;
79		public
80	+	constructor Create(AnOwner: TTreeNodes); override;
81		procedure DeleteAll;
82		property KeyValue: variant read FKeyValue;
83		end;
#	Line 74 | Line 86 | type
86		private
87		{ Private declarations }
88		FDataLink: TIBTreeViewDatalink;
89	+	FIBTreeViewControlLink: TIBTreeViewControlLink;
90		FHasChildField: string;
91	+	FImageIndexField: string;
92		FKeyField: string;
93	+	FSelectedIndexField: string;
94		FTextField: string;
95		FParentField: string;
96		FExpandNode: TTreeNode;
#	Line 93 | Line 108 | type
108		function GetDataSource: TDataSource;
109		function GetRelationNameQualifier: string;
110		function GetSelectedKeyValue: variant;
111	+	procedure IBControlLinkChanged;
112		procedure NodeMoved(Node: TTreeNode);
113		procedure NodeUpdated(Node: TTreeNode);
114		procedure RecordChanged(Sender: TObject; Field: TField);
115		procedure SetHasChildField(AValue: string);
116	+	procedure SetImageIndexField(AValue: string);
117		procedure SetKeyField(AValue: string);
118	+	procedure SetSelectedIndexField(AValue: string);
119		procedure SetTextField(AValue: string);
120		procedure SetDataSource(AValue: TDataSource);
121		procedure SetParentField(AValue: string);
#	Line 121 | Line 139 | type
139		{ Public declarations }
140		constructor Create(TheComponent: TComponent); override;
141		destructor Destroy; override;
142	<	function FindNode(KeyValuePath: array of variant; SelectNode: boolean): TIBTreeNode; overload;
142	>	function FindNode(KeyValuePath: TVariantArray; SelectNode: boolean): TIBTreeNode; overload;
143		function FindNode(KeyValue: variant): TIBTreeNode; overload;
144		function GetNodePath(Node: TTreeNode): TVariantArray;
145		property DataSet: TDataSet read GetDataSet;
#	Line 153 | Line 171 | type
171		property Images;
172		property Indent;
173		property HasChildField: string read FHasChildField write SetHasChildField;
174	+	property ImageIndexField: string read FImageIndexField write SetImageIndexField;
175	+	property SelectedIndexField: string read FSelectedIndexField write SetSelectedIndexField;
176		property KeyField: string read FKeyField write SetKeyField;
177		property MultiSelect;
178		property MultiSelectStyle;
#	Line 232 | Line 252 | type
252
253		implementation
254
255	<	uses IBQuery,IBCustomDataSet, Variants;
255	>	uses IBQuery,Variants;
256
257		function StrIntListToVar(s: string): TVariantArray;
258		var i, idx: integer;
#	Line 268 | Line 288 | begin
288		raise Exception.Create('Ordinal Type Expected when converting to integer string');
289		end;
290
291	+	{ TIBTreeViewControlLink }
292	+
293	+	constructor TIBTreeViewControlLink.Create(AOwner: TIBTreeView);
294	+	begin
295	+	inherited Create;
296	+	FOwner := AOwner;
297	+	end;
298	+
299	+	procedure TIBTreeViewControlLink.UpdateParams(Sender: TObject);
300	+	begin
301	+	FOwner.UpdateParams(self,TIBParserDataSet(Sender).Parser)
302	+	end;
303	+
304	+	procedure TIBTreeViewControlLink.UpdateSQL(Sender: TObject);
305	+	begin
306	+	FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
307	+	end;
308	+
309		{ TIBTreeNode }
310
311	+	constructor TIBTreeNode.Create(AnOwner: TTreeNodes);
312	+	begin
313	+	inherited Create(AnOwner);
314	+	FKeyValue := NULL;
315	+	end;
316	+
317		procedure TIBTreeNode.DeleteAll;
318		var Node, NextNode: TTreeNode;
319		begin
#	Line 290 | Line 334 | procedure TIBTreeView.ActiveChanged(Send
334		var AtTopLevel: boolean;
335		begin
336		if (csDesigning in ComponentState) then Exit;
337	+	IBControlLinkChanged;
338		if assigned(DataSet) and not DataSet.Active then
339		begin
340		if not assigned(FExpandNode) and not assigned(FUpdateNode) then {must really be closing}
#	Line 321 | Line 366 | begin
366		DataSet.First;
367		while not DataSet.EOF do
368		begin
369	<	Node := Items.AddChild(FExpandNode,DataSet.FieldByName(TextField).AsString);
370	<	TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
371	<	Node.HasChildren := (HasChildField = '') or (DataSet.FieldByName(HasChildField).AsInteger <> 0);
372	<	Inc(ChildCount);
369	>	if (FExpandNode = nil) or (TIBTreeNode(FExpandNode).KeyValue <> DataSet.FieldByName(KeyField).AsVariant) then
370	>	begin
371	>	Node := Items.AddChild(FExpandNode,DataSet.FieldByName(TextField).AsString);
372	>	if ImageIndexField <> '' then
373	>	Node.ImageIndex := DataSet.FieldByName(ImageIndexField).AsInteger;
374	>	if SelectedIndexField <> '' then
375	>	Node.SelectedIndex := DataSet.FieldByName(SelectedIndexField).AsInteger;
376	>	TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
377	>	Node.HasChildren := (HasChildField = '') or (DataSet.FieldByName(HasChildField).AsInteger <> 0);
378	>	Inc(ChildCount);
379	>	end;
380		DataSet.Next
381		end;
382		finally
#	Line 338 | Line 390 | end;
390
391		procedure TIBTreeView.DataSetChanged(Sender: TObject);
392		begin
393	<	//  Reinitialise
393	>	//  Do nothing;
394		end;
395
396		function TIBTreeView.GetDataSet: TDataSet;
#	Line 391 | Line 443 | procedure TIBTreeView.RecordChanged(Send
443		var Node: TIBTreeNode;
444		Destination: TIBTreeNode;
445		begin
446	+	if DataSet.State = dsInsert then Exit;
447	+
448		if assigned(Field) and (Field.FieldName = TextField) then
449		begin
450		Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
#	Line 405 | Line 459 | begin
459		end;
460		end
461		else
462	+	if assigned(Field) and (Field.FieldName = ImageIndexField) then
463	+	begin
464	+	Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
465	+	if assigned(Node) then
466	+	begin
467	+	FUpdating := true;
468	+	try
469	+	Node.ImageIndex := Field.AsInteger
470	+	finally
471	+	FUpdating := false
472	+	end;
473	+	end;
474	+	end
475	+	else
476		if assigned(Field) and (Field.FieldName = ParentField) then
477		begin
478		Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
#	Line 415 | Line 483 | begin
483		else
484		Destination := FindNode(DataSet.FieldByName(ParentField).AsVariant);
485
486	<	if Destination = Node.Parent then Exit;
486	>	if (Destination = nil) or (Destination = Node.Parent) then Exit;
487
488		FUpdating := true;
489		try
#	Line 434 | Line 502 | begin
502		Reinitialise
503		end;
504
505	+	procedure TIBTreeView.SetImageIndexField(AValue: string);
506	+	begin
507	+	if FImageIndexField = AValue then Exit;
508	+	FImageIndexField := AValue;
509	+	Reinitialise
510	+	end;
511	+
512		procedure TIBTreeView.SetKeyField(AValue: string);
513		begin
514		if FKeyField = AValue then Exit;
#	Line 441 | Line 516 | begin
516		Reinitialise
517		end;
518
519	+	procedure TIBTreeView.SetSelectedIndexField(AValue: string);
520	+	begin
521	+	if FSelectedIndexField = AValue then Exit;
522	+	FSelectedIndexField := AValue;
523	+	Reinitialise;
524	+	end;
525	+
526		procedure TIBTreeView.SetTextField(AValue: string);
527		begin
528		if FTextField = AValue then Exit;
#	Line 450 | Line 532 | end;
532
533		procedure TIBTreeView.SetDataSource(AValue: TDataSource);
534		begin
535	<	FDataLink.DataSource := AValue
535	>	FDataLink.DataSource := AValue;
536	>	IBControlLinkChanged;
537		end;
538
539		procedure TIBTreeView.SetParentField(AValue: string);
#	Line 466 | Line 549 | begin
549		if Result then
550		begin
551		if DataSet.Active and (DataSet.RecordCount > 0)
552	<	and (Node.KeyValue = DataSet.FieldByName(KeyField).AsVariant) then Exit;
552	>	and DataSet.Locate(KeyField,Node.KeyValue,[]) then Exit;
553
554		FUpdateNode := Node;
555		try
#	Line 496 | Line 579 | procedure TIBTreeView.UpdateParams(Sende
579		begin
580		if not assigned(FExpandNode) and assigned(FUpdateNode)  then {Scrolling dataset}
581		begin
582	<	if (Sender as TDataLink).DataSet is TIBQuery then
583	<	TIBQuery((Sender as TDataLink).DataSet).ParamByName('IBX_KEY_VALUE').Value :=
582	>	if DataSource.DataSet is TIBQuery then
583	>	TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
584		FUpdateNode.KeyValue
585		else
586	<	if (Sender as TDataLink).DataSet is TIBDataSet then
587	<	TIBDataSet((Sender as TDataLink).DataSet).ParamByName('IBX_KEY_VALUE').Value :=
586	>	if DataSource.DataSet is TIBDataSet then
587	>	TIBDataSet(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
588		FUpdateNode.KeyValue
589		end
590		else
591		if assigned(FExpandNode) then
592		begin
593	<	if (Sender as TDataLink).DataSet is TIBQuery then
594	<	TIBQuery((Sender as TDataLink).DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
593	>	if DataSource.DataSet is TIBQuery then
594	>	TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
595		TIBTreeNode(FExpandNode).KeyValue
596		else
597	<	if (Sender as TDataLink).DataSet is TIBDataSet then
598	<	TIBDataSet((Sender as TDataLink).DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
597	>	if DataSource.DataSet is TIBDataSet then
598	>	TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
599		TIBTreeNode(FExpandNode).KeyValue
600		end;
601		end;
#	Line 527 | Line 610 | begin
610		Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" is null')
611		else
612		if assigned(FExpandNode) then
613	+	begin
614		Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" = :IBX_PARENT_VALUE');
615	+	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_PARENT_VALUE',true);
616	+	end;
617		end;
618
619		procedure TIBTreeView.Added(Node: TTreeNode);
#	Line 589 | Line 675 | begin
675		FExpandNode := Node;
676		DataSet.Active := false;
677		DataSet.Active := true;
678	<	if assigned(Selected) then
593	<	ScrollToNode(TIBTreeNode(Selected))
678	>	Selected := Node;
679		end;
680		end;
681
682	+	procedure TIBTreeView.IBControlLinkChanged;
683	+	begin
684	+	if assigned(DataSource) and (DataSource.DataSet <> nil) and (DataSource.DataSet is TIBParserDataset) then
685	+	FIBTreeViewControllink.IBDataSet := TIBCustomDataSet(DataSource.DataSet)
686	+	else
687	+	FIBTreeViewControllink.IBDataSet := nil;
688	+	end;
689	+
690		procedure TIBTreeView.Loaded;
691		begin
692		inherited Loaded;
693	+	IBControlLinkChanged;
694		Reinitialise
695		end;
696
#	Line 618 | Line 712 | procedure TIBTreeView.Notification(AComp
712		begin
713		inherited Notification(AComponent, Operation);
714		if (Operation = opRemove) and
715	<	(FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil;
715	>	(FDataLink <> nil) and (AComponent = DataSource) then
716	>	DataSource := nil;
717		end;
718
719		procedure TIBTreeView.Reinitialise;
#	Line 632 | Line 727 | constructor TIBTreeView.Create(TheCompon
727		begin
728		inherited Create(TheComponent);
729		FDataLink := TIBTreeViewDatalink.Create(self);
730	+	FIBTreeViewControlLink := TIBTreeViewControlLink.Create(self);
731		end;
732
733		destructor TIBTreeView.Destroy;
734		begin
735		if assigned(FDataLink) then FDataLink.Free;
736	+	if assigned(FIBTreeViewControlLink) then FIBTreeViewControlLink.Free;
737		inherited Destroy;
738		end;
739
740	<	function TIBTreeView.FindNode(KeyValuePath: array of variant;
741	<	SelectNode: boolean): TIBTreeNode;
740	>	function TIBTreeView.FindNode(KeyValuePath: TVariantArray; SelectNode: boolean
741	>	): TIBTreeNode;
742		var Node: TTreeNode;
743		i,j: integer;
744		begin
745		Result := nil;
746	+	if Length(KeyValuePath) = 0 then Exit;
747	+
748		FLocatingNode := true;
749		try
750		for j := 0 to Items.TopLvlCount - 1 do
#	Line 655 | Line 754 | begin
754		Node.Expand(false);
755		while assigned(Node)  do
756		begin
757	<	if TIBTreeNode(Node).KeyValue = KeyValuePath[i] then
757	>	if not VarIsNull(TIBTreeNode(Node).KeyValue) and
758	>	(TIBTreeNode(Node).KeyValue = KeyValuePath[i]) then
759		begin
760		Inc(i);
761		if i = Length(KeyValuePath) then
#	Line 733 | Line 833 | begin
833		FOwner.ActiveChanged(self)
834		end;
835
736	–	procedure TIBTreeViewDatalink.DataEvent(Event: TDataEvent; Info: Ptrint);
737	–	begin
738	–	if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then
739	–	begin
740	–	if (DataSet is TIBDataSet) then
741	–	FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser)
742	–	else
743	–	if (DataSet is TIBQuery) then
744	–	FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser)
745	–	end
746	–	else
747	–	if (Event = deCheckBrowseMode) and (Info = 2) and not DataSet.Active then
748	–	begin
749	–	if (DataSet is TIBDataSet) then
750	–	FOwner.UpdateParams(self,TIBDataSet(DataSet).Parser)
751	–	else
752	–	if (DataSet is TIBQuery) then
753	–	FOwner.UpdateParams(self,TIBQuery(DataSet).Parser)
754	–	end
755	–	else
756	–	inherited DataEvent(Event, Info);
757	–	end;
758	–
836		procedure TIBTreeViewDatalink.DataSetChanged;
837		begin
838		FOwner.DataSetChanged(self)

Diff Legend

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