ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/ibcontrols/IBTreeView.pas
Revision: 217
Committed: Fri Mar 16 10:27:26 2018 UTC (6 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 23172 byte(s)
Log Message:
Fixes Merged

File Contents

# User Rev Content
1 tony 21 (*
2     * IBX For Lazarus (Firebird Express)
3     *
4     * The contents of this file are subject to the Initial Developer's
5     * Public License Version 1.0 (the "License"); you may not use this
6     * file except in compliance with the License. You may obtain a copy
7     * of the License here:
8     *
9     * http://www.firebirdsql.org/index.php?op=doc&id=idpl
10     *
11     * Software distributed under the License is distributed on an "AS
12     * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13     * implied. See the License for the specific language governing rights
14     * and limitations under the License.
15     *
16     * The Initial Developer of the Original Code is Tony Whyman.
17     *
18 tony 23 * The Original Code is (C) 2015 Tony Whyman, MWA Software
19 tony 21 * (http://www.mwasoftware.co.uk).
20     *
21     * All Rights Reserved.
22     *
23     * Contributor(s): ______________________________________.
24     *
25     *)
26     unit IBTreeView;
27    
28     {$mode objfpc}{$H+}
29    
30     interface
31    
32     uses
33     Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
34 tony 27 DB, IBSQLParser, IBCustomDataSet;
35 tony 21
36     type
37     {
38     TIBTreeView is intended to be a data aware descendent of TCustomTreeView and used to display
39     hierarchically structured data in a natural manner. Nodes can be deleted, moved
40     and added to the tree and each change is reflected in the underlying dataset. The
41     Node text can similarly be edited.
42     }
43    
44     TVariantArray = array of variant;
45    
46     TIBTreeView = class;
47    
48     { TIBTreeViewDatalink }
49    
50     TIBTreeViewDatalink = class(TDataLink)
51     private
52     FOwner: TIBTreeView;
53     protected
54     procedure ActiveChanged; override;
55     procedure DataSetChanged; override;
56     procedure RecordChanged(Field: TField); override;
57     procedure UpdateData; override;
58     public
59     constructor Create(AOwner: TIBTreeView);
60     end;
61    
62 tony 27 { 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 tony 21 { TIBTreeNode }
75    
76     TIBTreeNode = class(TTreeNode)
77     private
78     FKeyValue: variant;
79     public
80 tony 80 constructor Create(AnOwner: TTreeNodes); override;
81 tony 21 procedure DeleteAll;
82     property KeyValue: variant read FKeyValue;
83     end;
84    
85     TIBTreeView = class(TCustomTreeView)
86     private
87     { Private declarations }
88     FDataLink: TIBTreeViewDatalink;
89 tony 27 FIBTreeViewControlLink: TIBTreeViewControlLink;
90 tony 21 FHasChildField: string;
91 tony 143 FImageIndexField: string;
92 tony 21 FKeyField: string;
93 tony 143 FSelectedIndexField: string;
94 tony 21 FTextField: string;
95     FParentField: string;
96     FExpandNode: TTreeNode;
97     FNoAddNodeToDataset: boolean;
98     FRelationName: string;
99     FUpdateNode: TIBTreeNode;
100     FModifiedNode: TIBTreeNode;
101     FUpdating: boolean;
102     FLocatingNode: boolean;
103     FLastSelected: TVariantArray;
104     procedure ActiveChanged(Sender: TObject);
105     procedure AddNodes;
106     procedure DataSetChanged(Sender: TObject);
107     function GetDataSet: TDataSet;
108     function GetDataSource: TDataSource;
109     function GetRelationNameQualifier: string;
110     function GetSelectedKeyValue: variant;
111 tony 27 procedure IBControlLinkChanged;
112 tony 21 procedure NodeMoved(Node: TTreeNode);
113     procedure NodeUpdated(Node: TTreeNode);
114     procedure RecordChanged(Sender: TObject; Field: TField);
115     procedure SetHasChildField(AValue: string);
116 tony 143 procedure SetImageIndexField(AValue: string);
117 tony 21 procedure SetKeyField(AValue: string);
118 tony 143 procedure SetSelectedIndexField(AValue: string);
119 tony 21 procedure SetTextField(AValue: string);
120     procedure SetDataSource(AValue: TDataSource);
121     procedure SetParentField(AValue: string);
122     function ScrollToNode(Node: TIBTreeNode): boolean;
123     procedure UpdateData(Sender: TObject);
124     procedure UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
125     procedure UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
126     protected
127     { Protected declarations }
128     procedure Added(Node: TTreeNode); override;
129     procedure Delete(Node: TTreeNode); override;
130     procedure Change(Node: TTreeNode); override;
131     function CreateNode: TTreeNode; override;
132     function CanEdit(Node: TTreeNode): Boolean; override;
133     procedure Expand(Node: TTreeNode); override;
134     procedure Loaded; override;
135     procedure NodeChanged(Node: TTreeNode; ChangeEvent: TTreeNodeChangeReason); override;
136     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
137     procedure Reinitialise;
138     public
139     { Public declarations }
140     constructor Create(TheComponent: TComponent); override;
141     destructor Destroy; override;
142 tony 80 function FindNode(KeyValuePath: TVariantArray; SelectNode: boolean): TIBTreeNode; overload;
143 tony 21 function FindNode(KeyValue: variant): TIBTreeNode; overload;
144     function GetNodePath(Node: TTreeNode): TVariantArray;
145     property DataSet: TDataSet read GetDataSet;
146     property SelectedKeyValue: variant read GetSelectedKeyValue;
147     published
148     { Published declarations }
149     property Align;
150     property Anchors;
151     property AutoExpand;
152     property BorderSpacing;
153     //property BiDiMode;
154     property BackgroundColor;
155     property BorderStyle;
156     property BorderWidth;
157     property Color;
158     property Constraints;
159     property TextField: string read FTextField write SetTextField;
160     property DataSource: TDataSource read GetDataSource write SetDataSource;
161     property DefaultItemHeight;
162     property DragKind;
163     property DragCursor;
164     property DragMode;
165     property Enabled;
166     property ExpandSignColor;
167     property ExpandSignType;
168     property Font;
169     property HideSelection;
170     property HotTrack;
171     property Images;
172     property Indent;
173     property HasChildField: string read FHasChildField write SetHasChildField;
174 tony 143 property ImageIndexField: string read FImageIndexField write SetImageIndexField;
175     property SelectedIndexField: string read FSelectedIndexField write SetSelectedIndexField;
176 tony 21 property KeyField: string read FKeyField write SetKeyField;
177     property MultiSelect;
178     property MultiSelectStyle;
179     //property ParentBiDiMode;
180     property ParentColor default False;
181     property ParentField: string read FParentField write SetParentField;
182     property ParentFont;
183     property ParentShowHint;
184     property PopupMenu;
185     property ReadOnly;
186     property RelationName: string read FRelationName write FRelationName;
187     property RightClickSelect;
188     property RowSelect;
189     property ScrollBars;
190     property SelectionColor;
191     property ShowButtons;
192     property ShowHint;
193     property ShowLines;
194     property ShowRoot;
195     property StateImages;
196     property TabOrder;
197     property TabStop default True;
198     property Tag;
199     property ToolTips;
200     property Visible;
201     property OnAddition;
202     property OnAdvancedCustomDraw;
203     property OnAdvancedCustomDrawItem;
204     property OnChange;
205     property OnChanging;
206     property OnClick;
207     property OnCollapsed;
208     property OnCollapsing;
209     property OnCompare;
210     property OnContextPopup;
211     property OnCreateNodeClass;
212     property OnCustomCreateItem;
213     property OnCustomDraw;
214     property OnCustomDrawItem;
215     property OnDblClick;
216     property OnDeletion;
217     property OnDragDrop;
218     property OnDragOver;
219     property OnEdited;
220     property OnEditing;
221     property OnEditingEnd;
222     //property OnEndDock;
223     property OnEndDrag;
224     property OnEnter;
225     property OnExit;
226     property OnExpanded;
227     property OnExpanding;
228     property OnGetImageIndex;
229     property OnGetSelectedIndex;
230     property OnKeyDown;
231     property OnKeyPress;
232     property OnKeyUp;
233     property OnMouseDown;
234     property OnMouseEnter;
235     property OnMouseLeave;
236     property OnMouseMove;
237     property OnMouseUp;
238     property OnNodeChanged;
239     property OnSelectionChanged;
240     property OnShowHint;
241     //property OnStartDock;
242     property OnStartDrag;
243     property OnUTF8KeyPress;
244     property Options;
245     property Items;
246     property TreeLineColor;
247     property TreeLinePenStyle;
248     end;
249    
250     function StrIntListToVar(s: string): TVariantArray;
251     function VarToStrIntList(a: TVariantArray): string;
252    
253     implementation
254    
255 tony 27 uses IBQuery,Variants;
256 tony 21
257     function StrIntListToVar(s: string): TVariantArray;
258     var i, idx: integer;
259     List: TStringList;
260     begin
261     List := TStringList.Create;
262     try
263     idx := 1;
264     List.Clear;
265     while idx <= Length(s) do
266     List.Add(ExtractFieldName(s,idx));
267    
268     Setlength(Result,List.Count);
269     for i := 0 to List.Count - 1 do
270     Result[i] := StrToInt(List[i])
271     finally
272     List.Free
273     end;
274     end;
275    
276     function VarToStrIntList(a: TVariantArray): string;
277     var i: integer;
278     begin
279     for i := 0 to Length(a) - 1 do
280     if VarIsOrdinal(a[i]) then
281     begin
282     if i = 0 then
283     Result := IntToStr(a[i])
284     else
285     Result := Result + ';' + IntToStr(a[i])
286     end
287     else
288     raise Exception.Create('Ordinal Type Expected when converting to integer string');
289     end;
290    
291 tony 27 { 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 tony 21 { TIBTreeNode }
310    
311 tony 80 constructor TIBTreeNode.Create(AnOwner: TTreeNodes);
312     begin
313     inherited Create(AnOwner);
314     FKeyValue := NULL;
315     end;
316    
317 tony 21 procedure TIBTreeNode.DeleteAll;
318     var Node, NextNode: TTreeNode;
319     begin
320     Expand(true);
321     Node := GetFirstChild;
322     while Node <> nil do
323     begin
324     NextNode := Node.GetNextSibling;
325     TIBTreeNode(Node).DeleteAll;
326     Node := NextNode;
327     end;
328     Delete
329     end;
330    
331     { TIBTreeView }
332    
333     procedure TIBTreeView.ActiveChanged(Sender: TObject);
334     begin
335     if (csDesigning in ComponentState) then Exit;
336 tony 27 IBControlLinkChanged;
337 tony 21 if assigned(DataSet) and not DataSet.Active then
338     begin
339     if not assigned(FExpandNode) and not assigned(FUpdateNode) then {must really be closing}
340     Reinitialise
341     end
342     else
343     begin
344     AddNodes;
345     if not FLocatingNode and (Selected = nil) and (Items.TopLvlCount > 0) then
346     begin
347     if Length(FLastSelected) > 0 then
348     Selected := FindNode(FLastSelected,true)
349     else
350     Selected := Items.TopLvlItems[0];
351     end
352     end
353     end;
354    
355     procedure TIBTreeView.AddNodes;
356     var Node: TTreeNode;
357     ChildCount: integer;
358     begin
359     if assigned(FExpandNode) or (Items.Count = 0) then
360     begin
361     ChildCount := 0;
362     FNoAddNodeToDataset := true;
363     try
364     DataSet.First;
365     while not DataSet.EOF do
366     begin
367 tony 143 if (FExpandNode = nil) or (TIBTreeNode(FExpandNode).KeyValue <> DataSet.FieldByName(KeyField).AsVariant) then
368     begin
369     Node := Items.AddChild(FExpandNode,DataSet.FieldByName(TextField).AsString);
370     if ImageIndexField <> '' then
371     Node.ImageIndex := DataSet.FieldByName(ImageIndexField).AsInteger;
372     if SelectedIndexField <> '' then
373     Node.SelectedIndex := DataSet.FieldByName(SelectedIndexField).AsInteger;
374     TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
375     Node.HasChildren := (HasChildField = '') or (DataSet.FieldByName(HasChildField).AsInteger <> 0);
376     Inc(ChildCount);
377     end;
378 tony 21 DataSet.Next
379     end;
380     finally
381     FNoAddNodeToDataset := false
382     end;
383     if assigned(FExpandNode) then
384     FExpandNode.HasChildren := ChildCount > 0;
385     FExpandNode := nil
386     end
387     end;
388    
389     procedure TIBTreeView.DataSetChanged(Sender: TObject);
390     begin
391 tony 143 // Do nothing;
392 tony 21 end;
393    
394     function TIBTreeView.GetDataSet: TDataSet;
395     begin
396     Result := FDataLink.DataSet
397     end;
398    
399     function TIBTreeView.GetDataSource: TDataSource;
400     begin
401     Result := FDataLink.DataSource
402     end;
403    
404     function TIBTreeView.GetRelationNameQualifier: string;
405     begin
406     if FRelationName <> '' then
407     Result := FRelationName + '.'
408     else
409     Result := ''
410     end;
411    
412     function TIBTreeView.GetSelectedKeyValue: variant;
413     begin
414     Result := NULL;
415     if assigned(Selected) and (Selected is TIBTreeNode) then
416     Result := TIBTreeNode(Selected).KeyValue
417     end;
418    
419     procedure TIBTreeView.NodeMoved(Node: TTreeNode);
420     begin
421     {Need to update Parent}
422     if ScrollToNode(TIBTreeNode(Node)) then
423     begin
424     FDataLink.Edit;
425     FModifiedNode := TIBTreeNode(Node)
426     end;
427     end;
428    
429     procedure TIBTreeView.NodeUpdated(Node: TTreeNode);
430     begin
431     {Need to Update List Field}
432     if ScrollToNode(TIBTreeNode(Node)) then
433     begin
434     FDataLink.Edit;
435     FModifiedNode := TIBTreeNode(Node);
436     FDataLink.UpdateRecord
437     end;
438     end;
439    
440     procedure TIBTreeView.RecordChanged(Sender: TObject; Field: TField);
441     var Node: TIBTreeNode;
442     Destination: TIBTreeNode;
443     begin
444 tony 27 if DataSet.State = dsInsert then Exit;
445    
446 tony 21 if assigned(Field) and (Field.FieldName = TextField) then
447     begin
448     Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
449     if assigned(Node) then
450     begin
451     FUpdating := true;
452     try
453     Node.Text := Field.Text
454     finally
455     FUpdating := false
456     end;
457     end;
458     end
459     else
460 tony 143 if assigned(Field) and (Field.FieldName = ImageIndexField) then
461     begin
462     Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
463     if assigned(Node) then
464     begin
465     FUpdating := true;
466     try
467     Node.ImageIndex := Field.AsInteger
468     finally
469     FUpdating := false
470     end;
471     end;
472     end
473     else
474 tony 21 if assigned(Field) and (Field.FieldName = ParentField) then
475     begin
476     Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
477     if assigned(Node) then
478     begin
479     if DataSet.FieldByName(ParentField).IsNull then
480     Destination := nil
481     else
482     Destination := FindNode(DataSet.FieldByName(ParentField).AsVariant);
483    
484 tony 39 if (Destination = nil) or (Destination = Node.Parent) then Exit;
485 tony 21
486     FUpdating := true;
487     try
488     Node.MoveTo(Destination,naAddChild);
489     finally
490     FUpdating := false
491     end;
492     end;
493     end
494     end;
495    
496     procedure TIBTreeView.SetHasChildField(AValue: string);
497     begin
498     if FHasChildField = AValue then Exit;
499     FHasChildField := AValue;
500     Reinitialise
501     end;
502    
503 tony 143 procedure TIBTreeView.SetImageIndexField(AValue: string);
504     begin
505     if FImageIndexField = AValue then Exit;
506     FImageIndexField := AValue;
507     Reinitialise
508     end;
509    
510 tony 21 procedure TIBTreeView.SetKeyField(AValue: string);
511     begin
512     if FKeyField = AValue then Exit;
513     FKeyField := AValue;
514     Reinitialise
515     end;
516    
517 tony 143 procedure TIBTreeView.SetSelectedIndexField(AValue: string);
518     begin
519     if FSelectedIndexField = AValue then Exit;
520     FSelectedIndexField := AValue;
521     Reinitialise;
522     end;
523    
524 tony 21 procedure TIBTreeView.SetTextField(AValue: string);
525     begin
526     if FTextField = AValue then Exit;
527     FTextField := AValue;
528     Reinitialise
529     end;
530    
531     procedure TIBTreeView.SetDataSource(AValue: TDataSource);
532     begin
533 tony 27 FDataLink.DataSource := AValue;
534     IBControlLinkChanged;
535 tony 21 end;
536    
537     procedure TIBTreeView.SetParentField(AValue: string);
538     begin
539     if FParentField = AValue then Exit;
540     FParentField := AValue;
541     Reinitialise
542     end;
543    
544     function TIBTreeView.ScrollToNode(Node: TIBTreeNode): boolean;
545     begin
546     Result := assigned(DataSet) and DataSet.Active and assigned(Node) and not varIsNull(Node.KeyValue);
547     if Result then
548     begin
549     if DataSet.Active and (DataSet.RecordCount > 0)
550 tony 80 and DataSet.Locate(KeyField,Node.KeyValue,[]) then Exit;
551 tony 21
552     FUpdateNode := Node;
553     try
554     DataSet.Active := false;
555     DataSet.Active := true;
556     finally
557     FUpdateNode := nil
558     end;
559     Result := DataSet.FieldByName(KeyField).AsVariant = Node.KeyValue
560     end;
561     end;
562    
563     procedure TIBTreeView.UpdateData(Sender: TObject);
564     begin
565     if assigned(FModifiedNode) then
566     begin
567     DataSet.FieldByName(TextField).AsString := FModifiedNode.Text;
568     if FModifiedNode.Parent = nil then
569     DataSet.FieldByName(ParentField).Clear
570     else
571     DataSet.FieldByName(ParentField).AsVariant := TIBTreeNode(FModifiedNode.Parent).KeyValue;
572     FModifiedNode := nil
573     end
574     end;
575    
576     procedure TIBTreeView.UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
577     begin
578     if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
579     begin
580 tony 27 if DataSource.DataSet is TIBQuery then
581     TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
582 tony 21 FUpdateNode.KeyValue
583     else
584 tony 27 if DataSource.DataSet is TIBDataSet then
585     TIBDataSet(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
586 tony 21 FUpdateNode.KeyValue
587     end
588     else
589     if assigned(FExpandNode) then
590     begin
591 tony 27 if DataSource.DataSet is TIBQuery then
592     TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
593 tony 21 TIBTreeNode(FExpandNode).KeyValue
594     else
595 tony 27 if DataSource.DataSet is TIBDataSet then
596     TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
597 tony 21 TIBTreeNode(FExpandNode).KeyValue
598     end;
599     end;
600    
601     procedure TIBTreeView.UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
602     begin
603     if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
604     Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_KEY_VALUE')
605     else
606     if (Items.Count = 0) then
607     {Need to Load Root Nodes}
608     Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" is null')
609     else
610     if assigned(FExpandNode) then
611 tony 143 begin
612 tony 21 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" = :IBX_PARENT_VALUE');
613 tony 143 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_PARENT_VALUE',true);
614     end;
615 tony 21 end;
616    
617     procedure TIBTreeView.Added(Node: TTreeNode);
618     begin
619     if assigned(DataSet) and DataSet.Active and not FNoAddNodeToDataset then
620     begin
621     DataSet.Append;
622     TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
623     if (Node.Text = '') and not DataSet.FieldByName(TextField).IsNull then
624     Node.Text := DataSet.FieldByName(TextField).AsString;
625     FModifiedNode := TIBTreeNode(Node);
626     FDataLink.UpdateRecord
627     end;
628     inherited Added(Node);
629     end;
630    
631     procedure TIBTreeView.Delete(Node: TTreeNode);
632     begin
633     if not (tvsUpdating in States) {TreeNodes being cleared}
634     and not (tvsManualNotify in States) {Tree Collapse with node delete}
635     and ScrollToNode(TIBTreeNode(Node)) then
636     DataSet.Delete;
637     inherited Delete(Node);
638     end;
639    
640     procedure TIBTreeView.Change(Node: TTreeNode);
641     begin
642     inherited Change(Node);
643     ScrollToNode(TIBTreeNode(Node));
644     end;
645    
646     function TIBTreeView.CreateNode: TTreeNode;
647     var
648     NewNodeClass: TTreeNodeClass;
649     begin
650     Result := nil;
651     if Assigned(OnCustomCreateItem) then
652     OnCustomCreateItem(Self, Result);
653     if Result = nil then
654     begin
655     NewNodeClass:=TIBTreeNode;
656     if Assigned(OnCreateNodeClass) then
657     OnCreateNodeClass(Self,NewNodeClass);
658     Result := NewNodeClass.Create(Items);
659     end;
660     end;
661    
662     function TIBTreeView.CanEdit(Node: TTreeNode): Boolean;
663     begin
664     Result := inherited CanEdit(Node)
665     and assigned(DataSet) and not DataSet.FieldByName(TextField).ReadOnly
666     end;
667    
668     procedure TIBTreeView.Expand(Node: TTreeNode);
669     begin
670     inherited Expand(Node);
671     if Node.HasChildren and assigned(DataSet) and (Node.GetFirstChild = nil) then
672     begin
673     FExpandNode := Node;
674     DataSet.Active := false;
675     DataSet.Active := true;
676 tony 143 Selected := Node;
677 tony 21 end;
678     end;
679    
680 tony 27 procedure TIBTreeView.IBControlLinkChanged;
681     begin
682     if assigned(DataSource) and (DataSource.DataSet <> nil) and (DataSource.DataSet is TIBParserDataset) then
683     FIBTreeViewControllink.IBDataSet := TIBCustomDataSet(DataSource.DataSet)
684     else
685     FIBTreeViewControllink.IBDataSet := nil;
686     end;
687    
688 tony 21 procedure TIBTreeView.Loaded;
689     begin
690     inherited Loaded;
691 tony 29 IBControlLinkChanged;
692 tony 21 Reinitialise
693     end;
694    
695     procedure TIBTreeView.NodeChanged(Node: TTreeNode;
696     ChangeEvent: TTreeNodeChangeReason);
697     begin
698     inherited NodeChanged(Node, ChangeEvent);
699     if not FNoAddNodeToDataset and not FUpdating then
700     case ChangeEvent of
701     ncTextChanged:
702     NodeUpdated(Node);
703     ncParentChanged:
704     NodeMoved(Node);
705     end;
706     end;
707    
708     procedure TIBTreeView.Notification(AComponent: TComponent; Operation: TOperation
709     );
710     begin
711     inherited Notification(AComponent, Operation);
712     if (Operation = opRemove) and
713 tony 27 (FDataLink <> nil) and (AComponent = DataSource) then
714     DataSource := nil;
715 tony 21 end;
716    
717     procedure TIBTreeView.Reinitialise;
718     begin
719     if [csDesigning,csLoading] * ComponentState <> [] then Exit;
720     FLastSelected := GetNodePath(Selected);
721     Items.Clear;
722     end;
723    
724     constructor TIBTreeView.Create(TheComponent: TComponent);
725     begin
726     inherited Create(TheComponent);
727     FDataLink := TIBTreeViewDatalink.Create(self);
728 tony 27 FIBTreeViewControlLink := TIBTreeViewControlLink.Create(self);
729 tony 21 end;
730    
731     destructor TIBTreeView.Destroy;
732     begin
733     if assigned(FDataLink) then FDataLink.Free;
734 tony 27 if assigned(FIBTreeViewControlLink) then FIBTreeViewControlLink.Free;
735 tony 21 inherited Destroy;
736     end;
737    
738 tony 80 function TIBTreeView.FindNode(KeyValuePath: TVariantArray; SelectNode: boolean
739     ): TIBTreeNode;
740 tony 21 var Node: TTreeNode;
741     i,j: integer;
742     begin
743     Result := nil;
744 tony 80 if Length(KeyValuePath) = 0 then Exit;
745    
746 tony 21 FLocatingNode := true;
747     try
748     for j := 0 to Items.TopLvlCount - 1 do
749     begin
750     Node := Items.TopLvlItems[j];
751     i := 0;
752     Node.Expand(false);
753     while assigned(Node) do
754     begin
755 tony 80 if not VarIsNull(TIBTreeNode(Node).KeyValue) and
756     (TIBTreeNode(Node).KeyValue = KeyValuePath[i]) then
757 tony 21 begin
758     Inc(i);
759     if i = Length(KeyValuePath) then
760     begin
761     Result := TIBTreeNode(Node);
762     if SelectNode then
763     Selected := Node;
764     Exit
765     end
766     else
767     begin
768     Node.Expand(false);
769     Node := Node.GetFirstChild;
770     end
771     end
772     else
773     Node := Node.GetNextSibling
774     end
775     end
776     finally
777     FLocatingNode := false
778     end
779     end;
780    
781     function TIBTreeView.FindNode(KeyValue: variant): TIBTreeNode;
782     var i: integer;
783     begin
784     Result := nil;
785     if (Selected <> nil) and (TIBTreeNode(Selected).KeyValue = KeyValue) then
786     Result := TIBTreeNode(Selected)
787     else
788     {Find it the hard way}
789     begin
790     FullExpand;
791     for i := 0 to Items.Count -1 do
792     if TIBTreeNode(Items[i]).KeyValue = KeyValue then
793     begin
794     Result := TIBTreeNode(Items[i])
795     end;
796     end;
797     end;
798    
799     function TIBTreeView.GetNodePath(Node: TTreeNode): TVariantArray;
800     var aParent: TTreeNode;
801     i: integer;
802     begin
803     if not assigned(Node) or not (Node is TIBTreeNode) then
804     SetLength(Result,0)
805     else
806     begin
807     {Count length of Path}
808     i := 1;
809     aParent := Node.Parent;
810     while (aParent <> nil) do
811     begin
812     Inc(i);
813     aParent := aParent.Parent
814     end;
815    
816     {Save Path}
817     Setlength(Result,i);
818     while i > 0 do
819     begin
820     Dec(i);
821     Result[i] := TIBTreeNode(Node).KeyValue;
822     Node := Node.Parent
823     end;
824     end;
825     end;
826    
827     { TIBTreeViewDatalink }
828    
829     procedure TIBTreeViewDatalink.ActiveChanged;
830     begin
831     FOwner.ActiveChanged(self)
832     end;
833    
834     procedure TIBTreeViewDatalink.DataSetChanged;
835     begin
836     FOwner.DataSetChanged(self)
837     end;
838    
839     procedure TIBTreeViewDatalink.RecordChanged(Field: TField);
840     begin
841     FOwner.RecordChanged(self,Field);
842     end;
843    
844     procedure TIBTreeViewDatalink.UpdateData;
845     begin
846     FOwner.UpdateData(self)
847     end;
848    
849     constructor TIBTreeViewDatalink.Create(AOwner: TIBTreeView);
850     begin
851     inherited Create;
852     FOwner := AOwner
853     end;
854    
855     end.