source: trunk/Sibyl/SPCC/OUTLINE.PAS@ 7

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

+ sibyl staff
  • Property svn:eol-style set to native
File size: 70.4 KB
Line 
1
2{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3 º º
4 º Sibyl Portable Component Classes º
5 º º
6 º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
7 º º
8 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
9
10Unit OutLine;
11
12
13Interface
14
15{$IFDEF OS2}
16Uses Os2Def,PmWin,PmStdDlg;
17{$ENDIF}
18
19{$IFDEF Win95}
20Uses WinDef,WinUser,WinGDI,CommCtrl;
21{$ENDIF}
22
23Uses Messages,SysUtils,Classes,Forms,Graphics;
24
25
26Const
27 InvalidIndex = {MaxLongInt;} -1;
28 tab = Chr(9);
29
30Type
31 TAttachMode = (oaAdd, oaAddChild, oaInsert);
32
33
34Type
35 EOutlineError=Class(Exception);
36 EOutlineNodeError=Class(EOutlineError);
37 EOutlineIndexError=Class(EOutlineError);
38
39 TOutline=Class;
40 TOutlineNode=Class;
41
42 POutlineRecord=^TOutlineRecord;
43 TOutlineRecord=Record
44 {$IFDEF OS2}
45 RecordCore:RecordCore;
46 {$ENDIF}
47 {$IFDEF Win95}
48 RecordCore:TV_ITEM;
49 {$ENDIF}
50 Node:TOutlineNode; {Extra Data}
51 End;
52
53
54 TOutlineNode=Class
55 Private
56 FTreeRec:POutlineRecord;
57 FCaption:PChar;
58 FData:Pointer;
59 FIndex:LongInt;
60 FExpanded:Boolean;
61 FParent:TOutlineNode;
62 FOutline:TOutline;
63 FSubNodes:TList;
64 FPictureLeaf:TBitmap;
65 FPictureOpen:TBitmap;
66 FPictureClosed:TBitmap;
67 Function GetCaption:String;
68 Procedure SetCaption(NewCaption:String);
69 Function Index2Node(idx:LongInt):TOutlineNode;
70 Function GetNode(idx:LongInt):TOutlineNode;
71 Function GetNodeCount:LongInt;
72 Function InsertNode(OldNode,NewNode:TOutlineNode):LongInt;
73 Function AddNode(NewNode:TOutlineNode):LongInt;
74 Procedure Setup(RecordOrder:Pointer);
75 Function HasChildren:Boolean;
76 Function GetLastIndex:LongInt;
77 Function GetTopItem:LongInt;
78 Function ReIndex(idx,Max:LongInt):LongInt;
79 Function HasVisibleParent:Boolean;
80 Function GetVisibleParent:TOutlineNode;
81 Function GetFullPath:String;
82 Function GetLevel:LongInt;
83 Function GetList:TList;
84 Procedure SetLastValidIndex;
85 Function GetDataItem(Value:Pointer):LongInt;
86 Function GetTextItem(Const Value:String):LongInt;
87 Procedure ClearSubNodes;
88 Procedure SetExpanded(Value:Boolean);
89 Procedure UpdatePicture;
90 Procedure UpdateChildPictures;
91 Procedure SetPictureLeaf(NewBitmap:TBitmap);
92 Procedure SetPictureOpen(NewBitmap:TBitmap);
93 Procedure SetPictureClosed(NewBitmap:TBitmap);
94 Function GetItemRect:TRect;
95 Protected
96 Constructor Create(Owner:TOutline);
97 Property OutLine:TOutline Read FOutline;
98 Property List:TList Read GetList;
99 Public
100 Property Items[Index:LongInt]:TOutlineNode Read GetNode;
101 Property ItemCount:LongInt Read GetNodeCount;
102 Destructor Destroy;Override;
103 Procedure FullExpand;
104 Procedure FullCollapse;
105 Procedure Expand;
106 Procedure Collapse;
107 Procedure Clear;
108 Function GetFirstChild:LongInt;
109 Function GetLastChild:LongInt;
110 Function GetNextChild(Value:LongInt):LongInt;
111 Function GetPrevChild(Value:LongInt):LongInt;
112 Property Text:String Read GetCaption Write SetCaption;
113 Property Data:Pointer Read FData Write FData;
114 Property parent:TOutlineNode Read FParent;
115 Property Index:LongInt Read FIndex;
116 Property IsVisible:Boolean Read HasVisibleParent;
117 Property HasItems:Boolean Read HasChildren;
118 Property Level:LongInt Read GetLevel;
119 Property Expanded:Boolean Read FExpanded Write SetExpanded;
120 Property FullPath:String Read GetFullPath;
121 Property TopItem:LongInt Read GetTopItem;
122 Property PictureLeaf:TBitmap Read FPictureLeaf Write SetPictureLeaf;
123 Property PictureClosed:TBitmap Read FPictureClosed Write SetPictureClosed;
124 Property PictureOpen:TBitmap Read FPictureOpen Write SetPictureOpen;
125 Property ItemRect:TRect read GetItemRect;
126 End;
127 TOutlineNodeClass = Class Of TOutlineNode;
128
129
130{$M+}
131 TOutLineItemFocusEvent=Procedure(Sender:TObject;Index:LongInt) Of Object;
132 TOutLineItemSelectEvent=Procedure(Sender:TObject;Index:LongInt) Of Object;
133 TOutlineChangeEvent=Procedure(Sender:TObject;Index:LongInt) Of Object;
134{$M-}
135
136 TOutline=Class(TControl)
137 Private
138 FLines:TStrings;
139 FShowDragRects:Boolean;
140 FDragRectValid:Boolean;
141 FDragRect:TRect;
142 FDragSelected:TOutlineNode;
143 FInitLines:TStringList;
144 FNodeClass:TOutlineNodeClass;
145 FRootNode:TOutlineNode;
146 FGoodNode:TOutlineNode;
147 FUpdateCount:LongInt;
148 FSeparator:String;
149 FCurItem:TOutlineNode;
150 FStrings:TStrings;
151 FBorderStyle:TBorderStyle;
152 FPictureList:TBitmapList;
153 FPictureOpen:TBitmap;
154 FPictureClosed:TBitmap;
155 FPictureLeaf:TBitmap;
156 FInitNodes:TList;
157 FPlusMinusSize:TSize;
158 FPictureSize:TSize;
159 FShowTreeLines:Boolean;
160 FShowPlusMinus:Boolean;
161 FTreeLineWidth:LongInt;
162 FTreeIndent:LongInt;
163 FLineSpacing:LongInt;
164 FIndexInsert:Boolean;
165 FDragging:Boolean;
166 FFocusNode:TOutlineNode;
167 FPopupPos:TPoint;
168 {$IFDEF Win95}
169 FHim:HIMAGELIST;
170 FSelItem:Pointer;
171 {$ENDIF}
172 FOnExpand:TOutlineChangeEvent;
173 FOnCollapse:TOutlineChangeEvent;
174 FOnItemFocus:TOutLineItemFocusEvent;
175 FOnItemSelect:TOutLineItemSelectEvent;
176 FOnClick:TNotifyEvent;
177 FChangeLock:Boolean;
178 {$IFDEF OS2}
179 Procedure WMPaint(Var Msg:TMessage);Message WM_PAINT;
180 {$ENDIF}
181 Function AddPicture(NewBitmap:TBitmap):TBitmap;
182 Procedure SetBorderStyle(NewBorder:TBorderStyle);
183 Procedure SetPlusMinusSize(NewSize:TSize);
184 Procedure SetPictureSize(NewSize:TSize);
185 Procedure UpdateNode(Node:TOutlineNode);
186 Procedure SetCnrInfo;
187 Procedure SetShowTreeLines(NewValue:Boolean);
188 Procedure SetShowPlusMinus(NewValue:Boolean);
189 Procedure SetTreeLineWidth(NewValue:LongInt);
190 Procedure SetTreeIndent(Value:LongInt);
191 Procedure SetLineSpacing(Value:LongInt);
192 Procedure SetupTree;
193 Procedure SetupImageList;
194 Procedure SetupSubNodes(Node:TOutlineNode);
195 Function GetSelectedNode:TOutlineNode;
196 Procedure SetSelectedNode(NewSelected:TOutlineNode);
197 Function GetSelectedItem:LongInt;
198 Procedure SetSelectedItem(NewSelected:LongInt);
199 Function GetPictureClosed:TBitmap;
200 Procedure SetPictureClosed(NewBitmap:TBitmap);
201 Function GetPictureOpen:TBitmap;
202 Procedure SetPictureOpen(NewBitmap:TBitmap);
203 Function GetPictureLeaf:TBitmap;
204 Procedure SetPictureLeaf(NewBitmap:TBitmap);
205 Function Attach(idx:LongInt;Const Text:String;Data:Pointer;Mode:TAttachMode):LongInt;
206 Function Get(idx:LongInt):TOutlineNode;
207 Function GetItemCount:LongInt;
208 Procedure SetGoodNode(Node:TOutlineNode);
209 Function GetLines:TStrings;
210 Procedure SetLines(AStrings:TStrings);
211 Procedure DrawDragRect;
212 Protected
213 Procedure GetClassData(Var ClassData:TClassData);Override;
214 Procedure CreateParams(Var Params:TCreateParams);Override;
215 Procedure SetupComponent;Override;
216 Procedure Click;Virtual;
217 Procedure SetupShow;Override;
218 Procedure DestroyWnd;Override;
219 Procedure ParentNotification(Var Msg:TMessage);Override;
220 Procedure ItemFocus(Index:LongInt);Virtual;
221 Procedure ItemSelect(Index:LongInt);Virtual;
222 Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
223 Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
224 Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
225 Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
226 Procedure MouseClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
227 Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
228 Function AttachNode(Node:TOutlineNode;Const Text:String;Data:Pointer;Mode:TAttachMode):TOutlineNode;
229 Procedure indexerror;Virtual;
230 Procedure NodeError;Virtual;
231 Procedure ItemChanged(Var Msg:TMessage;Expanded:Boolean);Virtual;
232 Procedure Expand(Index:LongInt);Virtual;
233 Procedure Collapse(Index:LongInt);Virtual;
234 Procedure DragOver(Source:TObject;X,Y:LongInt;State:TDragState;Var Accept:Boolean);Override;
235 Procedure DragDrop(Source:TObject;X,Y:LongInt);Override;
236 Public
237 Destructor Destroy;Override;
238 Procedure BeginUpdate;
239 Procedure EndUpdate;
240 Function Add(Index:LongInt;Const Text:String):LongInt;
241 Function AddObject(Index:LongInt;Const Text:String;Data:Pointer):LongInt;
242 Function AddChild(Index:LongInt;Const Text:String):LongInt;
243 Function AddChildObject(Index:LongInt;Const Text:String;Data:Pointer):LongInt;
244 Function Insert(Index:LongInt;Const Text:String):LongInt;
245 Function InsertObject(Index:LongInt;Const Text:String;Data:Pointer):LongInt;
246 Procedure Delete(Index:LongInt);
247 Procedure FullExpand;
248 Procedure FullCollapse;
249 Function GetDataItem(Value:Pointer):LongInt;
250 Function GetTextItem(Const Value:String):LongInt;
251 Procedure Clear;
252 Function NodeFromPoint(pt:TPoint):TOutlineNode;
253 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
254 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
255 Property NodeClass:TOutlineNodeClass Read FNodeClass Write FNodeClass;
256 Property SelectedNode:TOutlineNode Read GetSelectedNode Write SetSelectedNode;
257 Property SelectedItem:LongInt Read GetSelectedItem Write SetSelectedItem;
258 Property Items[Index:LongInt]:TOutlineNode Read Get; Default;
259 Property ItemCount:LongInt Read GetItemCount;
260 Property ItemSeparator:String Read FSeparator Write FSeparator;
261 Property XAlign;
262 Property XStretch;
263 Property YAlign;
264 Property YStretch;
265 Published
266 Property Align;
267 Property Color;
268 Property BorderStyle:TBorderStyle Read FBorderStyle Write SetBorderStyle;
269 Property PenColor;
270 Property DragCursor;
271 Property DragMode;
272 Property Enabled;
273 Property Font;
274 Property Lines:TStrings Read GetLines Write SetLines;
275 Property LineSpacing:LongInt Read FLineSpacing Write SetLineSpacing;
276 Property ParentColor;
277 Property ParentPenColor;
278 Property ParentFont;
279 Property ParentShowHint;
280 Property PictureClosed:TBitmap Read GetPictureClosed Write SetPictureClosed;
281 Property PictureLeaf:TBitmap Read GetPictureLeaf Write SetPictureLeaf;
282 Property PictureOpen:TBitmap Read GetPictureOpen Write SetPictureOpen;
283 Property PictureSize:TSize Read FPictureSize Write SetPictureSize;
284 Property PlusMinusSize:TSize Read FPlusMinusSize Write SetPlusMinusSize;
285 Property PopupMenu;
286 Property ShowDragRects:Boolean Read FShowDragRects Write FShowDragRects;
287 Property ShowHint;
288 Property ShowPlusMinus:Boolean Read FShowPlusMinus Write SetShowPlusMinus;
289 Property ShowTreeLines:Boolean Read FShowTreeLines Write SetShowTreeLines;
290 Property TabOrder;
291 Property TabStop;
292 Property TreeIndent:LongInt Read FTreeIndent Write SetTreeIndent;
293 Property TreeLineWidth:LongInt Read FTreeLineWidth Write SetTreeLineWidth;
294 Property Visible;
295 Property ZOrder;
296
297 Property OnCanDrag;
298 Property OnClick:TNotifyEvent Read FOnClick Write FOnClick;
299 Property OnCollapse:TOutlineChangeEvent Read FOnCollapse Write FOnCollapse;
300 Property OnDblClick;
301 Property OnDragDrop;
302 Property OnDragOver;
303 Property OnEndDrag;
304 Property OnEnter;
305 Property OnExit;
306 Property OnExpand:TOutlineChangeEvent Read FOnExpand Write FOnExpand;
307 Property OnFontChange;
308 Property OnItemFocus:TOutLineItemFocusEvent Read FOnItemFocus Write FOnItemFocus;
309 Property OnItemSelect:TOutLineItemSelectEvent Read FOnItemSelect Write FOnItemSelect;
310 Property OnMouseClick;
311 Property OnMouseDblClick;
312 Property OnMouseDown;
313 Property OnMouseMove;
314 Property OnMouseUp;
315 Property OnSetupShow;
316 Property OnStartDrag;
317 End;
318
319
320Function InsertOutline(parent:TControl;Left,Bottom,Width,Height:LongInt;Hint:String):TOutline;
321
322
323Implementation
324
325
326Function InsertOutline(parent:TControl;Left,Bottom,Width,Height:LongInt;Hint:String):TOutline;
327Begin
328 Result.Create(parent);
329 Result.SetWindowPos(Left,Bottom,Width,Height);
330 Result.TabStop := True;
331 Result.Hint := Hint;
332 Result.parent := parent;
333End;
334
335
336Type
337 {$IFDEF OS2}
338 pRecordOrder=PRecordCore;
339 {$ENDIF}
340 {$IFDEF Win95}
341 pRecordOrder=POutlineRecord;
342 {$ENDIF}
343
344{
345ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
346º º
347º Speed-Pascal/2 Version 2.0 º
348º º
349º Speed-Pascal Component Classes (SPCC) º
350º º
351º This section: TOutlineBitmap Class Implementation º
352º º
353º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
354º º
355ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
356}
357
358Type
359 TOutlineBitmap=Class(TBitmap)
360 {$IFDEF Win95}
361 Private
362 FHimlIndex:LongInt;
363 Private
364 Function CreateBitmapFromClass:LongWord;
365 {$ENDIF}
366 End;
367
368
369{$IFDEF Win95}
370Function TOutlineBitmap.CreateBitmapFromClass:LongWord;
371Begin
372 Result := CopyImage(Handle,IMAGE_BITMAP,Width,Height,LR_COPYRETURNORG);
373End;
374{$ENDIF}
375
376
377{
378ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
379º º
380º Speed-Pascal/2 Version 2.0 º
381º º
382º Speed-Pascal Component Classes (SPCC) º
383º º
384º This section: TOutlineNode Class Implementation º
385º º
386º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
387º º
388ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
389}
390
391{$IFDEF Win95}
392Const
393 CMA_FIRST:LongWord=0;
394{$ENDIF}
395
396
397Procedure SetupNode(Node:TOutlineNode);
398Begin
399 {$IFDEF OS2}
400 Node.FTreeRec^.RecordCore.pszTree := Node.FCaption;
401 {$ENDIF}
402 {$IFDEF Win95}
403 Node.FTreeRec^.RecordCore.Mask := TVIF_TEXT Or TVIF_PARAM;
404 Node.FTreeRec^.RecordCore.pszText := Node.FCaption;
405 If Node.FCaption <> Nil
406 Then Node.FTreeRec^.RecordCore.cchTextMax := Length(Node.FCaption^)+1
407 Else Node.FTreeRec^.RecordCore.cchTextMax := 0;
408 {$ENDIF}
409
410 Node.UpdatePicture;
411End;
412
413
414Procedure RemoveRecord(Node:TOutlineNode; Update:Boolean);
415Var Flags:LongWord;
416 TreeHandle:LongWord;
417 AParent:TOutlineNode;
418Begin
419 If Node = Nil Then Exit;
420 If Node.FTreeRec = Nil Then Exit;
421
422 TreeHandle := Node.FOutline.Handle;
423 {$IFDEF OS2}
424 If Node.FTreeRec^.RecordCore.pTreeItemDesc <> Nil
425 Then Dispose(Node.FTreeRec^.RecordCore.pTreeItemDesc);
426 {$ENDIF}
427
428 If TreeHandle <> 0 Then
429 Begin
430 {$IFDEF OS2}
431 Flags := CMA_FREE;
432 If Update Then Flags := Flags Or CMA_INVALIDATE;
433 WinSendMsg(TreeHandle,CM_REMOVERECORD,LongWord(@Node.FTreeRec),
434 MPFROM2SHORT(1,Flags));
435 {$ENDIF}
436 {$IFDEF Win95}
437 SendMessage(TreeHandle,TVM_DELETEITEM,0,
438 LongWord(Node.FTreeRec^.RecordCore.hItem));
439 {$ENDIF}
440 End;
441
442 {$IFDEF Win95}
443 Dispose(Node.FTreeRec);
444 {$ENDIF}
445 Node.FTreeRec := Nil;
446
447 {Update parent Bitmap}
448 AParent := Node.parent;
449 If AParent <> Nil Then
450 If AParent <> Node.FOutline.FRootNode Then
451 If AParent.ItemCount = 1 Then AParent.UpdatePicture; {Node Is the Last}
452End;
453
454
455Procedure InsertRecord(NewNode:TOutlineNode; AParentRecord:POutlineRecord;
456 RecordOrder:Pointer);
457Var TreeHandle:LongWord;
458 Tree:TOutline;
459 AParent:TOutlineNode;
460 {$IFDEF OS2}
461 aRecordInsert:RECORDINSERT;
462 {$ENDIF}
463 {$IFDEF Win95}
464 tvins:TV_INSERTSTRUCT;
465 {$ENDIF}
466Begin
467 NewNode.FTreeRec^.Node := NewNode;
468 {specify where To Insert}
469 Tree := NewNode.FOutline;
470 TreeHandle := Tree.Handle;
471
472 {$IFDEF OS2}
473 aRecordInsert.cb := SizeOf(RECORDINSERT);
474 aRecordInsert.pRecordOrder := RecordOrder;
475 aRecordInsert.ZOrder := CMA_TOP;
476 aRecordInsert.cRecordsInsert := 1; //Number Of records
477 aRecordInsert.fInvalidateRecord := 1; //Invalidate records
478 aRecordInsert.pRecordParent := Pointer(AParentRecord);
479
480 {Insert Record}
481 WinSendMsg(TreeHandle,CM_INSERTRECORD,
482 LongWord(NewNode.FTreeRec),LongWord(@aRecordInsert));
483
484 {Expand Status}
485 If NewNode.FExpanded
486 Then WinSendMsg(TreeHandle,CM_EXPANDTREE, LongWord(NewNode.FTreeRec),0)
487 Else WinSendMsg(TreeHandle,CM_COLLAPSETREE, LongWord(NewNode.FTreeRec),0);
488 {$ENDIF}
489
490 {$IFDEF Win95}
491 {specify where To Insert}
492 FillChar(tvins,SizeOf(tvins),0);
493 NewNode.FTreeRec^.RecordCore.LParam:=LParam(NewNode);
494
495 tvins.Item:=NewNode.FTreeRec^.RecordCore;
496 If ((RecordOrder=Nil)Or(LongWord(RecordOrder)=CMA_FIRST)) Then tvins.hInsertAfter:=TVI_FIRST
497 Else tvins.hInsertAfter:=POutlineRecord(RecordOrder)^.RecordCore.hItem;
498 If AParentRecord=Nil Then tvins.hParent:=TVI_ROOT
499 Else tvins.hParent:=AParentRecord^.RecordCore.hItem;
500 NewNode.FTreeRec^.RecordCore.hItem:=
501 HTREEITEM(SendMessage(TreeHandle,TVM_INSERTITEM,0,LongWord(@tvins)));
502
503 {Expand Status}
504 If NewNode.FExpanded
505 Then SendMessage(TreeHandle,TVM_EXPAND,TVE_EXPAND,
506 LongWord(NewNode.FTreeRec^.RecordCore.hItem))
507 Else SendMessage(TreeHandle,TVM_EXPAND,TVE_COLLAPSE,
508 LongWord(NewNode.FTreeRec^.RecordCore.hItem));
509 {$ENDIF}
510
511 {Update parent Bitmap}
512 AParent := NewNode.parent;
513 If AParent <> Nil Then
514 If AParent <> Tree.FRootNode Then
515 If AParent.ItemCount = 1 Then AParent.UpdatePicture; {NewNode Is the 1st}
516End;
517
518
519Procedure AllocateRecord(Handle:LongWord;Var porec:POutlineRecord);
520Begin
521 //allocate Memory
522 {$IFDEF OS2}
523 porec:=Pointer(WinSendMsg(Handle,
524 CM_ALLOCRECORD,
525 {additional Info For OutlineRecord}
526 SizeOf(TOutlineRecord)-SizeOf(RecordCore),
527 1)); {allocate one Record}
528 {$ENDIF}
529 {$IFDEF Win95}
530 New(porec);
531 {$ENDIF}
532End;
533
534
535Constructor TOutlineNode.Create(Owner:TOutline);
536Begin
537 Inherited Create;
538
539 If Owner Is TOutline Then FOutline := TOutline(Owner)
540 Else Raise EOutlineError.Create(LoadNLSStr(SInvalidOutlineNodeOwner));
541End;
542
543
544Function TOutlineNode.GetCaption:String;
545Begin
546 If FCaption=Nil Then Result:=''
547 Else Result:=FCaption^;
548End;
549
550
551Procedure TOutlineNode.SetCaption(NewCaption:String);
552Begin
553 If NewCaption = Text Then Exit;
554
555 If FCaption <> Nil Then FreeMem(FCaption,Length(FCaption^)+1);
556 If NewCaption <> '' Then
557 Begin
558 GetMem(FCaption, Length(NewCaption)+1);
559 FCaption^ := NewCaption;
560 End
561 Else FCaption := Nil;
562
563 {$IFDEF OS2}
564 If FTreeRec <> Nil Then FTreeRec^.RecordCore.pszTree := FCaption;
565 {$ENDIF}
566 {$IFDEF Win95}
567 If FTreeRec <> Nil Then
568 Begin
569 FTreeRec^.RecordCore.pszText := FCaption;
570 If FCaption <> Nil
571 Then FTreeRec^.RecordCore.cchTextMax := Length(FCaption^)+1
572 Else FTreeRec^.RecordCore.cchTextMax := 0;
573 End;
574 {$ENDIF}
575
576 FOutline.UpdateNode(Self);
577End;
578
579
580Procedure TOutlineNode.UpdatePicture;
581Var Picture:TBitmap;
582 PictureHandle:LongWord;
583Begin
584 PictureHandle := 0;
585
586 If ItemCount > 0 Then
587 Begin
588 If Expanded Then
589 Begin
590 If FPictureOpen <> Nil Then Picture := FPictureOpen
591 Else Picture := FOutline.FPictureOpen;
592
593 {$IFDEF OS2}
594 If Picture <> Nil Then PictureHandle := Picture.Handle;
595
596 With FTreeRec^.RecordCore Do
597 Begin
598 If PictureHandle = 0 Then
599 Begin
600 If pTreeItemDesc <> Nil Then Dispose(pTreeItemDesc);
601 pTreeItemDesc := Nil;
602 End
603 Else
604 Begin
605 If pTreeItemDesc = Nil Then New(pTreeItemDesc);
606 pTreeItemDesc^.hbmExpanded := PictureHandle;
607 End;
608 End;
609 {$ENDIF}
610 End
611 Else
612 Begin
613 If FPictureClosed <> Nil Then Picture := FPictureClosed
614 Else Picture := FOutline.FPictureClosed;
615
616 {$IFDEF OS2}
617 If Picture <> Nil Then PictureHandle := Picture.Handle;
618
619 With FTreeRec^.RecordCore Do
620 Begin
621 If PictureHandle = 0 Then
622 Begin
623 If pTreeItemDesc <> Nil Then Dispose(pTreeItemDesc);
624 pTreeItemDesc := Nil;
625 End
626 Else
627 Begin
628 If pTreeItemDesc = Nil Then New(pTreeItemDesc);
629 pTreeItemDesc^.hbmCollapsed := PictureHandle;
630 End;
631 End;
632 {$ENDIF}
633 End;
634 End
635 Else
636 Begin
637 If FPictureLeaf <> Nil Then Picture := FPictureLeaf
638 Else Picture := FOutline.FPictureLeaf;
639 End;
640
641 If Picture <> Nil Then PictureHandle := Picture.Handle;
642
643 {$IFDEF OS2}
644 FTreeRec^.RecordCore.hbmBitmap := PictureHandle;
645 {$ENDIF}
646
647 {$IFDEF Win95}
648 If Picture = Nil Then
649 Begin
650 FTreeRec^.RecordCore.Mask := FTreeRec^.RecordCore.Mask And not
651 (TVIF_IMAGE Or TVIF_SELECTEDIMAGE);
652 FTreeRec^.RecordCore.iImage := 0;
653 FTreeRec^.RecordCore.iSelectedImage := 0;
654 End
655 Else
656 Begin
657 FTreeRec^.RecordCore.Mask := FTreeRec^.RecordCore.Mask
658 Or TVIF_IMAGE Or TVIF_SELECTEDIMAGE;
659 FTreeRec^.RecordCore.iImage := TOutlineBitmap(Picture).FHimlIndex;
660 FTreeRec^.RecordCore.iSelectedImage := TOutlineBitmap(Picture).FHimlIndex;
661 End;
662 {$ENDIF}
663End;
664
665
666Procedure TOutlineNode.UpdateChildPictures;
667Var Node:TOutlineNode;
668 T:LongInt;
669Begin
670 If FSubNodes = Nil Then Exit;
671 For T := 0 To FSubNodes.Count-1 Do
672 Begin
673 Node := FSubNodes.Items[T];
674 Node.UpdatePicture;
675 {$IFDEF WIN32}
676 Node.FOutLine.UpdateNode(Node);
677 {$ENDIF}
678 Node.UpdateChildPictures;
679 End;
680End;
681
682
683Procedure TOutlineNode.SetPictureLeaf(NewBitmap:TBitmap);
684Begin
685 FPictureLeaf := FOutline.AddPicture(NewBitmap); {Get local Copy}
686 If Not HasItems Then
687 Begin
688 UpdatePicture;
689 FOutline.UpdateNode(Self);
690 End;
691End;
692
693
694Procedure TOutlineNode.SetPictureOpen(NewBitmap:TBitmap);
695Begin
696 FPictureOpen := FOutline.AddPicture(NewBitmap); {Get local Copy}
697 If HasItems And Expanded Then
698 Begin
699 UpdatePicture;
700 FOutline.UpdateNode(Self);
701 End;
702End;
703
704
705Procedure TOutlineNode.SetPictureClosed(NewBitmap:TBitmap);
706Begin
707 FPictureClosed := FOutline.AddPicture(NewBitmap); {Get local Copy}
708 If HasItems And Not Expanded Then
709 Begin
710 UpdatePicture;
711 FOutline.UpdateNode(Self);
712 End;
713End;
714
715
716Function TOutlineNode.GetNode(idx:LongInt):TOutlineNode;
717Begin
718 Result := FSubNodes.Items[idx];
719End;
720
721
722Function TOutlineNode.GetNodeCount;
723Begin
724 If FSubNodes <> Nil Then Result := FSubNodes.Count
725 Else Result := 0;
726End;
727
728
729Function TOutlineNode.HasChildren:Boolean;
730Begin
731 Result := GetNodeCount > 0;
732End;
733
734
735Function TOutlineNode.GetLastIndex:LongInt;
736Begin
737 If ItemCount = 0 Then Result := Index
738 Else Result := TOutlineNode(FSubNodes.Last).GetLastIndex;
739End;
740
741
742Function TOutlineNode.GetTopItem:LongInt;
743Var Node:TOutlineNode;
744Begin
745 Result := 0;
746 Node := Self;
747 While Node <> FOutline.FRootNode Do
748 Begin
749 If Node.parent = FOutline.FRootNode
750 Then Result := Node.Index;
751 Node := Node.parent;
752 End;
753End;
754
755
756Function TOutlineNode.Index2Node(idx:LongInt):TOutlineNode;
757Var Node:TOutlineNode;
758 LastNode:TOutlineNode;
759 I:LongInt;
760Begin
761 If idx = Index Then
762 Begin
763 Result := Self;
764 Exit;
765 End;
766
767 {Find Last Node, where Index <= idx}
768 LastNode := Nil;
769 For I := 0 To ItemCount-1 Do
770 Begin
771 Node := Items[I];
772 If Node.Index = InvalidIndex Then break;
773 If Node.Index > idx Then break;
774 LastNode := Node;
775 End;
776
777 If LastNode <> Nil Then
778 Begin
779 Result := LastNode.Index2Node(idx);
780 Exit;
781 End;
782
783 FOutline.indexerror;
784End;
785
786
787Function TOutlineNode.ReIndex(idx,Max:LongInt):LongInt;
788Var Node:TOutlineNode;
789 I:LongInt;
790Begin
791 FIndex := idx;
792 FOutline.FGoodNode := Self;
793
794 For I := 0 To ItemCount-1 Do
795 Begin
796 Node := Items[I];
797 idx := Node.ReIndex(idx+1,Max);
798
799 If idx > Max Then {Stop reindexing}
800 Begin {Next sibling Of Node gets invalid Index}
801 If I < ItemCount-1 Then Items[I+1].FIndex := InvalidIndex;
802 break;
803 End;
804 End;
805 Result := idx;
806End;
807
808
809Procedure TOutlineNode.SetLastValidIndex;
810Var NextSibl:TOutlineNode;
811 idx:LongInt;
812Begin
813 idx := parent.FSubNodes.IndexOf(Self);
814
815 If idx < parent.FSubNodes.Count-1 Then NextSibl := parent.Items[idx+1]
816 Else NextSibl := Nil;
817
818 If NextSibl <> Nil Then NextSibl.FIndex := InvalidIndex;
819
820 If parent <> FOutline.FRootNode Then parent.SetLastValidIndex;
821End;
822
823
824Function TOutlineNode.HasVisibleParent:Boolean;
825Begin
826 If parent = FOutline.FRootNode Then Result := True
827 Else If Parent<>Nil Then Result := parent.FExpanded And parent.HasVisibleParent
828 Else Result:=False;
829End;
830
831
832Function TOutlineNode.GetVisibleParent:TOutlineNode;
833Begin
834 If IsVisible Then Result := Self
835 Else If Parent<>Nil Then Result := parent.GetVisibleParent
836 Else Result:=Nil;
837End;
838
839
840Procedure TOutlineNode.SetExpanded(Value:Boolean);
841Begin
842 If Value = FExpanded Then Exit;
843
844 If Value Then Expand
845 Else Collapse;
846End;
847
848
849Function TOutlineNode.GetFullPath:String;
850Begin
851 If Parent <> Nil Then
852 Begin
853 If Parent.Parent <> Nil Then
854 Result := Parent.GetFullPath + FOutline.FSeparator + Text
855 Else
856 Result := Text
857 End
858 Else Result := '';
859End;
860
861
862Procedure TOutlineNode.FullExpand;
863Var Node:TOutlineNode;
864 I:LongInt;
865Begin
866 For I := 0 To ItemCount-1 Do
867 Begin
868 Node := Items[I];
869 Node.FullExpand;
870 End;
871 Expand;
872End;
873
874
875Procedure TOutlineNode.FullCollapse;
876Var Node:TOutlineNode;
877 I:LongInt;
878Begin
879 Collapse;
880 For I := 0 To ItemCount-1 Do
881 Begin
882 Node := Items[I];
883 Node.FullCollapse;
884 End;
885End;
886
887
888Procedure TOutlineNode.Expand;
889Begin
890 FExpanded := True;
891 FOutline.Expand(FIndex);
892 If ItemCount = 0 Then Exit;
893 If FTreeRec = Nil Then Exit;
894 If FOutline.Handle = 0 Then Exit;
895
896 FOutline.FChangeLock:=True;
897 {$IFDEF OS2}
898 WinSendMsg(FOutline.Handle,CM_EXPANDTREE,LongWord(FTreeRec),0);
899 {$ENDIF}
900
901 {$IFDEF Win95}
902 SendMessage(FOutline.Handle,TVM_EXPAND,TVE_EXPAND,LongWord(FTreeRec^.RecordCore.hItem));
903 {$ENDIF}
904
905 FOutline.FChangeLock:=False;
906
907 If FTreeRec <> Nil Then UpdatePicture;
908
909 FOutline.UpdateNode(Self);
910End;
911
912Procedure TOutlineNode.Collapse;
913Begin
914 FExpanded := False;
915 FOutline.Collapse(FIndex);
916 If ItemCount = 0 Then Exit;
917 If FTreeRec = Nil Then Exit;
918 If FOutline.Handle = 0 Then Exit;
919
920 FOutline.FChangeLock:=True;
921
922 {$IFDEF OS2}
923 WinSendMsg(FOutline.Handle,CM_COLLAPSETREE,LongWord(FTreeRec),0);
924 {$ENDIF}
925
926 {$IFDEF Win95}
927 SendMessage(FOutline.Handle,TVM_EXPAND,TVE_COLLAPSE,LongWord(FTreeRec^.RecordCore.hItem));
928 {$ENDIF}
929
930 FOutline.FChangeLock:=False;
931
932 If FTreeRec <> Nil Then UpdatePicture;
933
934 FOutline.UpdateNode(Self);
935End;
936
937
938Function TOutlineNode.GetFirstChild:LongInt;
939Begin
940 Result := InvalidIndex;
941 If ItemCount = 0 Then Exit;
942 Result := Items[0].Index;
943End;
944
945
946Function TOutlineNode.GetLastChild:LongInt;
947Begin
948 Result := InvalidIndex;
949 If ItemCount = 0 Then Exit;
950 Result := Items[ItemCount-1].Index;
951End;
952
953
954Function TOutlineNode.GetNextChild(Value:LongInt):LongInt;
955Var idx:LongInt;
956Begin
957 Result := InvalidIndex;
958 If FSubNodes = Nil Then Exit;
959
960 For idx := 0 To ItemCount - 2 Do {0,1,2,...,N-2,_not_}
961 Begin
962 If Items[idx].Index = Value Then
963 Begin
964 Result := Items[idx + 1].Index;
965 Exit;
966 End;
967 End;
968End;
969
970
971Function TOutlineNode.GetPrevChild(Value:LongInt):LongInt;
972Var idx:LongInt;
973Begin
974 Result := InvalidIndex;
975 If FSubNodes = Nil Then Exit;
976
977 For idx := 1 To ItemCount - 1 Do {_not_,1,2,...,N-1}
978 Begin
979 If Items[idx].Index = Value Then
980 Begin
981 Result := Items[idx + 1].Index;
982 Exit;
983 End;
984 End;
985End;
986
987
988Function TOutlineNode.GetLevel:LongInt;
989Begin
990 If Self = FOutline.FRootNode Then Result := 0
991 Else Result := parent.GetLevel + 1;
992End;
993
994
995Function TOutlineNode.GetList:TList;
996Begin
997 If FSubNodes = Nil Then FSubNodes.Create;
998 Result := FSubNodes;
999End;
1000
1001
1002Function TOutlineNode.InsertNode(OldNode,NewNode:TOutlineNode):LongInt;
1003Var RecordOrder:pRecordOrder;
1004 I:LongInt;
1005Begin
1006 NewNode.FParent := Self;
1007
1008 I := List.IndexOf(OldNode);
1009 List.Insert(I, NewNode);
1010
1011 If I > 0 Then RecordOrder := Pointer(TOutlineNode(List.Items[I-1]).FTreeRec)
1012 Else LongWord(RecordOrder) := CMA_FIRST;
1013
1014 If FOutline.FIndexInsert Then
1015 Begin
1016 NewNode.FIndex := OldNode.Index;
1017 FOutline.SetGoodNode(NewNode);
1018 End
1019 Else NewNode.FIndex := InvalidIndex;
1020 Result := NewNode.Index;
1021
1022 NewNode.Setup(RecordOrder);
1023End;
1024
1025
1026Function TOutlineNode.AddNode(NewNode:TOutlineNode):LongInt;
1027Var PrevNode:TOutlineNode;
1028 RecordOrder:pRecordOrder;
1029Begin
1030 NewNode.FParent := Self;
1031
1032 If List.Count > 0 Then
1033 Begin
1034 PrevNode := TOutlineNode(List.Last);
1035 RecordOrder := Pointer(PrevNode.FTreeRec);
1036 End
1037 Else LongWord(RecordOrder) := CMA_FIRST;
1038
1039 List.Add(NewNode);
1040
1041 If FOutline.FIndexInsert Then
1042 Begin
1043 FOutline.SetGoodNode(Self);
1044 {force NewNode And successors have A correct Index}
1045 ReIndex(Index,MaxLongInt); {Time!}
1046 Result := NewNode.Index;
1047 End
1048 Else Result := InvalidIndex;
1049
1050 NewNode.Setup(RecordOrder);
1051End;
1052
1053
1054Procedure TOutlineNode.Setup(RecordOrder:Pointer);
1055Var TreeRec:POutlineRecord;
1056Begin
1057 If FOutline.Handle = 0 Then
1058 Begin
1059 {Show it With SetupTree}
1060 FOutline.FInitNodes := FOutline.FRootNode.FSubNodes;
1061 Exit;
1062 End;
1063 If FTreeRec = Nil Then AllocateRecord(FOutline.Handle,FTreeRec);
1064 SetupNode(Self);
1065
1066 If parent = FOutline.FRootNode Then TreeRec := Nil
1067 Else TreeRec := parent.FTreeRec;
1068
1069 InsertRecord(Self,TreeRec, pRecordOrder(RecordOrder));
1070 FOutline.SetupSubNodes(Self);
1071End;
1072
1073
1074Procedure TOutlineNode.ClearSubNodes;
1075Var T:LongInt;
1076Begin
1077 If FSubNodes = Nil Then Exit;
1078 For T := FSubNodes.Count-1 DownTo 0 Do
1079 Begin
1080 Items[T].FParent := Nil;
1081 Items[T].Destroy;
1082 End;
1083
1084 FSubNodes.Destroy;
1085 FSubNodes := Nil;
1086End;
1087
1088
1089Procedure TOutlineNode.Clear;
1090Begin
1091 FOutline.BeginUpdate;
1092 ClearSubNodes;
1093 FOutline.EndUpdate;
1094End;
1095
1096
1097Destructor TOutlineNode.Destroy;
1098Begin
1099 ClearSubNodes;
1100
1101 If Self <> FOutline.FRootNode Then
1102 Begin
1103 RemoveRecord(Self, True);
1104
1105 If FCaption <> Nil Then
1106 Begin
1107 FreeMem(FCaption,Length(FCaption^)+1);
1108 FCaption := Nil;
1109 End;
1110
1111 If FParent <> Nil Then
1112 If FParent.FSubNodes <> Nil Then FParent.FSubNodes.Remove(Self);
1113
1114 If FOutline.FCurItem = Self
1115 Then FOutline.FCurItem := FOutline.FRootNode;
1116 End;
1117
1118 Inherited Destroy;
1119End;
1120
1121
1122Function TOutlineNode.GetDataItem(Value:Pointer):LongInt;
1123Var I:LongInt;
1124 Node:TOutlineNode;
1125Begin
1126 If FData = Value Then
1127 Begin
1128 Result := FIndex;
1129 Exit;
1130 End;
1131
1132 For I := 0 To ItemCount-1 Do
1133 Begin
1134 Node := Items[I];
1135 Result := Node.GetDataItem(Value);
1136 If Result > 0 Then Exit;
1137 End;
1138 Result := 0;
1139End;
1140
1141
1142Function TOutlineNode.GetTextItem(Const Value:String):LongInt;
1143Var I:LongInt;
1144 Node:TOutlineNode;
1145Begin
1146 If Text = Value Then
1147 Begin
1148 Result := FIndex;
1149 Exit;
1150 End;
1151
1152 For I := 0 To ItemCount-1 Do
1153 Begin
1154 Node := Items[I];
1155 Result := Node.GetTextItem(Value);
1156 If Result > 0 Then Exit;
1157 End;
1158 Result := 0;
1159End;
1160
1161Function TOutlineNode.GetItemRect:TRect;
1162{$IFDEF OS2}
1163Var RecRect:QUERYRECORDRECT;
1164{$ENDIF}
1165Begin
1166 FillChar(result,sizeof(TRect),0);
1167 {$IFDEF OS2}
1168 RecRect.cb:=sizeof(QUERYRECORDRECT);
1169 RecRect.pRecord:=@FTreeRec^.RecordCore;
1170 RecRect.fRightSplitWindow:=0;
1171 RecRect.fsExtent:=CMA_ICON OR CMA_TEXT;
1172 WinSendMsg(FOutline.Handle,CM_QUERYRECORDRECT,LongWord(@Result),LongWord(@RecRect));
1173 {$ENDIF}
1174End;
1175
1176
1177
1178{
1179ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1180º º
1181º Speed-Pascal/2 Version 2.0 º
1182º º
1183º Speed-Pascal Component Classes (SPCC) º
1184º º
1185º This section: TOutline Class Implementation º
1186º º
1187º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1188º º
1189ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1190}
1191
1192Type
1193 TOutlineStrings=Class(TStrings)
1194 Private
1195 OutLine:TOutline;
1196 Protected
1197 Function GetCount: LongInt; Override;
1198 Function Get(Index: LongInt): String; Override;
1199 Function GetObject(Index: LongInt): TObject; Override;
1200 Procedure PutObject(Index: LongInt; AObject: TObject); Override;
1201 Procedure indexerror;
1202 Public
1203 Procedure Assign(AStrings:TStrings); Override;
1204 Function Add(Const S: String): LongInt; Override;
1205 Procedure Delete(Index: LongInt); Override;
1206 Procedure Insert(Index: LongInt; Const S: String); Override;
1207 Procedure Clear; Override;
1208 End;
1209
1210
1211Function TOutlineStrings.GetCount:LongInt;
1212Begin
1213 Result := OutLine.ItemCount;
1214End;
1215
1216
1217Function TOutlineStrings.Get(Index:LongInt):String;
1218Var Node:TOutlineNode;
1219 Level,I:LongInt;
1220Begin
1221 Node := OutLine.Items[Index+1];
1222 Level := Node.Level;
1223 Result := '';
1224 For I := 0 To Level-2 Do Result := Result + tab;
1225 Result := Result + Node.Text;
1226End;
1227
1228
1229Function TOutlineStrings.GetObject(Index:LongInt):TObject;
1230Begin
1231 Result := TObject(OutLine[Index + 1].Data);
1232End;
1233
1234
1235Procedure TOutlineStrings.PutObject(Index:LongInt; AObject:TObject);
1236Var Node:TOutlineNode;
1237Begin
1238 Node := OutLine[Index + 1];
1239 Node.Data := Pointer(AObject);
1240End;
1241
1242
1243Procedure TOutlineStrings.Assign(AStrings:TStrings);
1244Begin
1245 OutLine.BeginUpdate;
1246 Inherited Assign(AStrings);
1247 OutLine.EndUpdate;
1248End;
1249
1250
1251Function TOutlineStrings.Add(Const S:String):LongInt;
1252Var LastNode:TOutlineNode;
1253 s1:String;
1254 CountNodes,Level,LastLevel,I:LongInt;
1255Begin
1256 {Get Level from S}
1257 s1 := S;
1258 Level := 1;
1259 For I := 1 To Length(S) Do
1260 Begin
1261 If s1[1] In [' ',tab] Then
1262 Begin
1263 Inc(Level);
1264 System.Delete(s1,1,1);
1265 End
1266 Else break;
1267 End;
1268 {Get Last Node With Level-1 To Add A New Child}
1269 CountNodes := OutLine.ItemCount;
1270 If CountNodes > 0 Then LastNode := OutLine[CountNodes]
1271 Else LastNode := OutLine.FRootNode;
1272
1273 LastLevel := LastNode.Level;
1274 If (Level - LastLevel > 1) Or (LastNode = OutLine.FRootNode) Then
1275 Begin
1276 If Level - LastLevel > 1 Then OutLine.NodeError;
1277 End
1278 Else
1279 Begin
1280 For I := LastLevel DownTo Level Do
1281 Begin
1282 LastNode := LastNode.parent;
1283 If LastNode = Nil Then OutLine.NodeError;
1284 End;
1285 End;
1286
1287 Result := OutLine.AddChild(LastNode.Index, s1) - 1;
1288End;
1289
1290
1291Procedure TOutlineStrings.Delete(Index:LongInt);
1292Begin
1293 OutLine.Delete(Index + 1);
1294End;
1295
1296
1297Procedure TOutlineStrings.Insert(Index:LongInt;Const S:String);
1298Begin
1299 OutLine.Insert(Index + 1, S);
1300End;
1301
1302
1303Procedure TOutlineStrings.Clear;
1304Begin
1305 OutLine.Clear;
1306End;
1307
1308
1309Procedure TOutlineStrings.indexerror;
1310Begin
1311 OutLine.indexerror;
1312End;
1313
1314/////////////////////////////////////////////////////////////////////////////
1315
1316Procedure TOutline.SetBorderStyle(NewBorder:TBorderStyle);
1317Begin
1318 FBorderStyle := NewBorder;
1319 {$IFDEF OS2}
1320 SetCnrInfo;
1321 Invalidate;
1322 {$ENDIF}
1323 {$IFDEF Win95}
1324 RecreateWnd;
1325 {$ENDIF}
1326End;
1327
1328
1329Function TOutline.AddPicture(NewBitmap:TBitmap):TBitmap;
1330Var idx:LongInt;
1331Begin
1332 If NewBitmap = Nil Then
1333 Begin
1334 Result := Nil;
1335 Exit;
1336 End;
1337
1338 If FPictureList = Nil Then
1339 Begin
1340 FPictureList.Create;
1341 FPictureList.BitmapClass := TOutlineBitmap;
1342 FPictureList.Duplicates := False;
1343 End;
1344
1345 idx := FPictureList.IndexOfOrigin(NewBitmap);
1346 If idx < 0 Then {Not found}
1347 Begin
1348 idx := FPictureList.Add(NewBitmap); {Create local Bitmap}
1349 SetupImageList;
1350 End;
1351 Result := TBitmap(FPictureList.Bitmaps[idx]);
1352End;
1353
1354
1355Procedure TOutline.SetPictureLeaf(NewBitmap:TBitmap);
1356Begin
1357 FPictureLeaf := AddPicture(NewBitmap); {Get local Copy}
1358 SetCnrInfo;
1359 FRootNode.UpdateChildPictures;
1360End;
1361
1362
1363Procedure TOutline.SetPictureOpen(NewBitmap:TBitmap);
1364Begin
1365 FPictureOpen := AddPicture(NewBitmap); {Get local Copy}
1366 SetCnrInfo;
1367 FRootNode.UpdateChildPictures;
1368End;
1369
1370
1371Procedure TOutline.SetPictureClosed(NewBitmap:TBitmap);
1372Begin
1373 FPictureClosed := AddPicture(NewBitmap); {Get local Copy}
1374 SetCnrInfo;
1375 FRootNode.UpdateChildPictures;
1376End;
1377
1378
1379Function TOutline.GetPictureClosed:TBitmap;
1380Begin
1381 If FPictureClosed = Nil Then
1382 Begin
1383 FPictureClosed := TOutlineBitmap.Create;
1384 Include(FPictureClosed.ComponentState, csDetail);
1385 End;
1386 Result := FPictureClosed;
1387End;
1388
1389
1390Function TOutline.GetPictureOpen:TBitmap;
1391Begin
1392 If FPictureOpen = Nil Then
1393 Begin
1394 FPictureOpen := TOutlineBitmap.Create;
1395 Include(FPictureOpen.ComponentState, csDetail);
1396 End;
1397 Result := FPictureOpen;
1398End;
1399
1400
1401Function TOutline.GetPictureLeaf:TBitmap;
1402Begin
1403 If FPictureLeaf = Nil Then
1404 Begin
1405 FPictureLeaf := TOutlineBitmap.Create;
1406 Include(FPictureLeaf.ComponentState, csDetail);
1407 End;
1408 Result := FPictureLeaf;
1409End;
1410
1411
1412Procedure TOutline.GetClassData(Var ClassData:TClassData);
1413Begin
1414 Inherited GetClassData(ClassData);
1415
1416 {$IFDEF OS2}
1417 ClassData.ClassULong := WC_CONTAINER;
1418 {$ENDIF}
1419 {$IFDEF Win95}
1420 CreateSubClass(ClassData,WC_TREEVIEW);
1421 {$ENDIF}
1422End;
1423
1424
1425Procedure TOutline.DestroyWnd;
1426Begin
1427 {Store Tree Items -> Linear List}
1428 If Handle <> 0 Then
1429 If FInitLines <> Nil Then FInitLines.Assign(FLines);
1430
1431 If FRootNode <> Nil Then FRootNode.ClearSubNodes;
1432
1433 Inherited DestroyWnd;
1434End;
1435
1436
1437Destructor TOutline.Destroy;
1438Begin
1439 FLines.Destroy;
1440 FLines := Nil;
1441 FInitLines.Destroy;
1442 FInitLines := Nil;
1443 FRootNode.Destroy;
1444 FRootNode := Nil;
1445
1446 If FPictureList <> Nil Then
1447 Begin
1448 FPictureList.Destroy; {Destroy local Bitmaps}
1449 FPictureList := Nil;
1450 End;
1451
1452 {$IFDEF Win95}
1453 If FHim <> Nil Then ImageList_Destroy(FHim);
1454 FHim := Nil;
1455 {$ENDIF}
1456
1457 Inherited Destroy;
1458End;
1459
1460
1461Procedure TOutline.SetupComponent;
1462Begin
1463 Inherited SetupComponent;
1464
1465 Ownerdraw := False;
1466 Name := 'Outline';
1467 FRootNode.Create(Self);
1468 FRootNode.FIndex := 0;
1469 FRootNode.FParent := Nil;
1470 FGoodNode := FRootNode;
1471 FCurItem := FRootNode;
1472 FUpdateCount := 0;
1473 FSeparator := '\';
1474 FNodeClass := TOutlineNode;
1475
1476 FLines := TOutlineStrings.Create;
1477 TOutlineStrings(FLines).OutLine := Self;
1478 FInitLines.Create;
1479
1480 Height:=100;
1481 Width:=100;
1482 color:=clWindow;
1483 ParentPenColor:=False;
1484 ParentColor:=False;
1485 FBorderStyle:=bsSingle;
1486 FPlusMinusSize.CX:=16;
1487 FPlusMinusSize.CY:=16;
1488 FPictureSize.CX:=20;
1489 FPictureSize.CY:=20;
1490 FTreeLineWidth:=1;
1491 FShowTreeLines:=True;
1492 FShowPlusMinus:=True;
1493 FTreeIndent:=20;
1494 FLineSpacing:=0;
1495End;
1496
1497Procedure TOutline.SetupShow;
1498Begin
1499 Inherited SetupShow;
1500 CreateCanvas;
1501
1502 {Get information from StringList If available, Else Use invisible Tree}
1503 If FInitLines.Count > 0 Then
1504 Begin
1505 FLines.Assign(FInitLines);
1506 FInitLines.Clear;
1507 End;
1508
1509 If Handle=0 Then Exit;
1510 {Set Options}
1511 SetCnrInfo;
1512 SetupImageList;
1513 SetupTree;
1514End;
1515
1516{$IFDEF OS2}
1517Procedure TOutline.WMPaint(Var Msg:TMessage);
1518Var rc1,rcupdate:TRect;
1519Begin
1520 If FBorderStyle = bsSingle Then
1521 Begin {Exclude border from Redraw area}
1522 rc1 := ClientRect;
1523 {????????????+-1}
1524 Inc(rc1.Right);
1525 Inc(rc1.Top);
1526 InflateRect(rc1,-2,-2);
1527
1528 WinQueryUpdateRect(Handle,RECTL(rcupdate));
1529 WinValidateRect(Handle,RECTL(rcupdate),False);
1530 rcupdate := IntersectRect(rcupdate,rc1);
1531 WinInvalidateRect(Handle,RECTL(rcupdate),False);
1532 End;
1533
1534 DefaultHandler(Msg); {Do Default Action}
1535
1536 If FBorderStyle = bsSingle Then
1537 Begin
1538 rc1 := ClientRect;
1539 DrawSystemBorder(Self,rc1,FBorderStyle); {overpaint Text ON the border}
1540 End;
1541End;
1542{$ENDIF}
1543
1544
1545Procedure TOutline.SetShowTreeLines(NewValue:Boolean);
1546Begin
1547 FShowTreeLines:=NewValue;
1548 SetCnrInfo;
1549End;
1550
1551
1552Procedure TOutline.SetShowPlusMinus(NewValue:Boolean);
1553Begin
1554 FShowPlusMinus:=NewValue;
1555 SetCnrInfo;
1556End;
1557
1558
1559Procedure TOutline.SetTreeLineWidth(NewValue:LongInt);
1560Begin
1561 FTreeLineWidth:=NewValue;
1562 SetCnrInfo;
1563End;
1564
1565
1566Procedure TOutline.SetPlusMinusSize(NewSize:TSize);
1567Begin
1568 FPlusMinusSize:=NewSize;
1569 SetCnrInfo;
1570End;
1571
1572
1573Procedure TOutline.SetPictureSize(NewSize:TSize);
1574Begin
1575 FPictureSize:=NewSize;
1576 SetCnrInfo;
1577End;
1578
1579
1580Procedure TOutline.SetTreeIndent(Value:LongInt);
1581Begin
1582 FTreeIndent:=Value;
1583 SetCnrInfo;
1584End;
1585
1586
1587Procedure TOutline.SetLineSpacing(Value:LongInt);
1588Begin
1589 FLineSpacing:=Value;
1590 SetCnrInfo;
1591End;
1592
1593
1594Procedure TOutline.SetCnrInfo;
1595{$IFDEF OS2}
1596Var acnrInfo:CNRINFO;
1597 Flags:LongWord;
1598{$ENDIF}
1599{$IFDEF Win95}
1600Var WinStyle:LongWord;
1601{$ENDIF}
1602Begin
1603 If Handle = 0 Then Exit;
1604
1605 {$IFDEF OS2}
1606 FillChar(acnrInfo,SizeOf(CNRINFO),0);
1607 Flags:=CMA_FLWINDOWATTR;
1608
1609 With acnrInfo Do
1610 Begin
1611 cb:=SizeOf(CNRINFO);
1612 If (FPictureClosed <> Nil) Or (FPictureOpen <> Nil) Or
1613 (FPictureLeaf <> Nil) Then
1614 Begin
1615 If Not FShowPlusMinus Then
1616 Begin
1617 flWindowAttr:=CV_TREE Or CV_NAME;
1618 End
1619 Else flWindowAttr:=CV_TREE Or CV_ICON;
1620 End
1621 Else
1622 Begin
1623 If Not FShowPlusMinus Then
1624 Begin
1625 flWindowAttr:=CV_TREE Or CV_NAME
1626 End
1627 Else flWindowAttr:=CV_TREE Or CV_TEXT;
1628 End;
1629
1630 If FShowTreeLines Then flWindowAttr:=flWindowAttr Or CA_TREELINE;
1631
1632 slTreeBitmapOrIcon.CX:=FPlusMinusSize.CX;
1633 slTreeBitmapOrIcon.CY:=FPlusMinusSize.CY;
1634 Flags:=Flags Or CMA_SLTREEBITMAPORICON;
1635
1636 If (FPictureClosed <> Nil) Or (FPictureOpen <> Nil) Or
1637 (FPictureLeaf <> Nil) Then
1638 Begin
1639 slBitmapOrIcon.CX:=FPictureSize.CX;
1640 slBitmapOrIcon.CY:=FPictureSize.CY;
1641 Flags:=Flags Or CMA_SLBITMAPORICON;
1642 flWindowAttr:=flWindowAttr Or CA_DRAWBITMAP;
1643 End;
1644
1645 { grayed
1646 If FCaption<>Nil Then
1647 Begin
1648 flWindowAttr:=flWindowAttr Or CA_CONTAINERTITLE Or CA_TITLESEPARATOR;
1649 pszCnrTitle:=FCaption;
1650 Flags:=Flags Or CMA_CNRTITLE;
1651 End;
1652 }
1653
1654 If FTreeIndent<>0 Then
1655 Begin
1656 cxTreeIndent:=FTreeIndent;
1657 Flags:=Flags Or CMA_CXTREEINDENT;
1658 End;
1659
1660 If FLineSpacing<>0 Then
1661 Begin
1662 cyLineSpacing:=FLineSpacing;
1663 Flags:=Flags Or CMA_LINESPACING;
1664 End;
1665
1666 If FTreeLineWidth<>0 Then
1667 Begin
1668 cxTreeLine:=FTreeLineWidth;
1669 Flags:=Flags Or CMA_CXTREELINE;
1670 End;
1671 End;
1672 WinSendMsg(Handle,CM_SETCNRINFO,LongWord(@acnrInfo),Flags);
1673 {$ENDIF}
1674
1675 {$IFDEF Win95}
1676 WinStyle:=GetWindowLong(Handle,GWL_STYLE);
1677 If FShowTreeLines Then WinStyle:=WinStyle Or TVS_HASLINES Or TVS_LINESATROOT
1678 Else WinStyle:=WinStyle And Not (TVS_HASLINES Or TVS_LINESATROOT);
1679 If FShowPlusMinus Then WinStyle:=WinStyle Or TVS_HASBUTTONS
1680 Else WinStyle:=WinStyle And Not TVS_HASBUTTONS;
1681 SetWindowLong(Handle,GWL_STYLE,WinStyle);
1682 Invalidate;
1683 {$ENDIF}
1684End;
1685
1686
1687Procedure TOutline.SetupSubNodes(Node:TOutlineNode);
1688Var T:LongInt;
1689 WorkNode,ParentNode,PrevNode:TOutlineNode;
1690 P:Pointer;
1691Begin
1692 If Handle=0 Then Exit;
1693 If Node.FSubNodes=Nil Then Exit;
1694 {Create All subnodes}
1695 ParentNode:=Node;
1696 PrevNode:=Nil;
1697 For T:=0 To Node.FSubNodes.Count-1 Do
1698 Begin
1699 WorkNode:=Node.FSubNodes.Items[T];
1700 If WorkNode.FTreeRec=Nil Then
1701 Begin
1702 AllocateRecord(Handle,WorkNode.FTreeRec);
1703 SetupNode(WorkNode);
1704 End;
1705
1706 If PrevNode=Nil
1707 Then
1708 Begin
1709 LongWord(P):=CMA_FIRST;
1710 InsertRecord(WorkNode,ParentNode.FTreeRec,P)
1711 End
1712 Else InsertRecord(WorkNode,ParentNode.FTreeRec,Pointer(PrevNode.FTreeRec));
1713 SetupSubNodes(WorkNode);
1714 PrevNode:=WorkNode;
1715 End;
1716End;
1717
1718
1719Procedure TOutline.SetupTree;
1720Var T:LongInt;
1721 Node,PrevNode:TOutlineNode;
1722 P:Pointer;
1723Begin
1724 If Handle=0 Then Exit;
1725 If FInitNodes=Nil Then Exit;
1726 {Create All main Nodes}
1727 PrevNode:=Nil;
1728 For T:=0 To FInitNodes.Count-1 Do {the subnodes Of the root Node}
1729 Begin
1730 Node:=FInitNodes.Items[T];
1731 If Node.FTreeRec=Nil Then
1732 Begin
1733 AllocateRecord(Handle,Node.FTreeRec);
1734 SetupNode(Node);
1735 End;
1736
1737 If PrevNode=Nil Then
1738 Begin
1739 LongWord(P):=CMA_FIRST;
1740 InsertRecord(Node,Nil,P);
1741 End
1742 Else InsertRecord(Node,Nil,Pointer(PrevNode.FTreeRec));
1743 SetupSubNodes(Node);
1744 PrevNode:=Node;
1745 End;
1746 FInitNodes:=Nil;
1747End;
1748
1749
1750Procedure TOutline.SetupImageList;
1751{$IFDEF Win95}
1752Var Count:LongInt;
1753 T:LongInt;
1754 Bitmap:TOutlineBitmap;
1755 BitHandle:LongWord;
1756Label NoBmps;
1757{$ENDIF}
1758Begin
1759 {$IFDEF Win95}
1760 If Handle=0 Then Exit;
1761
1762 If FPictureList=Nil Then
1763 Begin
1764NoBmps:
1765 SendMessage(Handle,TVM_SETIMAGELIST,TVSIL_NORMAL,0);
1766 If FHim<>Nil Then ImageList_Destroy(FHim);
1767 FHim:=Nil;
1768 exit;
1769 End;
1770
1771 Count:=FPictureList.Count;
1772
1773 If Count=0 Then goto NoBmps;
1774
1775 If FHim<>Nil Then ImageList_Destroy(FHim);
1776 FHim:=ImageList_Create(FPictureSize.CX,FPictureSize.CY,ILC_COLOR4,Count,0);
1777
1778 For T:=0 To FPictureList.Count-1 Do
1779 Begin
1780 Bitmap:=TOutlineBitmap(FPictureList.Bitmaps[T]);
1781 BitHandle:=Bitmap.CreateBitmapFromClass;
1782 Bitmap.FHimlIndex:=ImageList_Add(FHim,BitHandle,0);
1783 DeleteObject(BitHandle);
1784 End;
1785
1786 SendMessage(Handle,TVM_SETIMAGELIST,TVSIL_NORMAL,LongWord(FHim));
1787 {$ENDIF}
1788End;
1789
1790
1791Procedure TOutline.CreateParams(Var Params:TCreateParams);
1792Begin
1793 Inherited CreateParams(Params);
1794
1795 {$IFDEF OS2}
1796 Params.Style := Params.Style
1797 Or CCS_AUTOPOSITION
1798 Or CCS_EXTENDSEL
1799 Or CCS_READONLY; // since we are not currently supporting direct edit
1800 {$ENDIF}
1801
1802 {$IFDEF Win95}
1803 Params.Style := Params.Style Or WS_CHILD;
1804 If FShowTreeLines
1805 Then Params.Style := Params.Style Or TVS_HASLINES Or TVS_LINESATROOT;
1806 If FShowPlusMinus Then Params.Style := Params.Style Or TVS_HASBUTTONS;
1807
1808 If FBorderStyle = bsSingle Then
1809 Begin
1810 Params.Style := Params.Style Or WS_BORDER; {Single}
1811 Params.ExStyle := Params.ExStyle Or WS_EX_CLIENTEDGE; {Double}
1812 End;
1813 {$ENDIF}
1814End;
1815
1816
1817Procedure TOutline.UpdateNode(Node:TOutlineNode);
1818Begin
1819 If Handle = 0 Then Exit;
1820 {$IFDEF OS2}
1821 WinSendMsg(Handle,CM_INVALIDATERECORD,LongWord(@Node.FTreeRec),
1822 MPFROM2SHORT(1,0));
1823 {$ENDIF}
1824 {$IFDEF Win95}
1825 SendMessage(Handle,TVM_SETITEM,0,LongWord(@Node.FTreeRec^.RecordCore));
1826 {$ENDIF}
1827End;
1828
1829
1830Function TOutline.GetSelectedNode:TOutlineNode;
1831{$IFDEF OS2}
1832Var RecordCore:POutlineRecord;
1833{$ENDIF}
1834{$IFDEF Win95}
1835Var tvItem:TV_ITEM;
1836{$ENDIF}
1837Begin
1838 Result:=Nil;
1839 If Handle=0 Then Exit;
1840 {$IFDEF OS2}
1841 RecordCore:=Pointer(WinSendMsg(Handle,CM_QUERYRECORDEMPHASIS,
1842 CMA_FIRST,CRA_SELECTED));
1843 If RecordCore<>Nil Then Result:=RecordCore^.Node;
1844 {$ENDIF}
1845 {$IFDEF Win95}
1846 FillChar(tvItem,SizeOf(TV_ITEM),0);
1847 tvItem.hItem:=FSelItem;
1848 tvItem.Mask:=TVIF_PARAM;
1849 SendMessage(Handle,TVM_GETITEM,0,LongWord(@tvItem));
1850 Result:=TOutlineNode(tvItem.LParam);
1851 {$ENDIF}
1852End;
1853
1854
1855Procedure TOutline.SetSelectedNode(NewSelected:TOutlineNode);
1856Begin
1857 If Handle=0 Then Exit;
1858 If NewSelected=Nil Then Exit;
1859
1860 If Not NewSelected.IsVisible
1861 Then NewSelected := NewSelected.GetVisibleParent;
1862 If NewSelected=Nil Then exit;
1863
1864 {$IFDEF OS2}
1865 WinSendMsg(Handle,CM_SETRECORDEMPHASIS,LongWord(NewSelected.FTreeRec),
1866 MPFROM2SHORT(1,CRA_SELECTED));
1867 {$ENDIF}
1868 {$IFDEF Win95}
1869 SendMessage(Handle,TVM_SELECTITEM,TVGN_CARET,
1870 LongWord(NewSelected.FTreeRec^.RecordCore.hItem));
1871 {$ENDIF}
1872End;
1873
1874
1875Function TOutline.GetSelectedItem:LongInt;
1876Var Node:TOutlineNode;
1877Begin
1878 Node := GetSelectedNode;
1879 If Node <> Nil Then Result := Node.Index
1880 Else Result := InvalidIndex;
1881End;
1882
1883
1884Procedure TOutline.SetSelectedItem(NewSelected:LongInt);
1885Var Node:TOutlineNode;
1886Begin
1887 Node := Get(NewSelected);
1888 If Node <> Nil Then SetSelectedNode(Node);
1889End;
1890
1891
1892Function TOutline.GetDataItem(Value:Pointer):LongInt;
1893Begin
1894 Result := FRootNode.GetDataItem(Value);
1895End;
1896
1897
1898Function TOutline.GetTextItem(Const Value:String):LongInt;
1899Begin
1900 Result := FRootNode.GetTextItem(Value);
1901End;
1902
1903
1904Procedure TOutline.ItemFocus(Index:LongInt);
1905Begin
1906 If OnItemFocus <> Nil Then OnItemFocus(Self,Index);
1907 If SelectedItem<>InvalidIndex Then Click;
1908End;
1909
1910
1911Procedure TOutline.ItemSelect(Index:LongInt);
1912Begin
1913 If OnItemSelect <> Nil Then OnItemSelect(Self,Index);
1914End;
1915
1916
1917{$HINTS OFF}
1918Procedure TOutline.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
1919Var Node1,Node2:TOutlineNode;
1920Begin
1921 Case KeyCode Of
1922 kbCUp,kbCDown,kbHome,kbEnd,kbPageUp,kbPageDown:
1923 Begin
1924 Node1 := SelectedNode;
1925 LastMsg.CallDefaultHandler; //!
1926 Node2 := SelectedNode;
1927 If Node1 <> Node2 Then
1928 If Node2 Is TOutlineNode Then ItemFocus(Node2.Index);
1929 End;
1930 Else Inherited ScanEvent(KeyCode,RepeatCount);
1931 End;
1932End;
1933
1934Procedure TOutline.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1935Begin
1936 {$IFDEF WIN32}
1937 If Button=mbRight Then
1938 Begin
1939 LastMsg.Handled:=True;
1940 exit;
1941 End;
1942 {$ENDIF}
1943
1944 Inherited MouseDown(Button,ShiftState,X,Y);
1945
1946 If Button = mbLeft Then
1947 Begin
1948 FDragging := True;
1949 FFocusNode := SelectedNode;
1950 End;
1951End;
1952
1953Procedure TOutline.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
1954Var Node:TOutlineNode;
1955Begin
1956 Inherited MouseMove(ShiftState,X,Y);
1957
1958 If FDragging Then
1959 Begin
1960 Node := SelectedNode;
1961 If Node <> FFocusNode Then
1962 If Node Is TOutlineNode Then
1963 Begin
1964 FFocusNode := Node;
1965 ItemFocus(Node.Index);
1966 End;
1967 End;
1968End;
1969
1970
1971Procedure TOutline.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1972Var Node:TOutlineNode;
1973Begin
1974 {$IFDEF WIN32}
1975 If Button=mbRight Then
1976 Begin
1977 LastMsg.Handled:=True;
1978 exit;
1979 End;
1980 {$ENDIF}
1981
1982 Inherited MouseUp(Button,ShiftState,X,Y);
1983
1984 If FDragging Then
1985 Begin
1986 FDragging := False;
1987 Node := SelectedNode;
1988 If Node <> FFocusNode Then
1989 If Node Is TOutlineNode Then
1990 Begin
1991 FFocusNode := Node;
1992 ItemFocus(Node.Index);
1993 End;
1994 End;
1995End;
1996
1997Procedure TOutline.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1998Begin
1999 Inherited MouseDblClick(Button,ShiftState,X,Y);
2000
2001 {$IFDEF WIN32}
2002 If SelectedNode<>Nil Then ItemSelect(SelectedNode.Index);
2003 {$ENDIF}
2004End;
2005
2006Procedure TOutline.MouseClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
2007Begin
2008 {$IFDEF OS2}
2009 If OnMouseClick <> Nil Then OnMouseClick(Self,Button,ShiftState,X,Y);
2010 {no Inherited because Of CN_CONTEXTMENU, but Store the mouse Pos}
2011 FPopupPos := Point(X,Y);
2012 {$ENDIF}
2013 {$IFDEF WIN32}
2014 FPopupPos := Point(X,Y);
2015 Inherited MouseClick(Button,ShiftState,X,Y);
2016 {$ENDIF}
2017End;
2018{$HINTS ON}
2019
2020Procedure TOutline.Expand(Index:LongInt);
2021Begin
2022 If FOnExpand <> Nil Then FOnExpand(Self,Index);
2023End;
2024
2025Procedure TOutline.Collapse(Index:LongInt);
2026Begin
2027 If FOnCollapse <> Nil Then FOnCollapse(Self,Index);
2028End;
2029
2030Procedure TOutline.Click;
2031Begin
2032 If FOnClick<>Nil Then FOnClick(Self);
2033End;
2034
2035Procedure TOutline.ItemChanged(Var Msg:TMessage;Expanded:Boolean);
2036Var Node:TOutlineNode;
2037 {$IFDEF OS2}
2038 RecordCore:POutlineRecord;
2039 {$ENDIF}
2040 {$IFDEF Win95}
2041 DispInfo:^NM_TREEVIEW;
2042 Item:TV_ITEM;
2043 {$ENDIF}
2044Begin
2045 {$IFDEF OS2}
2046 RecordCore := Pointer(Msg.Param2);
2047 Node := RecordCore^.Node;
2048 If Node = Nil Then Exit;
2049 {$ENDIF}
2050
2051 {$IFDEF Win95}
2052 DispInfo := Pointer(Msg.Param2);
2053 Item := DispInfo^.ItemNew;
2054 Node := TOutlineNode(Item.LParam);
2055 If Node = Nil Then Exit;
2056
2057 Node.UpdatePicture{(Node.FPictureLeaf)???};
2058 {$ENDIF}
2059
2060 Node.FExpanded := Expanded;
2061 Node.UpdatePicture;
2062 If Node.Expanded Then
2063 Begin
2064 If not FChangeLock Then
2065 Begin
2066 If Node.FIndex=InvalidIndex Then FRootNode.ReIndex(FRootNode.Index,MaxLongInt);
2067 If Node.FIndex<>InvalidIndex Then Expand(Node.FIndex);
2068 End;
2069 End
2070 Else
2071 Begin
2072 If not FChangeLock Then
2073 Begin
2074 If Node.FIndex=InvalidIndex Then FRootNode.ReIndex(FRootNode.Index,MaxLongInt);
2075 If Node.FIndex<>InvalidIndex Then Collapse(Node.FIndex);
2076 End;
2077 End;
2078
2079 UpdateNode(Node);
2080End;
2081
2082
2083Procedure TOutline.BeginUpdate;
2084Begin
2085 If FUpdateCount = 0 Then
2086 Begin
2087 If Handle <> 0 Then
2088 {$IFDEF OS2}
2089 WinEnableWindowUpdate(Handle,False);
2090 {$ENDIF}
2091 {$IFDEF Win95}
2092 SendMessage(Handle,WM_SETREDRAW, 0, 0);
2093 {$ENDIF}
2094 End;
2095 Inc(FUpdateCount);
2096End;
2097
2098
2099Procedure TOutline.EndUpdate;
2100Begin
2101 Dec(FUpdateCount);
2102 If FUpdateCount = 0 Then
2103 Begin
2104 If Handle <> 0 Then
2105 Begin
2106 {$IFDEF OS2}
2107 WinEnableWindowUpdate(Handle,True);
2108 {$ENDIF}
2109 {$IFDEF Win95}
2110 SendMessage(Handle,WM_SETREDRAW, 1, 0);
2111 {$ENDIF}
2112 End;
2113 FRootNode.ReIndex(FRootNode.Index,MaxLongInt);
2114 End;
2115End;
2116
2117
2118Procedure TOutline.ParentNotification(Var Msg:TMessage);
2119{$IFDEF OS2}
2120Var Node:TOutlineNode;
2121 RecordCore:POutlineRecord;
2122 RecEnter:PNOTIFYRECORDENTER;
2123 RecEmp:PNOTIFYRECORDEMPHASIS;
2124 SaveCount:LongInt;
2125{$ENDIF}
2126{$IFDEF WIN32}
2127Var DispInfo:^NM_TREEVIEW;
2128 Expanded:Boolean;
2129 KeyDown:^TV_KEYDOWN;
2130{$ENDIF}
2131CONST CN_TEST=0;
2132Begin
2133 {$IFDEF OS2}
2134 Case Msg.Param1Hi Of
2135 CN_SCROLL:
2136 Begin
2137 Inherited ParentNotification(Msg);
2138
2139 {!! Update BitBlt area Of the Ownerdraw Frame}
2140 If FBorderStyle = bsSingle Then Invalidate;
2141 End;
2142 CN_ENTER: {Enter & DoubleClick}
2143 Begin
2144 If Designed Then Exit;
2145 Inherited ParentNotification(Msg);
2146
2147 RecEnter := Pointer(Msg.Param2);
2148 If RecEnter = Nil Then Exit;
2149 RecordCore := Pointer(RecEnter^.pRecord);
2150 If RecordCore = Nil Then Exit;
2151 Node := RecordCore^.Node;
2152
2153 If Node Is TOutlineNode Then ItemSelect(Node.Index);
2154 End;
2155 CN_COLLAPSETREE,CN_EXPANDTREE:
2156 Begin
2157 If Designed Then Exit;
2158 Inherited ParentNotification(Msg);
2159
2160 RecordCore := Pointer(Msg.Param2);
2161 Node := RecordCore^.Node;
2162
2163 If Node Is TOutlineNode Then
2164 Begin
2165 If Msg.Param1Hi = CN_COLLAPSETREE
2166 Then ItemChanged(Msg,False)
2167 Else ItemChanged(Msg,True)
2168 End;
2169 {!! Update area Of the Ownerdraw Frame}
2170 If FBorderStyle = bsSingle Then Invalidate;
2171 End;
2172 CN_CONTEXTMENU:
2173 Begin
2174 If Designed Then Exit;
2175 CheckMenuPopup(FPopupPos);
2176 End;
2177(* Cut no effect
2178 CN_REALLOCPSZ:
2179 Begin
2180 End;
2181 CN_ENDEDIT:
2182 Begin
2183 CnrEdit := Pointer(Msg.Param2);
2184 RecordCore := POutlineRecord(CnrEdit^.pRecord);
2185 Node := RecordCore^.Node;
2186 ppc := CnrEdit^.ppszText;
2187 pc := ppc^;
2188 S := pc^;
2189 ErrorBox2(S+' <> '+RecordCore^.RecordCore.pszTree^);
2190 Msg.Handled := True;
2191 Msg.Result := 0;
2192 End;
2193*)
2194 CN_EMPHASIS:
2195 Begin
2196 Inherited ParentNotification(Msg);
2197
2198 RecEmp := Pointer(Msg.Param2);
2199 If RecEmp = Nil Then Exit;
2200 RecordCore := Pointer(RecEmp^.pRecord);
2201 If RecordCore = Nil Then Exit;
2202 Node := RecordCore^.Node;
2203 DefaultHandler(Msg);
2204
2205 If (RecEmp^.fEmphasisMask And 5)=5 Then
2206 If SelectedNode=Node Then
2207 Begin
2208 PostMsg(Parent.Handle,WM_CONTROL,
2209 Msg.Param1Lo OR (CN_TEST SHL 16),
2210 LONGWORD(Node));
2211 End;
2212 End;
2213 CN_TEST:
2214 BEGIN
2215 Node := Pointer(Msg.Param2);
2216 If (LongWord(Node) And $80000000)=0 Then
2217 If LongWord(Node)>$10000 Then
2218 Begin
2219 Try
2220 If FUpdateCount>0 Then FRootNode.ReIndex(FRootNode.Index,MaxLongInt);
2221 SaveCount:=FUpdateCount;
2222 FUpdateCount:=0;
2223 If Node IS TOutlineNode Then ItemFocus(Node.Index);
2224 FUpdateCount:=FUpdateCount+SaveCount;
2225 Except
2226 End;
2227 End;
2228 Msg.Handled:=True;
2229 END;
2230 Else
2231 Begin
2232 Inherited ParentNotification(Msg);
2233 End;
2234 End;
2235 {$ENDIF}
2236
2237 {$IFDEF Win95}
2238 If Msg.Msg<>WM_NOTIFY Then
2239 Begin
2240 Inherited ParentNotification(Msg);
2241 exit;
2242 End;
2243
2244 DispInfo:=Pointer(Msg.Param2);
2245 If DispInfo=Nil Then Exit;
2246 Case DispInfo^.hdr.Code Of
2247 TVN_ITEMEXPANDED:
2248 Begin
2249 Expanded:=DispInfo^.Action And TVE_EXPAND=TVE_EXPAND;
2250
2251 ItemChanged(Msg,Expanded);
2252
2253 Msg.Handled:=True;
2254 Msg.Result:=0;
2255 End;
2256 TVN_KEYDOWN:
2257 Begin
2258 KeyDown:=Pointer(Msg.Param2);
2259
2260 If KeyDown^.wVKey=VK_RETURN Then
2261 If SelectedNode<>Nil Then ItemSelect(SelectedNode.Index);
2262 End;
2263 TVN_SELCHANGED:
2264 Begin
2265 FSelItem:=DispInfo^.ItemNew.hItem;
2266 End;
2267 Else Inherited ParentNotification(Msg);
2268 End; {Case}
2269 {$ENDIF}
2270End;
2271
2272
2273Procedure TOutline.indexerror;
2274Begin
2275 Raise EOutlineIndexError.Create(LoadNLSStr(SInvalidOutlineNodeIndex));
2276End;
2277
2278
2279Procedure TOutline.NodeError;
2280Begin
2281 Raise EOutlineNodeError.Create(LoadNLSStr(SInvalidOutlineNode)+' (NIL)');
2282End;
2283
2284
2285Function TOutline.AttachNode(Node:TOutlineNode;Const Text:String;Data:Pointer;
2286 Mode:TAttachMode):TOutlineNode;
2287Var NewNode:TOutlineNode;
2288Begin
2289 If Node = Nil Then Node := FRootNode;
2290
2291 NewNode := FNodeClass.Create(Self);
2292 NewNode.Data := Data;
2293 NewNode.Text := Text;
2294 NewNode.FIndex := InvalidIndex;
2295 NewNode.FExpanded := False;
2296
2297 Case Mode Of
2298 oaAddChild: Node.AddNode(NewNode);
2299 oaAdd: Node.parent.AddNode(NewNode);
2300 oaInsert: Node.parent.InsertNode(Node,NewNode);
2301 End;
2302 Result := NewNode;
2303End;
2304
2305
2306Function TOutline.Add(Index:LongInt;Const Text:String):LongInt;
2307Begin
2308 Result := AddObject(Index,Text,Nil);
2309End;
2310
2311
2312{Add To the same Level like idx Node}
2313Function TOutline.AddObject(Index:LongInt;Const Text:String;Data:Pointer):LongInt;
2314Begin
2315 If Index >= 0 Then
2316 Begin
2317 If Index = 0 Then Result := AddChildObject(Index,Text,Data)
2318 Else Result := Attach(Index,Text,Data,oaAdd);
2319 End
2320 Else indexerror;
2321End;
2322
2323
2324{Add As Child Of the idx Node}
2325Function TOutline.AddChild(Index:LongInt;Const Text:String):LongInt;
2326Begin
2327 Result := AddChildObject(Index,Text,Nil);
2328End;
2329
2330
2331Function TOutline.AddChildObject(Index:LongInt;Const Text:String;Data:Pointer):LongInt;
2332Begin
2333 If Index >= 0 Then Result := Attach(Index,Text,Data,oaAddChild)
2334 Else indexerror;
2335End;
2336
2337
2338Function TOutline.Insert(Index:LongInt;Const Text:String):LongInt;
2339Begin
2340 Result := InsertObject(Index,Text,Nil);
2341End;
2342
2343
2344Function TOutline.InsertObject(Index:LongInt;Const Text:String;Data:Pointer):LongInt;
2345Begin
2346 If Index >= 0 Then
2347 Begin
2348 If Index = 0 Then Result := AddChildObject(Index,Text,Data)
2349 Else Result := Attach(Index,Text,Data,oaInsert);
2350 End
2351 Else indexerror;
2352End;
2353
2354
2355{Create the Node And Insert it}
2356Function TOutline.Attach(idx:LongInt;Const Text:String;Data:Pointer;
2357 Mode:TAttachMode):LongInt;
2358Var Node:TOutlineNode;
2359Begin
2360 If idx = 0 Then Node := FRootNode
2361 Else Node := Get(idx);
2362 If Node = Nil Then NodeError;
2363
2364 FIndexInsert := True; {force To Update Index}
2365 Node := AttachNode(Node,Text,Data,Mode);
2366 FIndexInsert := False; {Index Update Mode = OFF}
2367
2368 If Node <> Nil Then Result := Node.FIndex
2369 Else Result := InvalidIndex;
2370End;
2371
2372
2373Procedure TOutline.Delete(Index:LongInt);
2374Var ANode:TOutlineNode;
2375 AParent:TOutlineNode;
2376Begin
2377 If Index > 0 Then
2378 Begin
2379 ANode := Get(Index);
2380 AParent := ANode.parent;
2381 ANode.Destroy;
2382
2383 SetGoodNode(AParent);
2384 End
2385 Else indexerror;
2386End;
2387
2388
2389Procedure TOutline.SetGoodNode(Node:TOutlineNode);
2390Begin
2391 If FUpdateCount > 0 Then
2392 Begin
2393 FGoodNode := Node;
2394 If FGoodNode <> FRootNode Then FGoodNode.SetLastValidIndex;
2395 End
2396 Else FRootNode.ReIndex(FRootNode.Index,MaxLongInt);
2397End;
2398
2399
2400Function TOutline.GetLines:TStrings;
2401Begin
2402 If Handle <> 0 Then Result := FLines
2403 Else Result := FInitLines;
2404End;
2405
2406
2407Procedure TOutline.SetLines(AStrings:TStrings);
2408Begin
2409 If Lines <> AStrings Then Lines.Assign(AStrings);
2410End;
2411
2412
2413Function TOutline.Get(idx:LongInt):TOutlineNode;
2414Begin
2415 If FCurItem.Index = idx Then
2416 Begin
2417 Result := FCurItem;
2418 Exit;
2419 End;
2420 If FGoodNode.Index = idx Then
2421 Begin
2422 Result := FGoodNode;
2423 Exit;
2424 End;
2425
2426 If FGoodNode.Index < idx Then
2427 Begin
2428 FRootNode.ReIndex(FRootNode.Index,idx);
2429 End;
2430
2431 Result := FRootNode.Index2Node(idx);
2432 FCurItem := Result;
2433End;
2434
2435
2436Function TOutline.GetItemCount:LongInt;
2437Begin
2438 FRootNode.ReIndex(FRootNode.Index,MaxLongInt);
2439
2440 Result := FRootNode.GetLastIndex;
2441End;
2442
2443
2444Procedure TOutline.FullExpand;
2445Begin
2446 FRootNode.FullExpand;
2447End;
2448
2449
2450Procedure TOutline.FullCollapse;
2451Begin
2452 FRootNode.FullCollapse;
2453End;
2454
2455
2456Procedure TOutline.Clear;
2457Begin
2458 BeginUpdate;
2459 FRootNode.ClearSubNodes;
2460 EndUpdate;
2461End;
2462
2463
2464Function TOutline.WriteSCUResource(Stream:TResourceStream):Boolean;
2465Var aText:PChar;
2466Begin
2467 Result := Inherited WriteSCUResource(Stream);
2468 If Not Result Then Exit;
2469
2470 If (FPictureLeaf <> Nil) And Not FPictureLeaf.Empty
2471 Then Result := FPictureLeaf.WriteSCUResourceName(Stream,rnPictureLeaf);
2472 If Not Result Then Exit;
2473
2474 If (FPictureOpen <> Nil) And Not FPictureOpen.Empty
2475 Then Result := FPictureOpen.WriteSCUResourceName(Stream,rnPictureOpen);
2476 If Not Result Then Exit;
2477
2478 If (FPictureClosed <> Nil) And Not FPictureClosed.Empty
2479 Then Result := FPictureClosed.WriteSCUResourceName(Stream,rnPictureClosed);
2480 If Not Result Then Exit;
2481
2482 aText := Lines.GetText;
2483 If aText <> Nil Then
2484 Begin
2485 Result := Stream.NewResourceEntry(rnLines,aText^,Length(aText^)+1);
2486 StrDispose(aText);
2487 If Not Result Then Exit;
2488 End;
2489End;
2490
2491
2492Procedure TOutline.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
2493Var aText:PChar;
2494Begin
2495 If ResName = rnLines Then
2496 Begin
2497 aText := @Data;
2498 Lines.SetText(aText);
2499 End Else
2500 If ResName = rnPictureLeaf Then
2501 Begin
2502 If DataLen <> 0
2503 Then PictureLeaf.ReadSCUResource(rnBitmap,Data,DataLen);
2504 End Else
2505 If ResName = rnPictureOpen Then
2506 Begin
2507 If DataLen <> 0
2508 Then PictureOpen.ReadSCUResource(rnBitmap,Data,DataLen);
2509 End Else
2510 If ResName = rnPictureClosed Then
2511 Begin
2512 If DataLen <> 0
2513 Then PictureClosed.ReadSCUResource(rnBitmap,Data,DataLen);
2514 End
2515 Else Inherited ReadSCUResource(ResName,Data,DataLen)
2516End;
2517
2518Function TOutline.NodeFromPoint(pt:TPoint):TOutlineNode;
2519Var t:LongInt;
2520 rec:TRect;
2521Begin
2522 For t:=0 To ItemCount-1 Do
2523 Begin
2524 result:=Items[t];
2525 rec:=result.ItemRect;
2526 If ((pt.X>=rec.Left)And(pt.X<=rec.Right)) Then
2527 If ((pt.Y>=rec.Bottom)And(pt.Y<=rec.Top)) Then exit;
2528 End;
2529 result:=Nil;
2530End;
2531
2532Procedure TOutline.DrawDragRect;
2533Begin
2534 If Canvas = Nil Then Exit;
2535 Canvas.Pen.Mode:=pmNot;
2536 Canvas.Pen.color:=clBlack;
2537 Canvas.Pen.Style:=psDot;
2538 Canvas.Rectangle(FDragRect);
2539 Canvas.Pen.Mode:=pmCopy;
2540End;
2541
2542Procedure TOutline.DragOver(Source:TObject;X,Y:LongInt;State:TDragState;Var Accept:Boolean);
2543Var Node:TOutlineNode;
2544Label invalid;
2545Begin
2546 Node:=Nil;
2547 Inherited DragOver(Source,X,Y,State,Accept);
2548 If FShowDragRects Then
2549 Begin
2550 If Accept Then
2551 Begin
2552 Node:=NodeFromPoint(Point(X,Y));
2553 If Node<>Nil Then
2554 Begin
2555 Case State Of
2556 dsDragEnter:
2557 Begin
2558 CreateDragCanvas;
2559 If FDragRectValid Then DrawDragRect; //Delete old
2560 FDragRect := Node.ItemRect;
2561 FDragRectValid:=True;
2562 DrawDragRect; //Draw New
2563 DeleteDragCanvas;
2564 End;
2565 dsDragMove:
2566 If Node<>FDragSelected Then
2567 Begin
2568 CreateDragCanvas;
2569 If FDragRectValid Then DrawDragRect; //Delete old
2570 FDragRect := Node.ItemRect;
2571 FDragRectValid:=True;
2572 DrawDragRect; //Draw New
2573 DeleteDragCanvas;
2574 End;
2575 dsDragLeave:
2576 Begin
2577 If FDragRectValid Then
2578 Begin
2579 FDragRectValid:=False;
2580 CreateDragCanvas;
2581 DrawDragRect; //Delete old
2582 DeleteDragCanvas;
2583 End;
2584 End;
2585 End; //Case
2586 End
2587 Else Goto invalid;
2588 End
2589 Else
2590 Begin
2591invalid:
2592 If FDragRectValid Then
2593 Begin
2594 FDragRectValid:=False;
2595 CreateDragCanvas;
2596 DrawDragRect; //Delete old
2597 DeleteDragCanvas;
2598 End;
2599 End;
2600 FDragSelected:=Node;
2601 End;
2602End;
2603
2604Procedure TOutline.DragDrop(Source:TObject;X,Y:LongInt);
2605Begin
2606 If FDragRectValid Then
2607 Begin
2608 CreateDragCanvas;
2609 DrawDragRect; //Delete old
2610 DeleteDragCanvas;
2611 FDragRectValid:=False;
2612 End;
2613 Inherited DragDrop(Source,X,Y);
2614End;
2615
2616
2617
2618Begin
2619End.
2620
2621
Note: See TracBrowser for help on using the repository browser.