ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/ibcontrols/IBTreeView.pas
Revision: 272
Committed: Mon Feb 4 13:34:37 2019 UTC (5 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 23104 byte(s)
Log Message:
Fixes merged

File Contents

# Content
1 (*
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 * The Original Code is (C) 2015 Tony Whyman, MWA Software
19 * (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 DB, IBSQLParser, IBCustomDataSet;
35
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 { 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;
84
85 TIBTreeView = class(TCustomTreeView)
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;
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 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);
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 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;
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 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;
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 uses IBQuery,Variants;
256
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 { 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
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 IBControlLinkChanged;
337 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 if (FExpandNode = nil) or (TIBTreeNode(FExpandNode).KeyValue <> DataSet.FieldByName(KeyField).AsVariant) then
368 begin
369 Node := Items.AddChild(FExpandNode,DataSet.FieldByName(TextField).AsString);
370 Node.HasChildren := (HasChildField = '') or (DataSet.FieldByName(HasChildField).AsInteger <> 0);
371 Inc(ChildCount);
372 end;
373 DataSet.Next
374 end;
375 finally
376 FNoAddNodeToDataset := false
377 end;
378 if assigned(FExpandNode) then
379 FExpandNode.HasChildren := ChildCount > 0;
380 FExpandNode := nil
381 end
382 end;
383
384 procedure TIBTreeView.DataSetChanged(Sender: TObject);
385 begin
386 // Do nothing;
387 end;
388
389 function TIBTreeView.GetDataSet: TDataSet;
390 begin
391 Result := FDataLink.DataSet
392 end;
393
394 function TIBTreeView.GetDataSource: TDataSource;
395 begin
396 Result := FDataLink.DataSource
397 end;
398
399 function TIBTreeView.GetRelationNameQualifier: string;
400 begin
401 if FRelationName <> '' then
402 Result := FRelationName + '.'
403 else
404 Result := ''
405 end;
406
407 function TIBTreeView.GetSelectedKeyValue: variant;
408 begin
409 Result := NULL;
410 if assigned(Selected) and (Selected is TIBTreeNode) then
411 Result := TIBTreeNode(Selected).KeyValue
412 end;
413
414 procedure TIBTreeView.NodeMoved(Node: TTreeNode);
415 begin
416 {Need to update Parent}
417 if ScrollToNode(TIBTreeNode(Node)) then
418 begin
419 FDataLink.Edit;
420 FModifiedNode := TIBTreeNode(Node)
421 end;
422 end;
423
424 procedure TIBTreeView.NodeUpdated(Node: TTreeNode);
425 begin
426 {Need to Update List Field}
427 if ScrollToNode(TIBTreeNode(Node)) then
428 begin
429 FDataLink.Edit;
430 FModifiedNode := TIBTreeNode(Node);
431 FDataLink.UpdateRecord
432 end;
433 end;
434
435 procedure TIBTreeView.RecordChanged(Sender: TObject; Field: TField);
436 var Node: TIBTreeNode;
437 Destination: TIBTreeNode;
438 begin
439 if DataSet.State = dsInsert then Exit;
440
441 if assigned(Field) and (Field.FieldName = TextField) then
442 begin
443 Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
444 if assigned(Node) then
445 begin
446 FUpdating := true;
447 try
448 Node.Text := Field.Text
449 finally
450 FUpdating := false
451 end;
452 end;
453 end
454 else
455 if assigned(Field) and (Field.FieldName = ImageIndexField) then
456 begin
457 Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
458 if assigned(Node) then
459 begin
460 FUpdating := true;
461 try
462 Node.ImageIndex := Field.AsInteger
463 finally
464 FUpdating := false
465 end;
466 end;
467 end
468 else
469 if assigned(Field) and (Field.FieldName = ParentField) then
470 begin
471 Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
472 if assigned(Node) then
473 begin
474 if DataSet.FieldByName(ParentField).IsNull then
475 Destination := nil
476 else
477 Destination := FindNode(DataSet.FieldByName(ParentField).AsVariant);
478
479 if (Destination = nil) or (Destination = Node.Parent) then Exit;
480
481 FUpdating := true;
482 try
483 Node.MoveTo(Destination,naAddChild);
484 finally
485 FUpdating := false
486 end;
487 end;
488 end
489 end;
490
491 procedure TIBTreeView.SetHasChildField(AValue: string);
492 begin
493 if FHasChildField = AValue then Exit;
494 FHasChildField := AValue;
495 Reinitialise
496 end;
497
498 procedure TIBTreeView.SetImageIndexField(AValue: string);
499 begin
500 if FImageIndexField = AValue then Exit;
501 FImageIndexField := AValue;
502 Reinitialise
503 end;
504
505 procedure TIBTreeView.SetKeyField(AValue: string);
506 begin
507 if FKeyField = AValue then Exit;
508 FKeyField := AValue;
509 Reinitialise
510 end;
511
512 procedure TIBTreeView.SetSelectedIndexField(AValue: string);
513 begin
514 if FSelectedIndexField = AValue then Exit;
515 FSelectedIndexField := AValue;
516 Reinitialise;
517 end;
518
519 procedure TIBTreeView.SetTextField(AValue: string);
520 begin
521 if FTextField = AValue then Exit;
522 FTextField := AValue;
523 Reinitialise
524 end;
525
526 procedure TIBTreeView.SetDataSource(AValue: TDataSource);
527 begin
528 FDataLink.DataSource := AValue;
529 IBControlLinkChanged;
530 end;
531
532 procedure TIBTreeView.SetParentField(AValue: string);
533 begin
534 if FParentField = AValue then Exit;
535 FParentField := AValue;
536 Reinitialise
537 end;
538
539 function TIBTreeView.ScrollToNode(Node: TIBTreeNode): boolean;
540 begin
541 Result := assigned(DataSet) and DataSet.Active and assigned(Node) and not varIsNull(Node.KeyValue);
542 if Result then
543 begin
544 if DataSet.Active and (DataSet.RecordCount > 0)
545 and DataSet.Locate(KeyField,Node.KeyValue,[]) then Exit;
546
547 FUpdateNode := Node;
548 try
549 DataSet.Active := false;
550 DataSet.Active := true;
551 finally
552 FUpdateNode := nil
553 end;
554 Result := DataSet.FieldByName(KeyField).AsVariant = Node.KeyValue
555 end;
556 end;
557
558 procedure TIBTreeView.UpdateData(Sender: TObject);
559 begin
560 if assigned(FModifiedNode) then
561 begin
562 DataSet.FieldByName(TextField).AsString := FModifiedNode.Text;
563 if FModifiedNode.Parent = nil then
564 DataSet.FieldByName(ParentField).Clear
565 else
566 DataSet.FieldByName(ParentField).AsVariant := TIBTreeNode(FModifiedNode.Parent).KeyValue;
567 FModifiedNode := nil
568 end
569 end;
570
571 procedure TIBTreeView.UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
572 begin
573 if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
574 begin
575 if DataSource.DataSet is TIBQuery then
576 TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
577 FUpdateNode.KeyValue
578 else
579 if DataSource.DataSet is TIBDataSet then
580 TIBDataSet(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
581 FUpdateNode.KeyValue
582 end
583 else
584 if assigned(FExpandNode) then
585 begin
586 if DataSource.DataSet is TIBQuery then
587 TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
588 TIBTreeNode(FExpandNode).KeyValue
589 else
590 if DataSource.DataSet is TIBDataSet then
591 TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
592 TIBTreeNode(FExpandNode).KeyValue
593 end;
594 end;
595
596 procedure TIBTreeView.UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
597 begin
598 if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
599 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_KEY_VALUE')
600 else
601 if (Items.Count = 0) then
602 {Need to Load Root Nodes}
603 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" is null')
604 else
605 if assigned(FExpandNode) then
606 begin
607 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" = :IBX_PARENT_VALUE');
608 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_PARENT_VALUE',true);
609 end;
610 end;
611
612 procedure TIBTreeView.Added(Node: TTreeNode);
613 begin
614 if assigned(DataSet) and DataSet.Active then
615 begin
616 if not FNoAddNodeToDataset then
617 begin
618 DataSet.Append;
619 if (Node.Text = '') and not DataSet.FieldByName(TextField).IsNull then
620 Node.Text := DataSet.FieldByName(TextField).AsString;
621 FModifiedNode := TIBTreeNode(Node);
622 FDataLink.UpdateRecord;
623 end;
624 TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
625 if ImageIndexField <> '' then
626 Node.ImageIndex := DataSet.FieldByName(ImageIndexField).AsInteger;
627 if SelectedIndexField <> '' then
628 Node.SelectedIndex := DataSet.FieldByName(SelectedIndexField).AsInteger;
629 end;
630 inherited Added(Node);
631 end;
632
633 procedure TIBTreeView.Delete(Node: TTreeNode);
634 begin
635 if not (tvsUpdating in States) {TreeNodes being cleared}
636 and not (tvsManualNotify in States) {Tree Collapse with node delete}
637 and ScrollToNode(TIBTreeNode(Node)) then
638 DataSet.Delete;
639 inherited Delete(Node);
640 end;
641
642 procedure TIBTreeView.Change(Node: TTreeNode);
643 begin
644 inherited Change(Node);
645 ScrollToNode(TIBTreeNode(Node));
646 end;
647
648 function TIBTreeView.CreateNode: TTreeNode;
649 var
650 NewNodeClass: TTreeNodeClass;
651 begin
652 Result := nil;
653 if Assigned(OnCustomCreateItem) then
654 OnCustomCreateItem(Self, Result);
655 if Result = nil then
656 begin
657 NewNodeClass:=TIBTreeNode;
658 if Assigned(OnCreateNodeClass) then
659 OnCreateNodeClass(Self,NewNodeClass);
660 Result := NewNodeClass.Create(Items);
661 end;
662 end;
663
664 function TIBTreeView.CanEdit(Node: TTreeNode): Boolean;
665 begin
666 Result := inherited CanEdit(Node)
667 and assigned(DataSet) and not DataSet.FieldByName(TextField).ReadOnly
668 end;
669
670 procedure TIBTreeView.Expand(Node: TTreeNode);
671 begin
672 inherited Expand(Node);
673 if Node.HasChildren and assigned(DataSet) and (Node.GetFirstChild = nil) then
674 begin
675 FExpandNode := Node;
676 DataSet.Active := false;
677 DataSet.Active := true;
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
697 procedure TIBTreeView.NodeChanged(Node: TTreeNode;
698 ChangeEvent: TTreeNodeChangeReason);
699 begin
700 inherited NodeChanged(Node, ChangeEvent);
701 if not FNoAddNodeToDataset and not FUpdating then
702 case ChangeEvent of
703 ncTextChanged:
704 NodeUpdated(Node);
705 ncParentChanged:
706 NodeMoved(Node);
707 end;
708 end;
709
710 procedure TIBTreeView.Notification(AComponent: TComponent; Operation: TOperation
711 );
712 begin
713 inherited Notification(AComponent, Operation);
714 if (Operation = opRemove) and
715 (FDataLink <> nil) and (AComponent = DataSource) then
716 DataSource := nil;
717 end;
718
719 procedure TIBTreeView.Reinitialise;
720 begin
721 if [csDesigning,csLoading] * ComponentState <> [] then Exit;
722 FLastSelected := GetNodePath(Selected);
723 Items.Clear;
724 end;
725
726 constructor TIBTreeView.Create(TheComponent: TComponent);
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: 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
751 begin
752 Node := Items.TopLvlItems[j];
753 i := 0;
754 Node.Expand(false);
755 while assigned(Node) do
756 begin
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
762 begin
763 Result := TIBTreeNode(Node);
764 if SelectNode then
765 Selected := Node;
766 Exit
767 end
768 else
769 begin
770 Node.Expand(false);
771 Node := Node.GetFirstChild;
772 end
773 end
774 else
775 Node := Node.GetNextSibling
776 end
777 end
778 finally
779 FLocatingNode := false
780 end
781 end;
782
783 function TIBTreeView.FindNode(KeyValue: variant): TIBTreeNode;
784 var i: integer;
785 begin
786 Result := nil;
787 if (Selected <> nil) and (TIBTreeNode(Selected).KeyValue = KeyValue) then
788 Result := TIBTreeNode(Selected)
789 else
790 {Find it the hard way}
791 begin
792 FullExpand;
793 for i := 0 to Items.Count -1 do
794 if TIBTreeNode(Items[i]).KeyValue = KeyValue then
795 begin
796 Result := TIBTreeNode(Items[i])
797 end;
798 end;
799 end;
800
801 function TIBTreeView.GetNodePath(Node: TTreeNode): TVariantArray;
802 var aParent: TTreeNode;
803 i: integer;
804 begin
805 if not assigned(Node) or not (Node is TIBTreeNode) then
806 SetLength(Result,0)
807 else
808 begin
809 {Count length of Path}
810 i := 1;
811 aParent := Node.Parent;
812 while (aParent <> nil) do
813 begin
814 Inc(i);
815 aParent := aParent.Parent
816 end;
817
818 {Save Path}
819 Setlength(Result,i);
820 while i > 0 do
821 begin
822 Dec(i);
823 Result[i] := TIBTreeNode(Node).KeyValue;
824 Node := Node.Parent
825 end;
826 end;
827 end;
828
829 { TIBTreeViewDatalink }
830
831 procedure TIBTreeViewDatalink.ActiveChanged;
832 begin
833 FOwner.ActiveChanged(self)
834 end;
835
836 procedure TIBTreeViewDatalink.DataSetChanged;
837 begin
838 FOwner.DataSetChanged(self)
839 end;
840
841 procedure TIBTreeViewDatalink.RecordChanged(Field: TField);
842 begin
843 FOwner.RecordChanged(self,Field);
844 end;
845
846 procedure TIBTreeViewDatalink.UpdateData;
847 begin
848 FOwner.UpdateData(self)
849 end;
850
851 constructor TIBTreeViewDatalink.Create(AOwner: TIBTreeView);
852 begin
853 inherited Create;
854 FOwner := AOwner
855 end;
856
857 end.