source: branches/2.19_branch/Components/Outline2.PAS@ 338

Last change on this file since 338 was 15, checked in by RBRi, 19 years ago

+ components stuff

  • Property svn:eol-style set to native
File size: 54.1 KB
Line 
1Unit Outline2;
2
3Interface
4
5Uses
6 Classes, Forms, SysUtils, BseDos;
7
8{
9History
10
11V1.4.13 20/1/1
12Standardised border, use DrawSystemBorder.
13Added smooth scrolling.
14
15V1.4.12 16/9/00
16Added recursive collapse functions. Incl TOutline2.CollapseAll;
17
18V1.4.11 9/8/00
19Small optimisation for adding nodes outside
20of Update...
21If the node is collapsed, don't check refresh
22
23V1.4.10 9/8/00
24Added level and parent functions to TNOde
25
26V1.4.9 9/8/00
27Fixed problem with not setting up scroll bars after update.?
28Draw selected node correctly, with inverted colors.
29
30V1.4.8 31/7/00
31Crap - I damaged the node setting.
32
33V1.4.7 30/7/00
34Improved handling during updates: if the
35selected node is set during update then the new node is
36just saved and applied at end update.
37
38V1.4.6 30/7/00
39When clearing a node's children do it last node first
40for efficiency in list handling.
41
42V1.4.5 30/7/00
43Minor bit of fiddling with child list allocation.
44
45V1.4.4 26/4/00
46Added goto next node up and down
47(includes non-visible nodes; renamed previous
48methods to gotonextVISIBLEnodeup/down)
49
50V1.4.3 26/4/00
51Added page up and down
52
53V1.4.2 26/4/00
54Fixed problem clearing corner rect between scrollbars.
55
56V1.4.1 26/4/00
57Added +/- keyboard commands
58If selected node would be hidden when collapsing then
59make the collapsing node the selected one.
60
61V1.4.0 26/4/00
62Hmm, did I really do nothing for all that time ?
63Anyway, now has keyboard support, home/end/cursor up/down
64
65V1.3.1 12/4/00
66Tree lines have a seperate color
67Limit plus minus size to min 7
68ScanExtents sets lineheight to textheight if textheight is bigger.
69
70V1.3.0 12/4/00
71Optimised a lot more. Now drawing can be just of a single node
72which eliminates most flickering. Made the plus/minus buttons
73show feedback when clicked, exactly like original TOutline.
74
75V1.2.0 11/4/00
76Worked some more on visual aspects:
77- can now draw 3d or flat plus/minus
78- optimise background clearing somewhat (draw per node)
79- can show selected node as whole line or just text
80
81THis reduces flicker but, it coudl be better.
82Main thing to do would be to seperate out the layout:
83
84Function Layout:
85Reads from root to last expanded node. Works out Y position of
86each node and stores in the node. (?)
87
88This would allow node drawing to be done basically independently...
89
90V1.1.0 ???
91Now can set topnode to anything. Will draw
92correctly.
93Added ExpandParents method to help
94}
95
96const
97 AllNodes = nil;
98 WM_MOUSEENTER = $041E;
99 WM_MOUSELEAVE = $041F;
100
101Type
102
103 TNodeFindFunction = function( Data: TObject ): boolean;
104
105 TOutline2 = class;
106
107 TNode = class
108 protected
109 _Text: ^string;
110 _Data: TObject;
111 _Children: TList;
112 _Parent: TNode; // nil if head
113 _Expanded: boolean; // only applicable if _Children.Count> 0
114 _Outline: TOutline2;
115 Function GetChild( index: longint ): TNode;
116 Function IsVisible: boolean;
117 procedure CheckChangeRefresh;
118 Function GetText: string;
119 procedure SetText( const NewText: string );
120 procedure FreeText;
121 public
122 property Children[ index: longint ]: TNode read GetChild;
123 property Text: string read GetText write SetText;
124 property Data: TObject read _Data write _Data;
125
126 constructor Create( Parent: TNode );
127
128 function AddChild( const TheText: string;
129 const TheData: TObject ): TNode;
130 function HasChildren: boolean;
131 function ChildCount: longint;
132
133 procedure Clear; // clear children
134
135 destructor Destroy; override;
136
137 function Level: longint; // 0 is top level.
138 function Parent: TNode; // nil if at top level
139 function FullPath( const Separator: string ): string;
140 function IndexOfChild( Child: TNode ): longint;
141 function IndexInParent: longint;
142 function FindData( DataToFind: TObject ): TNode;
143 function FindByFunction( FindFunction: TNodeFindFunction ): TNode;
144
145 // Returns true if the given node is a parent of
146 // this node
147 function NodeIsAParent( Node: TNode ): boolean;
148
149 property Expanded: boolean read _Expanded;
150 procedure Expand;
151 procedure ExpandChildren( Recursive: boolean );
152
153 // Expand all parents if needed
154 procedure ExpandParents;
155
156 procedure Collapse;
157 procedure CollapseChildren( Recursive: boolean );
158 end;
159
160 TNodePart =
161 (
162 npNothing,
163 npPlusMinus,
164 npBitmap, // not yet implemented
165 npText,
166 npOther
167 );
168
169 TPlusMinusStyle = ( pmFlat, pm3d );
170
171 TNodeEvent = procedure( Node: TNode ) of object;
172
173 TOutline2=Class(TControl)
174 Protected
175 _UpdateCount: integer;
176 _NewSelectedNode: TNode; // during update
177
178 _MouseDownNode: TNode;
179 _MouseDownPart: TNodePart;
180 _MouseDownFeedback: boolean;
181 _LastMouseMoveFeedback: boolean;
182
183 _LastMouseX: longint;
184 _LastMouseY: longint;
185
186 _HScrollbar: TScrollbar;
187 _VScrollbar: TScrollbar;
188 _NeedVScroll, _NeedHScroll: boolean;
189
190 // Scroll information
191 // we use these rather than the scrollbar positions direct,
192 // since those are not updated during tracking
193 FXScroll: longint;
194 FYScroll: longint;
195
196 FLastXScroll: longint;
197 FLastYScroll: longint;
198
199 FSmoothScroll: boolean;
200
201 _Root: TNode;
202
203 _HoverTimer: TTimer;
204 _HintWindow: THintWindow;
205
206 // appearance controls
207 _BorderStyle: TBorderStyle;
208 _ScrollbarWidth: longint;
209 _LineHeight: longint;
210 _AutoLineHeight: boolean;
211 _Indent: longint; // X distance between branches
212 _LeftMargin: longint; // X distance to left of first plus/minus col
213 _TextIndent: longint; // pixels between stub end and text
214 _PlusMinusWidth: longint;
215 _PlusMinusHeight: longint;
216 _StubWidth: longint; // additional distance beyond indent to draw lines
217 _PlusMinusStyle: TPlusMinusStyle;
218 _SelectLine: boolean;
219 _TreeLineColor: TColor;
220
221 _PathSeparator: string;
222
223 _SelectedNode: TNode;
224
225 _OnItemDblClick: TNodeEvent;
226 _OnItemFocus: TNodeEvent;
227 _OnItemClick: TNodeEvent;
228 _OnExpand: TNodeEvent;
229 _OnCollapse: TNodeEvent;
230
231 _DrawNode: TNode; // nil for all
232
233 Procedure SetupComponent; Override;
234
235 Procedure ScanExtents;
236 Procedure ScanNodeExtents( Node: TNode;
237 X: longint;
238 Var MaxX: longint;
239 Var MaxY: longint );
240
241 Function RowIsVisible( Y: longint ): boolean;
242
243 function GetNodePosition( const Node: TNode;
244 Var NodeTop: longint ): boolean;
245 function NodeGetNodePosition( const NodeToFind: TNode;
246 const NodeToScan: TNode;
247 Var NodeTop: longint ): boolean;
248
249 procedure DrawNode( Node: TNode );
250
251 procedure Draw;
252 Procedure DrawBorder;
253 Procedure PaintNode( Node: TNode;
254 X: longint;
255 Var Y: longint );
256
257 procedure DrawPlusMinus( Rect: TRect;
258 Expanded: boolean;
259 Pressed: boolean );
260
261 Procedure TestHit( Point: TPoint;
262 Var Node: TNode;
263 Var Part: TNodePart );
264 Procedure TestNodeHit( Node: TNode;
265 Point: TPoint;
266 X: longint;
267 Var Y: longint;
268 Var HitNode: TNode;
269 Var Part: TNodePart );
270 Procedure SetupScrollbars;
271 function GetDrawRect: TRect;
272 function GetTextRect: TRect;
273 function DrawHeight: longint;
274 function GetLineRect( LineBottom: longint ): TRect;
275 Function GetPlusMinusRect( Left, LineBottom: longint ): TRect;
276
277 Procedure DoHorizontalScroll( NewX: longint );
278 Procedure DoVerticalScroll( NewY: longint );
279
280 // Property handlers
281 Procedure SetSelectedNode( Node: TNode );
282 Procedure SetTopNode( Node: TNode );
283
284 Function GetChild( index: longint ): TNode;
285 Function GetChildCount: longint;
286
287 Procedure SetLineHeight( LineHeight: longint );
288 Procedure SetAutoLineHeight( Value: boolean );
289 Procedure SetIndent( Indent: longint );
290 Procedure SetBorderStyle( BorderStyle: TBorderStyle );
291 Procedure SetScrollbarWidth( ScrollbarWidth: longint );
292 Procedure SetLeftMargin( LeftMargin: longint );
293 Procedure SetTextIndent( TextIndent: longint );
294 Procedure SetPlusMinusWidth( PlusMinusWidth: longint );
295 Procedure SetPlusMinusHeight( PlusMinusHeight: longint );
296 Procedure SetStubWidth( StubWidth: longint );
297 Procedure SetPlusMinusStyle( NewValue: TPlusMinusStyle );
298 Procedure SetSelectLine( NewValue: boolean );
299 Procedure SetTreeLineColor( NewValue: TColor );
300 Public
301 Procedure OnHoverTimeout( Sender: TObject );
302 // PM Events
303 Procedure Redraw( const rec: TRect ); Override;
304 Procedure Resize; override;
305 Procedure MouseDblClick( Button: TMouseButton;
306 ShiftState: TShiftState;
307 X, Y: Longint ); override;
308 Procedure MouseDown( Button: TMouseButton;
309 ShiftState: TShiftState;
310 X, Y: Longint ); override;
311 Procedure MouseUp( Button: TMouseButton;
312 ShiftState: TShiftState;
313 X, Y: Longint ); override;
314 Procedure MouseMove( ShiftState: TShiftState;
315 X, Y: Longint ); override;
316
317 Procedure Scroll( Sender: TScrollbar;
318 ScrollCode: TScrollCode;
319 Var ScrollPos: Longint ); override;
320
321 Procedure SetupShow; override;
322
323 Procedure ScanEvent( Var KeyCode: TKeyCode;
324 RepeatCount: Byte ); override;
325 Procedure CharEvent( Var Key: Char;
326 RepeatCount: Byte ); override;
327 Procedure WMMouseLeave( Var Msg: TMessage ); message WM_MOUSELEAVE;
328
329 Procedure FontChange; override;
330
331 Procedure SetFocus; override;
332 Procedure KillFocus; override;
333 published
334 property Align;
335 property Color;
336 property Font;
337 property ParentColor;
338 property ParentFont;
339 property ParentPenColor;
340 property ParentShowHint;
341 property PenColor;
342 property PopupMenu;
343 property ShowHint;
344 Property TabOrder;
345 Property TabStop;
346 property Visible;
347 property ZOrder;
348
349 property LineHeight: longint read _LineHeight write SetLineHeight;
350 property AutoLineHeight: boolean read _AutoLineHeight write SetAutoLineHeight;
351 property Indent: longint read _Indent write SetIndent;
352 property BorderStyle: TBorderStyle read _BorderStyle write SetBorderStyle;
353 property ScrollbarWidth: longint read _ScrollbarWidth write SetScrollbarWidth;
354 property LeftMargin: longint read _LeftMargin write SetLeftMargin;
355 property TextIndent: longint read _TextIndent write SetTextIndent;
356 property PlusMinusWidth: longint read _PlusMinusWidth write SetPlusMinusWidth;
357 property PlusMinusHeight: longint read _PlusMinusHeight write SetPlusMinusHeight;
358 property StubWidth: longint read _StubWidth write SetStubWidth;
359 property PlusMinusStyle: TPlusMinusStyle read _PlusMinusStyle write SetPlusMinusStyle;
360 property SelectLine: boolean read _SelectLine write SetSelectLine;
361 property TreeLineColor: TColor read _TreeLineColor write SetTreeLineColor;
362
363 property SmoothScroll: boolean read FSmoothScroll write FSmoothScroll;
364
365 property PathSeparator:string read _PathSeparator write _PathSeparator;
366
367 property OnItemDblClick: TNodeEvent read _OnItemDblClick write _OnItemDblClick;
368 property OnItemFocus: TNodeEvent read _OnItemFocus write _OnItemFocus;
369 property OnItemClick: TNodeEvent read _OnItemClick write _OnItemClick;
370 property OnExpand: TNodeEvent read _OnExpand write _OnExpand;
371 property OnCollapse: TNodeEvent read _OnCollapse write _OnCollapse;
372 property OnClick;
373 property OnDblClick;
374 property OnDragOver;
375 property OnDragDrop;
376 property OnEndDrag;
377 Property OnEnter;
378 Property OnExit;
379 Property OnFontChange;
380 Property OnHide;
381 property OnKeyPress;
382 Property OnResize;
383 Property OnScan;
384 Property OnSetupShow;
385 Property OnShow;
386
387 public
388
389 procedure Clear;
390
391 function AddChild( const TheText: string;
392 const TheObject: TObject ): TNode;
393 property Children[ index: longint ]: TNode read GetChild;
394 property ChildCount: longint read GetChildCount;
395
396 procedure BeginUpdate;
397 procedure EndUpdate;
398
399 Destructor Destroy; Override;
400
401 function NextNodeUp( Node: TNode;
402 VisibleOnly: boolean ): TNode;
403 function NextNodeDown( Node: TNode;
404 VisibleOnly: boolean ): TNode;
405 function LastVisibleNode: TNode;
406
407 Procedure GotoFirstNode;
408 Procedure GotoLastVisibleNode;
409
410 // The following 4 functions return false if
411 // they could not do the requested movement
412 function GotoNextVisibleNodeUp: boolean;
413 function GotoNextVisibleNodeDown: boolean;
414 function GotoNextNodeUp: boolean;
415 function GotoNextNodeDown: boolean;
416
417 Procedure PageUp;
418 Procedure PageDown;
419
420 Procedure ExpandAll;
421 Procedure CollapseAll;
422
423 // search for a node which starts with the given text
424 // Note: if you use VisibleOnly true, then make sure you
425 // start with a visible node!!
426 Function FindNextNodeByText( StartNode: TNode;
427 const S: string;
428 VisibleOnly: boolean ): TNode;
429
430{ Procedure ScrollUpLine;
431 Procedure ScrollDownLine;
432 Procedure ScrollUpPage;
433 Procedure ScrollDownPage;
434}
435{ Procedure ScrollLeftLine;
436 Procedure ScrollRightLine;
437 Procedure ScrollLeftPage;
438 Procedure ScrollRightPage;
439}
440 property SelectedNode: TNode read _SelectedNode write SetSelectedNode;
441 procedure SetSelectedObject( Data: TObject );
442 function NodeFromObject( Data: TObject ): TNode;
443 function FindByFunction( FindFunction: TNodeFindFunction ): TNode;
444
445// property TopNode: TNode read _TopNode write SetTopNode;
446 End;
447
448{Define components to export}
449{You may define a page of the component palette and a component bitmap file}
450Exports
451 TOutline2,'User','Outline2.bmp';
452
453Implementation
454
455uses
456 Messages,
457 ACLStringUtility,
458 ControlScrolling;
459
460// ============================================================================
461// Node implementation
462// ============================================================================
463
464Function TNode.IsVisible: boolean;
465var
466 Node: TNode;
467begin
468 Result:= true;
469 Node:= self;
470 while Node._Parent <> nil do
471 begin
472 Node:= Node._Parent;
473 if not Node._Expanded then
474 Result:= false;
475 end;
476end;
477
478// Call when a node changes (add, delete, rename, collapse/expand )
479procedure TNode.CheckChangeRefresh;
480begin
481 if _Outline.Handle = 0 then
482 exit;
483
484 if _Outline._UpdateCount > 0 then
485 exit;
486
487 if IsVisible then
488 begin
489 _Outline.ScanExtents;
490 _Outline.Refresh;
491 end;
492end;
493
494function TNode.GetText: string;
495begin
496 Result:= _Text^;
497end;
498
499procedure TNode.FreeText;
500begin
501 if _Text <> nil then
502 FreeMem( _Text, Length( _Text^ ) + 1 );
503end;
504
505procedure TNode.SetText( const NewText: string );
506begin
507 FreeText;
508 GetMem( _Text, Length( NewText ) + 1 );
509 _Text^:= NewText;
510end;
511
512function TNode.AddChild( const TheText: string;
513 const TheData: TObject ): TNode;
514Var
515 NewNode: TNode;
516Begin
517 NewNode:= TNode.Create( self );
518 NewNode.Text:= TheText;
519 NewNode.Data:= TheData;
520 NewNode._Outline:= _Outline;
521
522 if _Children.Count = 0 then
523 _Children.Capacity:= 4;
524
525 _Children.Add( NewNode );
526 Result:= NewNode;
527
528 if _Expanded
529 or ( _Children.Count = 1 ) // we just added first child; need to display +
530 then
531 CheckChangeRefresh;
532End;
533
534function TNode.IndexOfChild( Child: TNode ): longint;
535begin
536 Result:= _Children.IndexOf( Child );
537end;
538
539function TNode.NodeIsAParent( Node: TNode ): boolean;
540begin
541 if _Parent = _Outline._Root then
542 Result:= false
543 else if _Parent = Node then
544 Result:= true
545 else
546 Result:= _Parent.NodeIsAParent( Node );
547end;
548
549function TNode.IndexInParent: longint;
550begin
551 if _Parent = nil then
552 result:= -1
553 else
554 Result:= _Parent.IndexOfChild( Self );
555end;
556
557procedure TNode.ExpandChildren( Recursive: boolean );
558Var
559 ChildIndex: longint;
560 Child: TNode;
561begin
562 _Outline.BeginUpdate;
563 for ChildIndex:= 0 to _Children.Count - 1 do
564 begin
565 Child:= _Children[ ChildIndex ];
566 Child.Expand;
567 if Recursive then
568 Child.ExpandChildren( true );
569 end;
570 _Outline.EndUpdate;
571end;
572
573procedure TNode.CollapseChildren( Recursive: boolean );
574Var
575 ChildIndex: longint;
576 Child: TNode;
577begin
578 _Outline.BeginUpdate;
579 for ChildIndex:= 0 to _Children.Count - 1 do
580 begin
581 Child:= _Children[ ChildIndex ];
582 Child.Collapse;
583 if Recursive then
584 Child.CollapseChildren( true );
585 end;
586 _Outline.EndUpdate;
587end;
588
589function TNode.FindData( DataToFind: TObject ): TNode;
590Var
591 ChildIndex: longint;
592 Child: TNode;
593begin
594 if _Parent <> nil then
595 // not root...
596 if Data = DataToFind then
597 begin
598 Result:= self;
599 exit;
600 end;
601 for ChildIndex:= 0 to _Children.Count - 1 do
602 begin
603 Child:= _Children[ ChildIndex ];
604 Result:= Child.FindData( DataToFind );
605 if Result <> nil then
606 exit;
607 end;
608 Result:= nil;
609end;
610
611function TNode.FindByFunction( FindFunction: TNodeFindFunction ): TNode;
612Var
613 ChildIndex: longint;
614 Child: TNode;
615 d: TObject;
616begin
617 if _Parent <> nil then
618 begin
619 // not root...
620 d:= Data;
621 if FindFunction( Data ) then
622 begin
623 Result:= self;
624 exit;
625 end;
626 end;
627 for ChildIndex:= 0 to _Children.Count - 1 do
628 begin
629 Child:= _Children[ ChildIndex ];
630 Result:= Child.FindByFunction( FindFunction );
631 if Result <> nil then
632 exit;
633 end;
634 Result:= nil;
635end;
636
637constructor TNode.Create( Parent: TNode );
638Begin
639 _Parent:= Parent;
640 _Children:= TList.Create;
641 _Expanded:= false;
642 _Text:= nil;
643End;
644
645procedure TNode.Clear;
646begin
647 // Delete children
648 // (They will remove themselves from us)
649 // Remove them from end of list first for efficiency.
650 while _Children.Count > 0 do
651 TNode( _Children[ _Children.Count - 1 ] ).Destroy;
652end;
653
654destructor TNode.Destroy;
655Begin
656 Clear;
657 _Children.Destroy;
658 // Delete self from parent
659 if _Parent <> nil then
660 _Parent._Children.Remove( self );
661
662 if _Outline._NewSelectedNode = self then
663 _Outline._NewSelectedNode := nil;
664
665 if _Outline._SelectedNode = self then
666 _Outline.SetSelectedNode( nil );
667
668 FreeText;
669 CheckChangeRefresh;
670End;
671
672function TNode.ChildCount: longint;
673Begin
674 Result:= _Children.Count;
675End;
676
677function TNode.HasChildren: boolean;
678Begin
679 Result:= _Children.Count > 0;
680End;
681
682Function TNode.GetChild( index: longint ): TNode;
683Begin
684 Result:= _Children[ index ];
685End;
686
687function TNode.Level: longint;
688Var
689 NextNode: TNode;
690Begin
691 Result:= -1; // since root is a special case
692 NextNode:= _Parent;
693 while NextNode <> nil do
694 begin
695 inc( Result );
696 NextNode:= NextNode._Parent;
697 end;
698End;
699
700Function TNode.Parent: TNode;
701begin
702 if _Parent = nil then
703 Result:= nil
704 else if _Parent._Parent = nil then
705 Result:= nil // parent is really root but we don't want to give access to root
706 else
707 Result:= _Parent;
708end;
709
710Function TNode.FullPath( const Separator: string ): string;
711Var
712 NextNode: TNode;
713Begin
714 Result:= Text;
715 NextNode:= _Parent;
716 while NextNode <> nil do
717 begin
718 Result:= NextNode.Text + Separator + Result;
719 NextNode:= NextNode._Parent;
720 end;
721End;
722
723procedure TNode.Expand;
724begin
725 if _Expanded then
726 exit;
727 _Expanded:= true;
728 if Assigned( _Outline._OnExpand ) then
729 _Outline._OnExpand( self );
730 CheckChangeRefresh;
731end;
732
733procedure TNode.Collapse;
734begin
735 if not _Expanded then
736 exit;
737 if _Outline.SelectedNode <> nil then
738 if _Outline.SelectedNode.NodeIsAParent( Self ) then
739 // selected node is in collapsed nodes, make ourself the selected one
740 _Outline._SelectedNode:= Self;
741 if Assigned( _Outline._OnCollapse ) then
742 _Outline._OnCollapse( self );
743 _Expanded:= false;
744 CheckChangeRefresh;
745end;
746
747// Returns true if a row starting at Y will be at least partially visible
748Function TOutline2.RowIsVisible( Y: longint ): boolean;
749begin
750 Result:= ( Y < Height + _LineHeight ) and ( Y >= 0 );
751end;
752
753// ============================================================================
754// Outline component implementation
755// ============================================================================
756
757Procedure TOutline2.ScanExtents;
758Var
759 ChildIndex: longint;
760 MaxWidth, MaxHeight: longint;
761 AvailableHeight: longint;
762 AvailableWidth: longint;
763 TextRect: TRect;
764 TextHeight: longint;
765Begin
766 if csDesigning in ComponentState then
767 exit;
768 if Handle = 0 then
769 exit;
770
771 MaxWidth:= 0;
772 MaxHeight:= 0;
773 _NeedVScroll:= false;
774 _NeedHScroll:= false;
775
776 TextRect:= GetTextRect;
777 AvailableWidth:= TextRect.Right - TextRect.Left;
778 AvailableHeight:= TextRect.Top - TextRect.Bottom;
779
780 TextHeight:= Canvas.TextHeight( 'H' );
781 if TextHeight > _LineHeight then
782 _LineHeight := TextHeight;
783
784 // draw children
785 for ChildIndex:= 0 to _Root.ChildCount - 1 do
786 begin
787 ScanNodeExtents( _Root.Children[ ChildIndex ],
788 0,
789 MaxWidth,
790 MaxHeight );
791 end;
792
793 if MaxWidth > AvailableWidth then
794 begin
795 // will need horizontal scroll bar...
796 _NeedHScroll:= true;
797 dec( AvailableHeight, _ScrollBarWidth );
798 end;
799
800 if MaxHeight > AvailableHeight then
801 begin
802 // will need vertical scroll bar
803 _NeedVScroll:= true;
804 dec( AvailableWidth, _ScrollBarWidth );
805 if _NeedHScroll = false then
806 // check if we need one now,
807 if MaxWidth > AvailableWidth then
808 begin
809 // will need horizontal scroll bar after all
810 dec( AvailableHeight, _ScrollBarWidth );
811 _NeedHScroll:= true;
812 end;
813 end;
814
815 if _NeedVScroll then
816 begin
817 if _VScrollBar.Position > ( MaxHeight - AvailableHeight ) then
818 _VScrollBar.Position:= MaxHeight - AvailableHeight;
819
820 _VScrollBar.Min:= 0;
821 _VScrollBar.Max:= MaxHeight;
822 _VScrollBar.SliderSize:= AvailableHeight;
823 _VScrollBar.SmallChange:= _LineHeight;
824 _VScrollBar.LargeChange:= AvailableHeight div 2;
825 end
826 else
827 // everything will fit vertically.
828 _VScrollBar.Position:= 0;
829
830 if _NeedHScroll then
831 begin
832 if _HScrollBar.Position > ( MaxWidth - AvailableWidth ) then
833 _HScrollBar.Position:= MaxWidth - AvailableWidth;
834
835 _HScrollBar.Min:= 0;
836 _HScrollBar.Max:= MaxWidth;
837 _HScrollBar.SliderSize:= AvailableWidth;
838 _HScrollBar.SmallChange:= _LineHeight;
839 _HScrollBar.LargeChange:= AvailableWidth div 2;
840 end
841 else
842 // everything will fit horizontally
843 _HScrollBar.Position:= 0; // no offset
844
845 SetupScrollBars;
846End;
847
848Procedure TOutline2.ScanNodeExtents( Node: TNode;
849 X: longint;
850 Var MaxX: longint;
851 Var MaxY: longint );
852Var
853 ChildIndex: longint;
854 TextW, TextH: longint;
855 TextX: longint;
856
857Begin
858 Canvas.GetTextExtent( Node.Text, TextW, TextH );
859 TextX:= X + _PlusMinusWidth + _StubWidth + _TextIndent;
860
861 if TextX + TextW > MaxX then
862 MaxX:= TextX + TextW;
863
864 inc( MaxY, _LineHeight );
865
866 if Node.ChildCount > 0 then
867 if Node._Expanded then
868 // check children
869 for ChildIndex:= 0 to Node.ChildCount-1 do
870 ScanNodeExtents( Node.Children[ ChildIndex ],
871 X + Indent,
872 MaxX,
873 MaxY );
874
875End;
876
877function TOutline2.GetDrawRect: TRect;
878begin
879 Result := ClientRect;
880 if _NeedHScroll then
881 inc( Result.Bottom, _ScrollbarWidth );
882 if _NeedVScroll then
883 dec( Result.Right, _ScrollbarWidth );
884end;
885
886function TOutline2.GetTextRect: TRect;
887begin
888 Result := GetDrawRect;
889 if _BorderStyle <> bsNone then
890 InflateRect( Result, -2, -2 );
891end;
892
893function TOutline2.DrawHeight: longint;
894begin
895 Result := ClientRect.Top - ClientRect.Bottom;
896 if _NeedHScroll then
897 dec( Result, _ScrollbarWidth );
898
899 if _BorderStyle <> bsNone then
900 begin
901 dec( Result, 2 ); // top border
902 if not _NeedHScroll then
903 dec( Result, 2 ); // bottom border
904 end;
905end;
906
907Procedure TOutline2.Redraw( const rec: TRect );
908Var
909 OldClip: TRect;
910 TextRect: TRect;
911Begin
912 OldClip:= Canvas.ClipRect;
913
914 if csDesigning in ComponentState then
915 begin
916 _NeedVScroll:= false;
917 _NeedHScroll:= false;
918 DrawBorder;
919 Canvas.FillRect( GetTextRect, Color );
920 exit;
921 end;
922
923 FYScroll:= _VScrollBar.Position;
924 FLastYScroll:= FYScroll;
925 FXScroll:= _HScrollBar.Position;
926 FLastXScroll:= FXScroll;
927
928 DrawBorder;
929
930 TextRect:= GetTextRect;
931 Canvas.ClipRect:= IntersectRect( rec, TextRect );
932
933 _DrawNode:= AllNodes;
934 Draw;
935
936 Canvas.ClipRect:= OldClip;
937
938end;
939
940procedure TOutline2.DrawNode( Node: TNode );
941var
942 OldClip: TRect;
943 TextRect: TRect;
944begin
945 if Node = nil then
946 exit;
947 if InDesigner then
948 exit;
949 if Handle = 0 then
950 exit;
951 _DrawNode:= Node;
952
953 TextRect:= GetTextRect;
954 OldClip:= Canvas.ClipRect;
955 Canvas.ClipRect:= TextRect;
956
957 Draw;
958
959 Canvas.ClipRect:= OldClip;
960end;
961
962procedure TOutline2.Draw;
963var
964 Y: longint;
965 ChildIndex: longint;
966 TextRect: Trect;
967begin
968 TextRect:= GetTextRect;
969
970 Y:= TextRect.Top + _VScrollBar.Position + 1;
971
972 // draw children
973 for ChildIndex:= 0 to _Root.ChildCount - 1 do
974 begin
975 PaintNode( _Root.Children[ ChildIndex ],
976 _LeftMargin - _HScrollBar.Position,
977 Y );
978 if y < 0 then
979 break;
980 end;
981
982 // clear remainder -
983 if Y>0 then
984 begin
985 TextRect.Top:= Y - 1;
986 Canvas.FillRect( TextRect, Color );
987 end;
988End;
989
990Procedure TOutline2.DrawBorder;
991var
992 Rect: TRect;
993 CornerRect: TRect;
994begin
995 Rect:= GetDrawRect;
996 DrawSystemBorder( Self, Rect, _BorderStyle );
997 if _NeedHScroll and _NeedVScroll then
998 begin
999 CornerRect.Left:= Width - _ScrollBarWidth;
1000 CornerRect.Bottom:= 0;
1001 CornerRect.Right:= Width;
1002 CornerRect.Top:= _ScrollBarWidth;
1003 Canvas.ClipRect:= IntersectRect( Canvas.ClipRect, CornerRect );
1004 Canvas.FillRect( CornerRect, Parent.Color );
1005 end;
1006end;
1007
1008Procedure DrawDottedRect( Canvas: TCanvas; Rect: TRect );
1009var
1010 OldStyle: TPenStyle;
1011begin
1012 OldStyle:= Canvas.Pen.Style;
1013 Canvas.Pen.Style:= psInsideFrame; // psAlternate for SPCC v2.5+
1014 Canvas.MoveTo( Rect.Left, Rect.Bottom - 1 );
1015 Canvas.LineTo( Rect.Left, Rect.Top );
1016 Canvas.LineTo( Rect.Right, Rect.Top );
1017 Canvas.LineTo( Rect.Right, Rect.Bottom );
1018 Canvas.LineTo( Rect.Left, Rect.Bottom );
1019 Canvas.Pen.Style:= OldStyle;
1020end;
1021
1022procedure TOutline2.DrawPlusMinus( Rect: TRect;
1023 Expanded: boolean;
1024 Pressed: boolean );
1025var
1026 CentreY: integer;
1027 CentreX: integer;
1028begin
1029 CentreY:= ( Rect.Top + Rect.Bottom ) div 2;
1030 CentreX:= ( Rect.Left + Rect.Right ) div 2;
1031
1032 Canvas.Pen.Color:= clBlack;
1033
1034 case _PlusMinusStyle of
1035 pmFlat:
1036 begin
1037 if Pressed then
1038 Canvas.FillRect( Rect, clHighlight );
1039 DrawDottedRect( Canvas, Rect );
1040 end;
1041
1042 pm3d:
1043 begin
1044 Canvas.Rectangle( Rect );
1045
1046 InflateRect( Rect, -1, -1 );
1047 Canvas.FillRect( Rect, clLtGray );
1048 if Pressed then
1049 Canvas.ShadowedBorder( Rect,
1050 clDkGray,
1051 clWhite )
1052 else
1053 Canvas.ShadowedBorder( Rect,
1054 clWhite,
1055 clDkGray );
1056 end;
1057 end;
1058
1059 // draw minus
1060 Canvas.Line( Rect.Left + 2, CentreY,
1061 Rect.Right - 2, CentreY );
1062
1063 if not Expanded then
1064 // draw vertical stroke of +
1065 Canvas.Line( CentreX, Rect.Top - 2,
1066 CentreX, Rect.Bottom + 2 );
1067end;
1068
1069Function TOutline2.GetPlusMinusRect( Left, LineBottom: longint ): TRect;
1070Var
1071 CentreY: longint;
1072Begin
1073 CentreY:= LineBottom + _LineHeight div 2;
1074
1075 Result.Left:= Left;
1076 Result.Right:= Left + _PlusMinusWidth - 1;
1077 Result.Bottom:= CentreY - _PlusMinusHeight div 2;
1078 Result.Top:= Result.Bottom + _PlusMinusHeight - 1;
1079end;
1080
1081Function TOutline2.GetLineRect( LineBottom: longint ): TRect;
1082begin
1083 Result:= GetTextRect;
1084
1085 Result.Top:= LineBottom + _LineHeight - 1;
1086 Result.Bottom:= LineBottom;
1087end;
1088
1089Procedure TOutline2.PaintNode( Node: TNode;
1090 X: longint;
1091 Var Y: longint );
1092Var
1093 ChildIndex: longint;
1094 CentrePMX: longint;
1095 CentreY: longint;
1096 ChildCentreY: longint;
1097 TextW, TextH: longint;
1098 PlusMinusRect: TRect;
1099 TextX: longint;
1100 LineRect: TRect;
1101 SelectedRect: TRect;
1102Begin
1103 dec( Y, _LineHeight );
1104
1105 PlusMinusRect:= GetPlusMinusRect( X, Y );
1106
1107 CentrePMX:= X + _PlusMinusWidth div 2;
1108 CentreY:= Y + _LineHeight div 2;
1109
1110 if ( ( _DrawNode = AllNodes )
1111 or ( Node = _DrawNode ) )
1112 and ( Y + _LineHeight >= Canvas.ClipRect.Bottom ) // line top above bottom
1113 and ( Y <= Canvas.ClipRect.Top ) // line bottom below top
1114 then
1115 begin
1116 Canvas.GetTextExtent( Node.Text, TextW, TextH );
1117 TextX:= PlusMinusRect.Right + _StubWidth + _TextIndent;
1118
1119 LineRect:= GetLineRect( Y );
1120
1121 if Node = _SelectedNode then
1122 begin
1123 Canvas.Pen.Color:= clHighlightText;
1124 Canvas.Brush.Color:= clHighlight;
1125 if _SelectLine then
1126 SelectedRect:= LineRect
1127 else
1128 begin
1129 SelectedRect.Left:= TextX - _TextIndent div 2;
1130 SelectedRect.Top:= CentreY + TextH div 2 - 1;
1131 SelectedRect.Right:= TextX + TextW + _TextIndent div 2;
1132 SelectedRect.Bottom:= SelectedRect.Top - TextH + 1;
1133 // clear line
1134 Canvas.FillRect( LineRect, Color );
1135 end;
1136
1137 // Draw selected background (either whole line, or just text background)
1138 Canvas.FillRect( SelectedRect, clHighLight );
1139
1140 if HasFocus then
1141 Canvas.DrawFocusRect( SelectedRect );
1142 end
1143 else
1144 begin
1145 // Clear line
1146 Canvas.FillRect( LineRect, Color );
1147 Canvas.Pen.Color:= PenColor;
1148 Canvas.Brush.Color:= Color;
1149 end;
1150
1151 // Draw text
1152 Canvas.Brush.Mode:= bmTransparent;
1153 Canvas.TextOut( TextX,
1154 CentreY - TextH div 2,
1155 Node.Text );
1156
1157 if Node.ChildCount > 0 then
1158 begin
1159 // draw plus/minus
1160 DrawPlusMinus( PlusMinusRect,
1161 Node._Expanded,
1162 ( _MouseDownNode = Node )
1163 and ( _MouseDownPart = npPlusMinus )
1164 and ( _MouseDownFeedback ) );
1165 // Draw stub from plus/minus
1166 if _StubWidth > 0 then
1167 begin
1168 Canvas.Pen.Color:= _TreeLineColor;
1169 Canvas.Line( PlusMinusRect.Right + 1,
1170 CentreY,
1171 PlusMinusRect.Right + _StubWidth,
1172 CentreY );
1173 end;
1174
1175 end
1176 else
1177 begin
1178 // no children
1179 if Node._Parent <> _Root then
1180 begin
1181 Canvas.Pen.Color:= _TreeLineColor;
1182 // draw stub, no Plus minus
1183 Canvas.Line( X,
1184 CentreY,
1185 PlusMinusRect.Right + _StubWidth,
1186 CentreY );
1187 end;
1188 end;
1189 end;
1190
1191 if ( Node.ChildCount > 0 )
1192 and Node._Expanded then
1193 begin
1194 // draw children
1195 for ChildIndex:= 0 to Node.ChildCount-1 do
1196 begin
1197 // make sure truncation of the half pixel works same as for parent
1198 ChildCentreY:= Y - _LineHeight + _LineHeight div 2;
1199 if y < 0 then
1200 break;
1201 PaintNode( Node.Children[ ChildIndex ],
1202 X + Indent,
1203 Y );
1204 Canvas.Pen.Color:= _TreeLineColor;
1205 Canvas.Line( CentrePMX,
1206 ChildCentreY,
1207 X + _Indent,
1208 ChildCentreY );
1209 end;
1210
1211 // draw vertical branch line
1212 Canvas.Pen.Color:= _TreeLineColor;
1213 Canvas.Line( CentrePMX,
1214 PlusMinusRect.Bottom - 1,
1215 CentrePMX,
1216 ChildCentreY );
1217 end;
1218
1219End;
1220
1221// Outline component implementation
1222Procedure TOutline2.TestHit( Point: TPoint;
1223 Var Node: TNode;
1224 Var Part: TNodePart );
1225Var
1226 ChildIndex: longint;
1227 Y: longint;
1228 DrawRect: TRect;
1229Begin
1230 Node:= nil;
1231
1232 DrawRect:= GetDrawRect;
1233 if ( Point.X < DrawRect.Left )
1234 or ( Point.X > DrawRect.Right )
1235 or ( Point.Y > DrawRect.Top )
1236 or ( Point.Y < DrawRect.Bottom ) then
1237 exit;
1238
1239 Y:= DrawRect.Top + _VScrollBar.Position;
1240
1241 // test children
1242 for ChildIndex:= 0 to _Root.ChildCount - 1 do
1243 begin
1244 TestNodeHit( _Root.Children[ ChildIndex ],
1245 Point,
1246 _LeftMargin - _HScrollBar.Position,
1247 Y,
1248 Node,
1249 Part );
1250 if Node <> nil then
1251 break;
1252 if Y < 0 then
1253 break;
1254 end;
1255
1256End;
1257
1258Procedure TOutline2.TestNodeHit( Node: TNode;
1259 Point: TPoint;
1260 X: longint;
1261 Var Y: longint;
1262 Var HitNode: TNode;
1263 Var Part: TNodePart );
1264Var
1265 ChildIndex: longint;
1266 TextW, TextH: longint;
1267 TextX: longint;
1268 PlusMinusRect: TRect;
1269 CentreY: longint;
1270 TextRect: TRect;
1271Begin
1272
1273 dec( Y, _LineHeight );
1274
1275 if ( Point.Y >= Y )
1276 and ( Point.Y < Y + _LineHeight ) then
1277 begin
1278 // this node. What part?
1279
1280 HitNode:= Node;
1281
1282 CentreY:= Y + _LineHeight div 2;
1283
1284 PlusMinusRect:= GetPlusMinusRect( X, Y );
1285
1286 if PointInRect( Point, PlusMinusRect ) then
1287 begin
1288 Part:= npPlusMinus;
1289 exit;
1290 end;
1291
1292 Canvas.GetTextExtent( Node.Text, TextW, TextH );
1293 TextX:= X + _PlusMinusWidth + _StubWidth + _TextIndent;
1294 TextRect.Left:= TextX;
1295 TextRect.Right:= TextX + TextW;
1296 TextRect.Top:= CentreY + TextH div 2;
1297 TextRect.Bottom:= TextRect.Top + TextH;
1298
1299 if PointInRect( Point, TextRect ) then
1300 begin
1301 Part:= npText;
1302 exit;
1303 end;
1304
1305 // bitmap...
1306
1307 Part:= npOther;
1308 exit;
1309 end;
1310
1311 if Node.ChildCount > 0 then
1312 if Node._Expanded then
1313 // check children
1314 for ChildIndex:= 0 to Node.ChildCount-1 do
1315 begin
1316 TestNodeHit( Node.Children[ ChildIndex ],
1317 Point,
1318 X + Indent,
1319 Y,
1320 HitNode,
1321 Part );
1322 if HitNode <> nil then
1323 break;
1324 if y < 0 then
1325 break;
1326 end;
1327
1328End;
1329
1330// Finds the distance from the top of the given node.
1331function TOutline2.GetNodePosition( const Node: TNode;
1332 Var NodeTop: longint ): boolean;
1333Var
1334 ChildIndex: longint;
1335 DrawRect: TRect;
1336Begin
1337 DrawRect:= GetDrawRect;
1338
1339 NodeTop:= 0;
1340
1341 // test children
1342 for ChildIndex:= 0 to _Root.ChildCount - 1 do
1343 begin
1344 if NodeGetNodePosition( Node,
1345 _Root.Children[ ChildIndex ],
1346 NodeTop ) then
1347 begin
1348 Result:= true;
1349 NodeTop:= - NodeTop;
1350 exit;
1351 end;
1352 end;
1353 Result:= false;
1354End;
1355
1356function TOutline2.NodeGetNodePosition( const NodeToFind: TNode;
1357 const NodeToScan: TNode;
1358 Var NodeTop: longint ): boolean;
1359Var
1360 ChildIndex: longint;
1361Begin
1362 if NodeToFind = NodeToScan then
1363 begin
1364 Result:= true;
1365 exit;
1366 end;
1367
1368 dec( NodeTop, _LineHeight );
1369
1370 if NodeToScan.ChildCount > 0 then
1371 if NodeToScan._Expanded then
1372 // check children
1373 for ChildIndex:= 0 to NodeToScan.ChildCount-1 do
1374 begin
1375 if NodeGetNodePosition( NodeToFind,
1376 NodeToScan.Children[ ChildIndex ],
1377 NodeTop ) then
1378 begin
1379 Result:= true;
1380 exit;
1381 end;
1382 end;
1383 Result:= false;
1384End;
1385
1386Procedure TOutline2.SetSelectedNode( Node: TNode );
1387var
1388 OldSelectedNode: TNode;
1389 NodePosition: longint;
1390 DrawRect: TRect;
1391 DrawHeight: longint;
1392 OldScroll: longint;
1393begin
1394 if _UpdateCount > 0 then
1395 begin
1396 _NewSelectedNode:= Node;
1397 exit;
1398 end;
1399
1400 if _SelectedNode = Node then
1401 exit;
1402
1403 OldSelectedNode:= _SelectedNode;
1404
1405 _SelectedNode:= Node;
1406
1407 if Node = nil then
1408 begin
1409 DrawNode( OldSelectedNode ); // clear old
1410 exit;
1411 end;
1412
1413 if not Node.IsVisible then
1414 _SelectedNode.ExpandParents // this will refresh the whole thing...
1415 else
1416 DrawNode( OldSelectedNode ); // clear old
1417
1418 DrawRect:= GetDrawRect;
1419 DrawHeight:= DrawRect.Top - DrawRect.Bottom;
1420
1421 OldScroll:= _VScrollBar.Position;
1422 if GetNodePosition( Node, NodePosition ) then
1423 begin
1424 if NodePosition + _LineHeight > _VScrollBar.Position + DrawHeight then
1425 // Node is below bottom of control - scroll down
1426 _VScrollBar.Position:= NodePosition - DrawHeight + _LineHeight;
1427
1428 if NodePosition < _VScrollBar.Position then
1429 // Node is aobve top of control - scroll up
1430 _VScrollBar.Position:= NodePosition;
1431 end;
1432
1433
1434 // draw new
1435 if OldScroll = _VScrollBar.Position then
1436 DrawNode( _SelectedNode )
1437 else
1438 Refresh;
1439
1440 if _OnItemFocus <> nil then
1441 _OnItemFocus( Node );
1442
1443end;
1444
1445Procedure TOutline2.SetTopNode( Node: TNode );
1446var
1447 NodePosition: longint;
1448begin
1449 Node.ExpandParents;
1450
1451 if GetNodePosition( Node, NodePosition ) then
1452 begin
1453 _VScrollBar.Position:= NodePosition;
1454 end;
1455end;
1456
1457Procedure TOutline2.SetAutoLineHeight( Value: boolean );
1458begin
1459 _AutoLineHeight := Value;
1460 if Value then
1461 FontChange;
1462end;
1463
1464Procedure TOutline2.SetLineHeight( LineHeight: longint );
1465begin
1466 if LineHeight < _PlusMinusHeight + 1 then
1467 LineHeight := _PlusMinusHeight + 1;
1468 if _LineHeight = LineHeight then
1469 exit;
1470 _LineHeight:= LineHeight;
1471 ScanExtents;
1472 Refresh;
1473end;
1474
1475Procedure TOutline2.SetIndent( Indent: longint );
1476begin
1477 if _Indent = Indent then
1478 exit;
1479
1480 _Indent:= Indent;
1481 ScanExtents;
1482 Refresh;
1483end;
1484
1485Procedure TOutline2.SetBorderStyle( BorderStyle: TBorderStyle );
1486begin
1487 if _BorderStyle = BorderStyle then
1488 exit;
1489 _BorderStyle:= BorderStyle;
1490 ScanExtents;
1491 Refresh;
1492end;
1493
1494Procedure TOutline2.SetScrollbarWidth( ScrollbarWidth: longint );
1495begin
1496 _ScrollBarWidth:= ScrollBarWidth;
1497 ScanExtents;
1498 Refresh;
1499end;
1500
1501Procedure TOutline2.SetLeftMargin( LeftMargin: longint );
1502begin
1503 if _LeftMargin = LeftMargin then
1504 exit;
1505 _LeftMargin:= LeftMargin;
1506 ScanExtents;
1507 Refresh;
1508end;
1509
1510Procedure TOutline2.SetTextIndent( TextIndent: longint );
1511begin
1512 if _TextIndent = TextIndent then
1513 exit;
1514 _TextIndent:= TextIndent;
1515 ScanExtents;
1516 Refresh;
1517end;
1518
1519Procedure TOutline2.SetPlusMinusWidth( PlusMinusWidth: longint );
1520begin
1521 if _PlusMinusWidth = PlusMinusWidth then
1522 exit;
1523
1524 if PlusMinusWidth < 7 then
1525 PlusMinusWidth:= 7;
1526
1527 _PlusMinusWidth:= PlusMinusWidth;
1528 ScanExtents;
1529 Refresh;
1530end;
1531
1532Procedure TOutline2.SetPlusMinusHeight( PlusMinusHeight: longint );
1533begin
1534 if _PlusMinusHeight = PlusMinusHeight then
1535 exit;
1536 if PlusMinusHeight < 7 then
1537 PlusMinusHeight:= 7;
1538
1539 _PlusMinusHeight:= PlusMinusHeight;
1540 ScanExtents;
1541 Refresh;
1542end;
1543
1544Procedure TOutline2.SetStubWidth( StubWidth: longint );
1545begin
1546 if _StubWidth = StubWidth then
1547 exit;
1548 _StubWidth:= StubWidth;
1549 ScanExtents;
1550 Refresh;
1551end;
1552
1553Procedure TOutline2.SetPlusMinusStyle( NewValue: TPlusMinusStyle );
1554begin
1555 if _PlusMinusStyle = NewValue then
1556 exit;
1557
1558 _PlusMinusStyle:= NewValue;
1559 Refresh;
1560end;
1561
1562Procedure TOutline2.SetSelectLine( NewValue: boolean );
1563begin
1564 if _SelectLine = NewValue then
1565 exit;
1566 _SelectLine:= NewValue;
1567 DrawNode( _SelectedNode );
1568end;
1569
1570Procedure TOutline2.SetTreeLineColor( NewValue: TColor );
1571begin
1572 if _TreeLineColor = NewValue then
1573 exit;
1574 _TreeLineColor:= NewValue;
1575 Refresh;
1576end;
1577
1578procedure TNode.ExpandParents;
1579var
1580 AParent: TNode;
1581begin
1582 AParent:= self._Parent;
1583 while AParent._Parent <> nil do
1584 begin
1585 AParent.Expand;
1586 AParent:= AParent._Parent;
1587 end;
1588end;
1589
1590procedure TOutline2.Clear;
1591begin
1592 BeginUpdate;
1593 _Root.Clear;
1594 EndUpdate;
1595end;
1596
1597Function TOutline2.AddChild( const TheText: string;
1598 const TheObject: TObject ): TNode;
1599Begin
1600 Result := _Root.AddChild( TheText, TheObject );
1601End;
1602
1603Function TOutline2.GetChild( index: longint ): TNode;
1604Begin
1605 Result:= _Root.Children[ index ];
1606End;
1607
1608Function TOutline2.GetChildCount: longint;
1609begin
1610 Result:= _Root.ChildCount;
1611end;
1612
1613Procedure TOutline2.SetupScrollbars;
1614Begin
1615 _VScrollbar.Visible:= _NeedVScroll;
1616 if _NeedVScroll then
1617 begin
1618 _VScrollbar.Left:= Width - _ScrollbarWidth;
1619 _VScrollbar.Width:= _ScrollbarWidth;
1620
1621 if _NeedHScroll then
1622 begin
1623 _VScrollbar.Bottom:= _ScrollbarWidth;
1624 _VScrollbar.Height:= Height - _ScrollbarWidth
1625 end
1626 else
1627 begin
1628 _VScrollbar.Bottom:= 0;
1629 _VScrollbar.Height:= Height;
1630 end;
1631 end;
1632
1633 _HScrollbar.Visible:= _NeedHScroll;
1634 if _NeedHScroll then
1635 begin
1636 _HScrollbar.Left:= 0;
1637 _HScrollbar.Bottom:= 0;
1638 _HScrollbar.Height:= _ScrollbarWidth;
1639
1640 if _NeedVScroll then
1641 _HScrollbar.Width:= Width - _ScrollBarWidth
1642 else
1643 _HScrollbar.Width:= Width;
1644 end;
1645
1646End;
1647
1648Procedure TOutline2.Resize;
1649begin
1650 ScanExtents;
1651end;
1652
1653Procedure TOutline2.SetupComponent;
1654Begin
1655 Inherited SetupComponent;
1656 Name:= 'Outline2';
1657
1658 Width:= 100;
1659 Height:= 100;
1660
1661 _BorderStyle:= bsSingle;
1662 FSmoothScroll := true;
1663
1664 _StubWidth:= 0;
1665 _Indent:= 11;
1666 _PlusMinusWidth:= 11;
1667 _PlusMinusHeight:= 11;
1668 _AutoLineHeight := true;
1669 _LeftMargin:= 5;
1670 _TextIndent:= 5;
1671 _ScrollbarWidth:= 15;
1672 _PlusMinusStyle:= pm3d;
1673 _SelectLine:= false;
1674 _TreeLineColor:= clGray;
1675
1676 Color:= clEntryField;
1677 ParentPenColor:= true;
1678 Exclude( ComponentState, csAcceptsControls );
1679
1680 if not InDesigner then
1681 begin
1682 _Root:= TNode.Create( nil );
1683 _Root.Text:= 'Root';
1684 _Root._Outline:= self;
1685 _Root._Expanded:= true; // by definition
1686 _SelectedNode:= nil;
1687
1688 _MouseDownNode:= nil;
1689 _MouseDownPart:= npNothing;
1690
1691 _HScrollbar.Create( self );
1692 _HScrollbar.Kind:= sbHorizontal;
1693 Include( _HScrollbar.ComponentState, csDetail );
1694 _HScrollbar.Parent:= self;
1695
1696 _VScrollbar.Create( self );
1697 _VScrollbar.Kind:= sbVertical;
1698 Include( _VScrollbar.ComponentState, csDetail );
1699 _VScrollbar.Parent:= self;
1700
1701 _UpdateCount:= 0;
1702
1703 _HoverTimer := TTimer.Create( self );
1704 _HoverTimer.Interval := 500;
1705 _HoverTimer.OnTImer := OnHoverTimeout;
1706 _HintWindow:= THintWindow.Create( self );
1707 _HintWindow.CreateWnd;
1708 end;
1709
1710End;
1711
1712Destructor TOutline2.Destroy;
1713Begin
1714 if not InDesigner then
1715 begin
1716 _Root.Destroy;
1717 end;
1718 Inherited Destroy;
1719End;
1720
1721Procedure TOutline2.SetupShow;
1722begin
1723 Inherited SetupShow;
1724 _UpdateCount:= 0;
1725
1726 if not InDesigner then
1727 ScanExtents;
1728end;
1729
1730Procedure TOutline2.MouseDown( Button: TMouseButton;
1731 ShiftState: TShiftState;
1732 X, Y: Longint );
1733var
1734 Node: TNode;
1735 Part: TNodePart;
1736 Point: TPoint;
1737begin
1738 inherited MouseDown( Button, ShiftState, X, Y );
1739
1740 if InDesigner then
1741 exit;
1742
1743 Focus;
1744
1745 MouseCapture:= true;
1746 Point.X:= X;
1747 Point.Y:= Y;
1748 TestHit( Point,
1749 Node,
1750 Part );
1751 if Node <> nil then
1752 begin
1753 _MouseDownNode:= Node;
1754 _MouseDownPart:= Part;
1755
1756 _MouseDownFeedback:= true;
1757 _LastMouseMoveFeedback:= true;
1758
1759 DrawNode( _MouseDownNode );
1760 end;
1761end;
1762
1763Procedure TOutline2.MouseMove( ShiftState: TShiftState;
1764 X, Y: Longint );
1765var
1766 Node: TNode;
1767 Part: TNodePart;
1768 Point: TPoint;
1769begin
1770 if InDesigner then
1771 exit;
1772
1773 if not MouseCapture then
1774 begin
1775 _HoverTimer.Stop;
1776// _HoverTimer.Start;
1777 _LastMouseX := X;
1778 _LastMouseY := Y;
1779 exit;
1780 end;
1781
1782 Point.X:= X;
1783 Point.Y:= Y;
1784 TestHit( Point,
1785 Node,
1786 Part );
1787
1788 _MouseDownFeedback:=
1789 ( Node = _MouseDownNode )
1790 and ( Part = _MouseDownPart );
1791
1792 if _LastMouseMoveFeedback <> _MouseDownFeedback then
1793 DrawNode( _MouseDownNode );
1794
1795 _LastMouseMoveFeedback:= _MouseDownFeedback;
1796end;
1797
1798Procedure TOutline2.MouseUp( Button: TMouseButton;
1799 ShiftState: TShiftState;
1800 X, Y: Longint );
1801var
1802 Node: TNode;
1803 Part: TNodePart;
1804 Point: TPoint;
1805 MouseDownNode: TNode;
1806begin
1807 if InDesigner then
1808 exit;
1809
1810 if not MouseCapture then
1811 exit;
1812
1813 MouseDownNode:= _MouseDownNode;
1814 _MouseDownNode:= nil;
1815 MouseCapture:= false;
1816
1817 Point.X:= X;
1818 Point.Y:= Y;
1819 TestHit( Point,
1820 Node,
1821 Part );
1822
1823 if ( Node <> nil )
1824 and ( Node = MouseDownNode )
1825 and ( Part = _MouseDownPart )
1826 then
1827 begin
1828 if Part = npPlusMinus then
1829 begin
1830 if Node.Expanded then
1831 Node.Collapse
1832 else
1833 Node.Expand;
1834 end
1835 else
1836 begin
1837 SelectedNode:= Node;
1838
1839 if Assigned( _OnItemClick ) then
1840 _OnItemClick( Node );
1841 end;
1842
1843 end
1844 else
1845 begin
1846 DrawNode( MouseDownNode );
1847 end;
1848
1849end;
1850
1851Procedure TOutline2.MouseDblClick( Button: TMouseButton;
1852 ShiftState: TShiftState;
1853 X, Y: Longint );
1854var
1855 Node: TNode;
1856 Part: TNodePart;
1857 Point: TPoint;
1858begin
1859 if InDesigner then
1860 exit;
1861
1862 Point.X:= X;
1863 Point.Y:= Y;
1864 TestHit( Point,
1865 Node,
1866 Part );
1867 if Node <> nil then
1868 begin
1869 if Part = npPlusMinus then
1870 if Node.Expanded then
1871 Node.Collapse
1872 else
1873 Node.Expand
1874 else
1875 begin
1876 SelectedNode:= Node;
1877 if Assigned( _OnItemDblClick ) then
1878 _OnItemDblClick( Node );
1879 end;
1880
1881 end;
1882end;
1883
1884procedure TOutline2.BeginUpdate;
1885begin
1886 if _UpdateCount = 0 then
1887 _NewSelectedNode:= _SelectedNode;
1888
1889 inc( _UpdateCount );
1890end;
1891
1892procedure TOutline2.EndUpdate;
1893begin
1894 dec( _UpdateCount );
1895 if _UpdateCount = 0 then
1896 begin
1897 ScanExtents;
1898 Refresh;
1899 SetSelectedNode( _NewSelectedNode );
1900 end
1901 else if _UpdateCount < 0 then
1902 raise Exception.Create( 'Too many EndUpdates in TOutline2!' );
1903end;
1904
1905procedure TOutline2.SetSelectedObject( Data: TObject );
1906var
1907 Node: TNode;
1908begin
1909 Node:= _Root.FindData( Data );
1910 SelectedNode:= Node;
1911end;
1912
1913function TOutline2.NodeFromObject( Data: TObject ): TNode;
1914begin
1915 Result:= _Root.FindData( Data );
1916end;
1917
1918function TOutline2.FindByFunction( FindFunction: TNodeFindFunction ): TNode;
1919begin
1920 Result:= _Root.FindByFunction( FindFunction );
1921end;
1922
1923Procedure TOutline2.GotoFirstNode;
1924begin
1925 if ChildCount > 0 then
1926 SelectedNode:= Children[ 0 ];
1927end;
1928
1929Procedure TOutline2.GotoLastVisibleNode;
1930var
1931 Node: TNode;
1932begin
1933 Node:= LastVisibleNode;
1934 if Node <> nil then
1935 SelectedNode:= Node;
1936end;
1937
1938function TOutline2.LastVisibleNode: TNode;
1939begin
1940 Result:= nil;
1941 if ChildCount > 0 then
1942 begin
1943 Result:= _Root;
1944 while Result.HasChildren do
1945 begin
1946 if Result.Expanded then
1947 Result:= Result.Children[ Result.ChildCount - 1 ]
1948 else
1949 break;
1950 end;
1951 end;
1952end;
1953
1954function TOutline2.NextNodeUp( Node: TNode;
1955 VisibleOnly: boolean ): TNode;
1956var
1957 NodeIndexInParent: longint;
1958begin
1959 NodeIndexInParent:= Node.IndexInParent;
1960 if NodeIndexInParent = 0 then
1961 begin
1962 if Node._Parent = _Root then
1963 Result:= nil // nothing above this one
1964 else
1965 Result:= Node._Parent
1966 end
1967 else
1968 begin
1969 Result:= Node._Parent.Children[ NodeIndexInParent - 1 ];
1970 while Result.HasChildren
1971 and ( Result.Expanded or ( not VisibleOnly ) ) do
1972 begin
1973 Result:= Result.Children[ Result.ChildCount - 1 ];
1974 end;
1975 end;
1976
1977end;
1978
1979function TOutline2.NextNodeDown( Node: TNode;
1980 VisibleOnly: boolean ): TNode;
1981var
1982 NodeIndexInParent: longint;
1983begin
1984 if Node.HasChildren
1985 and ( Node.Expanded or ( not VisibleOnly ) ) then
1986 Result:= Node.Children[ 0 ]
1987 else
1988 begin
1989 Result:= node;
1990 while Result <> _Root do
1991 begin
1992 NodeIndexInParent:= Result.IndexInParent;
1993 if NodeIndexInParent < Result._Parent.ChildCount - 1 then
1994 begin
1995 Result:= Result._Parent.Children[ NodeIndexInParent + 1 ];
1996 break;
1997 end;
1998 Result:= Result._Parent;
1999 end;
2000 if Result = _Root then
2001 begin
2002 Result:= nil;
2003 // already at bottom
2004 exit;
2005 end;
2006 end;
2007end;
2008
2009function TOutline2.GotoNextVisibleNodeUp: boolean;
2010var
2011 NextNode: TNode;
2012begin
2013 Result := true;
2014 if SelectedNode <> nil then
2015 begin
2016 NextNode:= NextNodeUp( SelectedNode, true );
2017 if NextNode <> nil then
2018 SelectedNode:= NextNode
2019 else
2020 Result := false;
2021 end
2022 else
2023 GotoFirstNode;
2024end;
2025
2026function TOutline2.GotoNextVisibleNodeDown: boolean;
2027var
2028 NextNode: TNode;
2029begin
2030 Result := true;
2031 if SelectedNode <> nil then
2032 begin
2033 NextNode:= NextNodeDown( SelectedNode, true );
2034 if NextNode <> nil then
2035 SelectedNode:= NextNode
2036 else
2037 Result := false;
2038 end
2039 else
2040 GotoFirstNode;
2041end;
2042
2043function TOutline2.GotoNextNodeUp: boolean;
2044var
2045 NextNode: TNode;
2046begin
2047 Result := true;
2048 if SelectedNode <> nil then
2049 begin
2050 NextNode:= NextNodeUp( SelectedNode, false );
2051 if NextNode <> nil then
2052 SelectedNode:= NextNode
2053 else
2054 Result := false;
2055 end
2056 else
2057 GotoFirstNode;
2058end;
2059
2060function TOutline2.GotoNextNodeDown: boolean;
2061var
2062 NextNode: TNode;
2063begin
2064 Result := true;
2065 if SelectedNode <> nil then
2066 begin
2067 NextNode:= NextNodeDown( SelectedNode, false );
2068 if NextNode <> nil then
2069 SelectedNode:= NextNode
2070 else
2071 Result := false;
2072 end
2073 else
2074 GotoFirstNode;
2075end;
2076
2077Procedure TOutline2.PageUp;
2078var
2079 NextNode: TNode;
2080 Y: longint;
2081begin
2082 if SelectedNode <> nil then
2083 begin
2084 NextNode:= NextNodeUp( SelectedNode, true );
2085 Y:= _LineHeight;
2086 while ( NextNode <> nil )
2087 and ( Y < DrawHeight ) do
2088 begin
2089 inc( Y, _LineHeight );
2090 NextNode:= NextNodeUp( NextNode, true );
2091 end;
2092 if NextNode = nil then
2093 GotoFirstNode
2094 else
2095 SelectedNode:= NextNode;
2096
2097 end
2098 else
2099 GotoFirstNode;
2100end;
2101
2102Procedure TOutline2.PageDown;
2103var
2104 NextNode: TNode;
2105 Y: longint;
2106begin
2107 if SelectedNode <> nil then
2108 begin
2109 NextNode:= NextNodeDown( SelectedNode, true );
2110 Y:= _LineHeight;
2111 while ( NextNode <> nil )
2112 and ( Y < DrawHeight ) do
2113 begin
2114 inc( Y, _LineHeight );
2115 NextNode:= NextNodeDown( NextNode, true );
2116 end;
2117 if NextNode = nil then
2118 GotoLastVisibleNode
2119 else
2120 SelectedNode:= NextNode;
2121
2122 end
2123 else
2124 GotoFirstNode;
2125end;
2126
2127Procedure TOutline2.CollapseAll;
2128begin
2129 _Root.CollapseChildren( true );
2130end;
2131
2132Procedure TOutline2.ExpandAll;
2133begin
2134 _Root.ExpandChildren( true );
2135end;
2136
2137Procedure TOutline2.SetFocus;
2138begin
2139 inherited SetFocus;
2140 if _SelectedNode <> nil then
2141 DrawNode( _SelectedNode );
2142end;
2143
2144Procedure TOutline2.KillFocus;
2145begin
2146 inherited KillFocus;
2147 if _SelectedNode <> nil then
2148 DrawNode( _SelectedNode );
2149end;
2150
2151Procedure TOutline2.ScanEvent( Var KeyCode: TKeyCode;
2152 RepeatCount: Byte );
2153Begin
2154 if InDesigner then
2155 begin
2156 inherited ScanEvent( KeyCode, RepeatCount );
2157 exit;
2158 end;
2159
2160 Case KeyCode Of
2161 kbHome, kbCtrlHome, kbCtrlPageUp:
2162 GotoFirstNode;
2163
2164 kbEnd, kbCtrlEnd, kbCtrlPageDown:
2165 GotoLastVisibleNode;
2166
2167 kbCUp:
2168 begin
2169 GotoNextVisibleNodeUp;
2170 KeyCode := kbNull; // prevent sibyl changing focus
2171 end;
2172
2173 kbCDown:
2174 begin
2175 GotoNextVisibleNodeDown;
2176 KeyCode := kbNull; // prevent sibyl changing focus
2177 end;
2178
2179 kbPageUp:
2180 PageUp;
2181
2182 kbPageDown:
2183 PageDown;
2184
2185 End;
2186
2187 inherited ScanEvent( KeyCode, RepeatCount );
2188
2189End;
2190
2191Function TOutline2.FindNextNodeByText( StartNode: TNode;
2192 const S: string;
2193 VisibleOnly: boolean ): TNode;
2194
2195var
2196 Node: TNode;
2197begin
2198 Result := nil;
2199
2200 if StartNode = nil then
2201 exit;
2202
2203 Node := StartNode;
2204
2205 while true do
2206 begin
2207 Node := NextNodeDown( Node, VisibleOnly );
2208 if Node = nil then
2209 // reached bottom, start from top again.
2210 Node := Children[ 0 ];
2211
2212 if Node = StartNode then
2213 // searched all nodes, done.
2214 exit;
2215
2216 if StrStarts( S, Node.Text ) then
2217 begin
2218 // found
2219 Result := Node;
2220 exit;
2221 end;
2222 end;
2223end;
2224
2225Procedure TOutline2.CharEvent( Var Key: Char;
2226 RepeatCount: Byte );
2227var
2228 Node: TNode;
2229 NextNode: TNode;
2230begin
2231 if InDesigner then
2232 begin
2233 inherited CharEvent( Key, RepeatCount );
2234 exit;
2235 end;
2236
2237 if SelectedNode <> nil then
2238 begin
2239 case Key of
2240 '+', '=': // = to catch non-shifted + on most keyboards
2241 SelectedNode.Expand;
2242
2243 '-':
2244 SelectedNode.Collapse;
2245
2246 ' ': // space toggles expanded/collapsed
2247 if SelectedNode.Expanded then
2248 SelectedNode.Collapse
2249 else
2250 SelectedNode.Expand;
2251
2252 '*': // Alberto thinks this would be nice to expand the tree...
2253 begin
2254 SelectedNode.Expand;
2255 SelectedNode.ExpandChildren( true );
2256 end;
2257
2258 else
2259 begin
2260 // search by first letter, in visible nodes.
2261
2262 if ChildCount = 0 then
2263 // no nodes to search in
2264 exit;
2265
2266 if SelectedNode = nil then
2267 Node := _Root.Children[ 0 ]
2268 else
2269 Node := SelectedNode;
2270
2271 NextNode := FindNextNodeByText( Node, key, true ); // visible only
2272 if NextNode <> nil then
2273 SelectedNode := NextNode;
2274
2275 end;
2276 end;
2277 end;
2278
2279 inherited CharEvent( Key, RepeatCount );
2280end;
2281
2282Procedure TOutline2.OnHoverTimeout( Sender: TObject );
2283var
2284 R: TRect;
2285begin
2286 R.Left := _LastMouseX;
2287 R.Bottom := _LastMouseY;
2288 R.Right := R.Left + 100;
2289 R.Top := R.Bottom + 50;
2290 // show hint
2291 R.LeftBottom := ClientToScreen( R.LeftBottom );
2292 R.RightTop := ClientToScreen( R.RightTop );
2293 _HintWindow.Parent := Parent;
2294 _HintWindow.ActivateHint( R, 'Yees' );
2295 _HoverTimer.Stop;
2296end;
2297
2298Procedure TOutline2.WMMouseLeave( Var Msg: TMessage );
2299begin
2300 if InDesigner then
2301 exit;
2302 _HoverTimer.Stop;
2303// _HintWindow.DeactivateHint;
2304end;
2305
2306Procedure TOutline2.FontChange;
2307begin
2308 inherited FontChange;
2309
2310 if _AutoLineHeight then
2311 begin
2312 LineHeight := Canvas.TextHeight( 'H' ) + 1;
2313 Refresh; // lineheight change alone may not be enough.
2314 end;
2315end;
2316
2317Procedure TOutline2.DoVerticalScroll( NewY: longint );
2318var
2319 ScrollDistance: longint;
2320begin
2321 if not Visible then
2322 exit;
2323
2324 FYScroll := NewY;
2325 ScrollDistance:= FYScroll - FLastYScroll;
2326
2327 ScrollControlRect( Self,
2328 GetTextRect,
2329 0,
2330 ScrollDistance,
2331 Color,
2332 FSmoothScroll );
2333
2334 FLastYScroll:= FYScroll;
2335 PostMsg( Handle, WM_PAINT, 0, 0 );
2336end;
2337
2338Procedure TOutline2.DoHorizontalScroll( NewX: longint );
2339var
2340 ScrollDistance: longint;
2341begin
2342 if not Visible then
2343 exit;
2344
2345 FXScroll := NewX;
2346 ScrollDistance:= FXScroll - FLastXScroll;
2347
2348 ScrollControlRect( Self,
2349 GetTextRect,
2350 - ScrollDistance,
2351 0,
2352 Color,
2353 FSmoothScroll );
2354
2355 FLastXScroll:= FXScroll;
2356 PostMsg( Handle, WM_PAINT, 0, 0 );
2357end;
2358
2359Procedure TOutline2.Scroll( Sender: TScrollbar;
2360 ScrollCode: TScrollCode;
2361 Var ScrollPos: Longint );
2362
2363begin
2364 case ScrollCode of
2365// scVertEndScroll,
2366 scVertPosition,
2367 scPageUp,
2368 scPageDown,
2369 scVertTrack,
2370 scLineDown,
2371 scLineUp:
2372 begin
2373 DoVerticalScroll( ScrollPos );
2374 end;
2375
2376 scHorzPosition,
2377 scPageRight,
2378 scPageLeft,
2379 scHorzTrack,
2380 scColumnRight,
2381 scColumnLeft:
2382 begin
2383 DoHorizontalScroll( ScrollPos );
2384 end;
2385 end;
2386end;
2387
2388Initialization
2389 {Register classes}
2390 RegisterClasses([TOutline2]);
2391End.
2392
2393
Note: See TracBrowser for help on using the repository browser.