ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/ibcontrols/IBTreeView.pas
Revision: 143
Committed: Fri Feb 23 12:11:21 2018 UTC (6 years, 9 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/ibcontrols/IBTreeView.pas
File size: 23238 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 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}
341 Reinitialise
342 end
343 else
344 begin
345 AtTopLevel := Items.TopLvlCount = 0;
346 AddNodes;
347 if not FLocatingNode and (Selected = nil) and (Items.TopLvlCount > 0) then
348 begin
349 if Length(FLastSelected) > 0 then
350 Selected := FindNode(FLastSelected,true)
351 else
352 Selected := Items.TopLvlItems[0];
353 end
354 end
355 end;
356
357 procedure TIBTreeView.AddNodes;
358 var Node: TTreeNode;
359 ChildCount: integer;
360 begin
361 if assigned(FExpandNode) or (Items.Count = 0) then
362 begin
363 ChildCount := 0;
364 FNoAddNodeToDataset := true;
365 try
366 DataSet.First;
367 while not DataSet.EOF do
368 begin
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
383 FNoAddNodeToDataset := false
384 end;
385 if assigned(FExpandNode) then
386 FExpandNode.HasChildren := ChildCount > 0;
387 FExpandNode := nil
388 end
389 end;
390
391 procedure TIBTreeView.DataSetChanged(Sender: TObject);
392 begin
393 // Do nothing;
394 end;
395
396 function TIBTreeView.GetDataSet: TDataSet;
397 begin
398 Result := FDataLink.DataSet
399 end;
400
401 function TIBTreeView.GetDataSource: TDataSource;
402 begin
403 Result := FDataLink.DataSource
404 end;
405
406 function TIBTreeView.GetRelationNameQualifier: string;
407 begin
408 if FRelationName <> '' then
409 Result := FRelationName + '.'
410 else
411 Result := ''
412 end;
413
414 function TIBTreeView.GetSelectedKeyValue: variant;
415 begin
416 Result := NULL;
417 if assigned(Selected) and (Selected is TIBTreeNode) then
418 Result := TIBTreeNode(Selected).KeyValue
419 end;
420
421 procedure TIBTreeView.NodeMoved(Node: TTreeNode);
422 begin
423 {Need to update Parent}
424 if ScrollToNode(TIBTreeNode(Node)) then
425 begin
426 FDataLink.Edit;
427 FModifiedNode := TIBTreeNode(Node)
428 end;
429 end;
430
431 procedure TIBTreeView.NodeUpdated(Node: TTreeNode);
432 begin
433 {Need to Update List Field}
434 if ScrollToNode(TIBTreeNode(Node)) then
435 begin
436 FDataLink.Edit;
437 FModifiedNode := TIBTreeNode(Node);
438 FDataLink.UpdateRecord
439 end;
440 end;
441
442 procedure TIBTreeView.RecordChanged(Sender: TObject; Field: TField);
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);
451 if assigned(Node) then
452 begin
453 FUpdating := true;
454 try
455 Node.Text := Field.Text
456 finally
457 FUpdating := false
458 end;
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);
479 if assigned(Node) then
480 begin
481 if DataSet.FieldByName(ParentField).IsNull then
482 Destination := nil
483 else
484 Destination := FindNode(DataSet.FieldByName(ParentField).AsVariant);
485
486 if (Destination = nil) or (Destination = Node.Parent) then Exit;
487
488 FUpdating := true;
489 try
490 Node.MoveTo(Destination,naAddChild);
491 finally
492 FUpdating := false
493 end;
494 end;
495 end
496 end;
497
498 procedure TIBTreeView.SetHasChildField(AValue: string);
499 begin
500 if FHasChildField = AValue then Exit;
501 FHasChildField := AValue;
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;
515 FKeyField := AValue;
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;
529 FTextField := AValue;
530 Reinitialise
531 end;
532
533 procedure TIBTreeView.SetDataSource(AValue: TDataSource);
534 begin
535 FDataLink.DataSource := AValue;
536 IBControlLinkChanged;
537 end;
538
539 procedure TIBTreeView.SetParentField(AValue: string);
540 begin
541 if FParentField = AValue then Exit;
542 FParentField := AValue;
543 Reinitialise
544 end;
545
546 function TIBTreeView.ScrollToNode(Node: TIBTreeNode): boolean;
547 begin
548 Result := assigned(DataSet) and DataSet.Active and assigned(Node) and not varIsNull(Node.KeyValue);
549 if Result then
550 begin
551 if DataSet.Active and (DataSet.RecordCount > 0)
552 and DataSet.Locate(KeyField,Node.KeyValue,[]) then Exit;
553
554 FUpdateNode := Node;
555 try
556 DataSet.Active := false;
557 DataSet.Active := true;
558 finally
559 FUpdateNode := nil
560 end;
561 Result := DataSet.FieldByName(KeyField).AsVariant = Node.KeyValue
562 end;
563 end;
564
565 procedure TIBTreeView.UpdateData(Sender: TObject);
566 begin
567 if assigned(FModifiedNode) then
568 begin
569 DataSet.FieldByName(TextField).AsString := FModifiedNode.Text;
570 if FModifiedNode.Parent = nil then
571 DataSet.FieldByName(ParentField).Clear
572 else
573 DataSet.FieldByName(ParentField).AsVariant := TIBTreeNode(FModifiedNode.Parent).KeyValue;
574 FModifiedNode := nil
575 end
576 end;
577
578 procedure TIBTreeView.UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
579 begin
580 if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
581 begin
582 if DataSource.DataSet is TIBQuery then
583 TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
584 FUpdateNode.KeyValue
585 else
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 DataSource.DataSet is TIBQuery then
594 TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
595 TIBTreeNode(FExpandNode).KeyValue
596 else
597 if DataSource.DataSet is TIBDataSet then
598 TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
599 TIBTreeNode(FExpandNode).KeyValue
600 end;
601 end;
602
603 procedure TIBTreeView.UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
604 begin
605 if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
606 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_KEY_VALUE')
607 else
608 if (Items.Count = 0) then
609 {Need to Load Root Nodes}
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);
620 begin
621 if assigned(DataSet) and DataSet.Active and not FNoAddNodeToDataset then
622 begin
623 DataSet.Append;
624 TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
625 if (Node.Text = '') and not DataSet.FieldByName(TextField).IsNull then
626 Node.Text := DataSet.FieldByName(TextField).AsString;
627 FModifiedNode := TIBTreeNode(Node);
628 FDataLink.UpdateRecord
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.