home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / T-Pascal.70 / SOURCE.ZIP / OUTLINE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-30  |  25KB  |  915 lines

  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Outline;
  12.  
  13. {$O+,F+,X+,I-,S-,R-}
  14.  
  15. interface
  16.  
  17. uses Objects, Drivers, Views;
  18.  
  19. const
  20.   ovExpanded = $01;
  21.   ovChildren = $02;
  22.   ovLast     = $04;
  23.  
  24. const
  25.   cmOutlineItemSelected = 301;
  26.  
  27. const
  28.   COutlineViewer = CScroller + #8#8;
  29.  
  30. type
  31.  
  32. { TOutlineViewer  object }
  33.  
  34.   { Palette layout }
  35.   { 1 = Normal color }
  36.   { 2 = Focus color }
  37.   { 3 = Select color }
  38.   { 4 = Not expanded color }
  39.  
  40.   POutlineViewer = ^TOutlineViewer;
  41.   TOutlineViewer = object(TScroller)
  42.     Foc: Integer;
  43.     constructor Init(var Bounds: TRect; AHScrollBar,
  44.       AVScrollBar: PScrollBar);
  45.     constructor Load(var S: TStream);
  46.     procedure Adjust(Node: Pointer; Expand: Boolean); virtual;
  47.     function CreateGraph(Level: Integer; Lines: LongInt; Flags: Word;
  48.       LevWidth, EndWidth: Integer; const Chars: String): String;
  49.     procedure Draw; virtual;
  50.     procedure ExpandAll(Node: Pointer);
  51.     function FirstThat(Test: Pointer): Pointer;
  52.     procedure Focused(I: Integer); virtual;
  53.     function ForEach(Action: Pointer): Pointer;
  54.     function GetChild(Node: Pointer; I: Integer): Pointer; virtual;
  55.     function GetGraph(Level: Integer; Lines: LongInt; Flags: Word): String; virtual;
  56.     function GetNumChildren(Node: Pointer): Integer; virtual;
  57.     function GetNode(I: Integer): Pointer;
  58.     function GetPalette: PPalette; virtual;
  59.     function GetRoot: Pointer; virtual;
  60.     function GetText(Node: Pointer): String; virtual;
  61.     procedure HandleEvent(var Event: TEvent); virtual;
  62.     function HasChildren(Node: Pointer): Boolean; virtual;
  63.     function IsExpanded(Node: Pointer): Boolean; virtual;
  64.     function IsSelected(I: Integer): Boolean; virtual;
  65.     procedure Selected(I: Integer); virtual;
  66.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  67.     procedure Store(var S: TStream);
  68.     procedure Update;
  69.   private
  70.     procedure AdjustFocus(NewFocus: Integer);
  71.     function Iterate(Action: Pointer; CallerFrame: Word;
  72.       CheckRslt: Boolean): Pointer;
  73.   end;
  74.  
  75. { TNode }
  76.  
  77.   PNode = ^TNode;
  78.   TNode = record
  79.     Next: PNode;
  80.     Text: PString;
  81.     ChildList: PNode;
  82.     Expanded: Boolean;
  83.   end;
  84.  
  85. { TOutline object }
  86.  
  87.   { Palette layout }
  88.   { 1 = Normal color }
  89.   { 2 = Focus color }
  90.   { 3 = Select color }
  91.  
  92.   POutline = ^TOutline;
  93.   TOutline = object(TOutlineViewer)
  94.     Root: PNode;
  95.  
  96.     constructor Init(var Bounds: TRect; AHScrollBar,
  97.       AVScrollBar: PScrollBar; ARoot: PNode);
  98.     constructor Load(var S: TStream);
  99.     destructor Done; virtual;
  100.  
  101.     procedure Adjust(Node: Pointer; Expand: Boolean); virtual;
  102.     function GetRoot: Pointer; virtual;
  103.     function GetNumChildren(Node: Pointer): Integer; virtual;
  104.     function GetChild(Node: Pointer; I: Integer): Pointer; virtual;
  105.     function GetText(Node: Pointer): String; virtual;
  106.     function IsExpanded(Node: Pointer): Boolean; virtual;
  107.     function HasChildren(Node: Pointer): Boolean; virtual;
  108.     procedure Store(var S: TStream);
  109.   end;
  110.  
  111. const
  112.   ROutline: TStreamRec = (
  113.      ObjType: 91;
  114.      VmtLink: Ofs(TypeOf(TOutline)^);
  115.      Load:    @TOutline.Load;
  116.      Store:   @TOutline.Store
  117.   );
  118.  
  119. procedure RegisterOutline;
  120. function NewNode(const AText: String; AChildren, ANext: PNode): PNode;
  121. procedure DisposeNode(Node: PNode);
  122.  
  123. implementation
  124.  
  125. { TOutlineViewer }
  126.  
  127. constructor TOutlineViewer.Init(var Bounds: TRect; AHScrollBar,
  128.   AVScrollBar: PScrollBar);
  129. begin
  130.   inherited Init(Bounds, AHScrollBar, AVScrollBar);
  131.   GrowMode := gfGrowHiX + gfGrowHiY;
  132.   Foc := 0;
  133. end;
  134.  
  135. constructor TOutlineViewer.Load(var S: TStream);
  136. begin
  137.   inherited Load(S);
  138.   S.Read(Foc, SizeOf(Foc));
  139. end;
  140.  
  141. { Called when the user requests Node to be contracted or
  142.   expanded (i.e. its children to be hidden or shown) }
  143.  
  144. procedure TOutlineViewer.Adjust(Node: Pointer; Expand: Boolean);
  145. begin
  146.   Abstract;
  147. end;
  148.  
  149. { Called internally to ensure the focus is within range and displayed }
  150.  
  151. procedure TOutlineViewer.AdjustFocus(NewFocus: Integer);
  152. begin
  153.   if NewFocus < 0 then NewFocus := 0
  154.   else if NewFocus >= Limit.Y then NewFocus := Limit.Y - 1;
  155.   if Foc <> NewFocus then Focused(NewFocus);
  156.   if NewFocus < Delta.Y then
  157.     ScrollTo(Delta.X, NewFocus)
  158.   else if NewFocus - Size.Y >= Delta.Y then
  159.     ScrollTo(Delta.X, NewFocus - Size.Y + 1);
  160. end;
  161.  
  162. { Called to draw the outline }
  163.  
  164. procedure TOutlineViewer.Draw;
  165. var
  166.   NrmColor, SelColor, FocColor: Word;
  167.   B: TDrawBuffer;
  168.   I: Integer;
  169.  
  170.   function DrawTree(Cur: Pointer; Level, Position: Integer; Lines: LongInt;
  171.     Flags: Word): Boolean; far;
  172.   var
  173.     Color: Word;
  174.     S: String;
  175.   begin
  176.     DrawTree := False;
  177.  
  178.     if Position >= Delta.Y then
  179.     begin
  180.       if Position >= Delta.Y + Size.Y then
  181.       begin
  182.         DrawTree := True;
  183.         Exit;
  184.       end;
  185.  
  186.       if (Position = Foc) and (State and sfFocused <> 0) then
  187.         Color := FocColor
  188.       else if IsSelected(Position) then
  189.         Color := SelColor
  190.       else
  191.         Color := NrmColor;
  192.       MoveChar(B, ' ', Color, Size.X);
  193.       S := GetGraph(Level, Lines, Flags);
  194.       if Flags and  ovExpanded = 0 then
  195.         S := Concat(S, '~', GetText(Cur), '~')
  196.       else
  197.         S := Concat(S, GetText(Cur));
  198.       MoveCStr(B, Copy(S, Delta.X + 1, 255), Color);
  199.       WriteLine(0, Position - Delta.Y, Size.X, 1, B);
  200.       I := Position;
  201.     end;
  202.   end;
  203.  
  204. begin
  205.   NrmColor := GetColor($0401);
  206.   FocColor := GetColor($0202);
  207.   SelColor := GetColor($0303);
  208.   FirstThat(@DrawTree);
  209.   MoveChar(B, ' ', NrmColor, Size.X);
  210.   WriteLine(0, I + 1, Size.X, Size.Y - (I - Delta.Y), B);
  211. end;
  212.  
  213. { ExpandAll expands the current node and all child nodes }
  214.  
  215. procedure TOutlineViewer.ExpandAll(Node: Pointer);
  216. var
  217.   I, N: Integer;
  218. begin
  219.   if HasChildren(Node) then
  220.   begin
  221.     Adjust(Node, True);
  222.     N := GetNumChildren(Node) - 1;
  223.     for I := 0 to N do
  224.       ExpandAll(GetChild(Node, I));
  225.   end;
  226. end;
  227.  
  228. { Draws a graph string suitable for returning from GetGraph.  Level
  229.   indicates the outline level.  Lines is the set of bits decribing
  230.   the which levels have a "continuation" mark (usually a vertical
  231.   lines).  If bit 3 is set, level 3 is continued beyond this level.
  232.   Flags gives extra information about how to draw the end of the
  233.   graph (see the ovXXX constants).  LevWidth is how many characters
  234.   to indent for each level.  EndWidth is the length the end characters.
  235.  
  236.   The graphics is divided into two parts: the level marks, and the end
  237.   or node graphic.  The level marks consist of the Level Mark character
  238.   separated by Level Filler.  What marks are present is determined by
  239.   Lines.  The end graphic is constructed by placing on of the End First
  240.   charcters followed by EndWidth-4 End Filler characters, followed by the
  241.   End Child character, followed by the Retract/Expand character.  If
  242.   EndWidth equals 2, End First and Retract/Expand are used.  If EndWidth
  243.   equals 1, only the Retract/Expand character is used.  Which characters
  244.   are selected is determined by Flags.
  245.  
  246.   The layout for the characters in the Chars is:
  247.  
  248.    1: Level Filler
  249.      Typically a space.  Used between level markers.
  250.    2: Level Mark
  251.      Typically a vertical bar.  Used to mark the levels currenly active.
  252.    3: End First (not last child)
  253.      Typically a sideways T.  Used as the first character of the end part
  254.      of a node graphic if the node is not the last child of the parent.
  255.    4: End First (last child)
  256.      Typically a L shape.  Used as the first character of the end part
  257.      of a node graphic if the node is the last child of the parent.
  258.    5: End Filler
  259.      Typically a horizontal line.  Used as filler for the end part of a
  260.      node graphic.
  261.    6: End Child position
  262.      Typically not used.  If EndWidth > LevWidth this character will
  263.      be placed on top of the markers for next level.  If used it is
  264.      typically a T.
  265.    7: Retracted character
  266.      Typically a '+'.  Displayed as the last character of the end
  267.      node if the level has children and they are not expanded.
  268.    8: Expanded character
  269.      Typically as straight line. Displayed as the last character of
  270.      the end node if the level has children and they are expanded.
  271.  
  272.   As an example GetGraph calls CreateGraph with the following paramters:
  273.  
  274.     CreateGraph(Level, Lines, Flags, 3, 3, ' '#179#195#192#196#196'+'#196);
  275.  
  276.   To use double, instead of single lines use:
  277.  
  278.     CreateGraph(Level, Lines, Flags, 3, 3, ' '#186#204#200#205#205'+'#205);
  279.  
  280.   To have the children line drop off prior to the text instead of underneath,
  281.   use the following call:
  282.  
  283.     CreateGraph(Level, Lines, Flags, 2, 4, ' '#179#195#192#196#194'+'#196);
  284.  
  285.   }
  286.  
  287. function TOutlineViewer.CreateGraph(Level: Integer; Lines: LongInt;
  288.   Flags: Word; LevWidth, EndWidth: Integer;
  289.   const Chars: String): String; assembler;
  290. const
  291.   FillerOrBar   = 0;
  292.   YorL          = 2;
  293.   StraightOrTee = 4;
  294.   Retracted     = 6;
  295. var
  296.   Last, Children, Expanded: Boolean;
  297. asm
  298.         PUSH    DS
  299.         CLD
  300.  
  301.         { Break out flags }
  302.         XOR     BX,BX
  303.         MOV     AX,Flags
  304.         MOV     Expanded,BL
  305.         SHR     AX,1
  306.         ADC     Expanded,BL
  307.         MOV     Children,BL
  308.         SHR     AX,1
  309.         ADC     Children,BL
  310.         MOV     Last,BL
  311.         SHR     AX,1
  312.         ADC     Last,BL
  313.  
  314.         { Load registers }
  315.         LDS     SI,Chars
  316.         INC     SI
  317.         LES     DI,@Result
  318.         INC     DI
  319.         MOV     AX,Lines.Word[0]
  320.         MOV     DX,Lines.Word[2]
  321.         INC     Level
  322.  
  323.         { Write bar characters }
  324.         JMP     @@2
  325. @@1:    XOR     BX,BX
  326.         SHR     DX,1
  327.         RCR     AX,1
  328.         RCL     BX,1
  329.         PUSH    AX
  330.         MOV     AL,[SI].FillerOrBar[BX]
  331.         STOSB
  332.         MOV     AL,[SI].FillerOrBar
  333.         MOV     CX,LevWidth
  334.         DEC     CX
  335.         REP     STOSB
  336.         POP     AX
  337. @@2:    DEC     Level
  338.         JNZ     @@1
  339.  
  340.         { Write end characters }
  341.         MOV     BH,0
  342.         MOV     CX,EndWidth
  343.         DEC     CX
  344.         JZ      @@4
  345.         MOV     BL,Last
  346.         MOV     AL,[SI].YorL[BX]
  347.         STOSB
  348.         DEC     CX
  349.         JZ      @@4
  350.         DEC     CX
  351.         JZ      @@3
  352.         MOV     AL,[SI].StraightOrTee
  353.         REP     STOSB
  354. @@3:    MOV     BL,Children
  355.         MOV     AL,[SI].StraightOrTee[BX]
  356.         STOSB
  357. @@4:    MOV     BL,Expanded
  358.         MOV     AL,[SI].Retracted[BX]
  359.         STOSB
  360.         MOV     AX,DI
  361.         LES     DI,@Result
  362.         SUB     AX,DI
  363.         DEC     AX
  364.         STOSB
  365.         POP     DS
  366. end;
  367.  
  368. { Internal function used to fetch the caller's stack frame }
  369.  
  370. function CallerFrame: Word; inline(
  371.   $8B/$46/$00           { MOV   AX,[BP] }
  372. );
  373.  
  374.  
  375. { FirstThat iterates over the nodes of the outline until the given
  376.   local function returns true. The declaration for the local function
  377.   must look like (save for the names, of course):
  378.  
  379.     function MyIter(Cur: Pointer; Level, Position: Integer;
  380.       Lines: LongInt; Flags: Word); far;
  381.  
  382.   The parameters are as follows:
  383.  
  384.     Cur:        A pointer to the node being checked.
  385.     Level:      The level of the node (how many node above it it has)
  386.                 Level is 0 based.  This can be used to a call to
  387.                 either GetGraph or CreateGraph.
  388.     Position:   The display order position of the node in the list.
  389.                 This can be used in a call to Focused or Selected.
  390.                 If in range, Position - Delta.Y is location the node
  391.                 is displayed on the view.
  392.     Lines:      Bits indicating the active levels.  This can be used in a
  393.                 call to GetGraph or CreateGraph. It dicatates which
  394.                 horizontal lines need to be drawn.
  395.     Flags:      Various flags for drawing (see ovXXXX flags).  Can be used
  396.                 in a call to GetGraph or CreateGraph. }
  397.  
  398. function TOutlineViewer.FirstThat(Test: Pointer): Pointer;
  399. begin
  400.   FirstThat := Iterate(Test, CallerFrame, True);
  401. end;
  402.  
  403. { Called whenever Node is receives focus }
  404.  
  405. procedure TOutlineViewer.Focused(I: Integer);
  406. begin
  407.   Foc := I;
  408. end;
  409.  
  410. { Iterates over all the nodes.  See FirstThat for a more details }
  411.  
  412. function TOutlineViewer.ForEach(Action: Pointer): Pointer;
  413. begin
  414.   Iterate(Action, CallerFrame, False);
  415. end;
  416.  
  417. { Returns the outline palette }
  418.  
  419. function TOutlineViewer.GetPalette: PPalette;
  420. const
  421.   P: String[Length(COutlineViewer)] = COutlineViewer;
  422. begin
  423.   GetPalette := @P;
  424. end;
  425.  
  426. { Overridden to return a pointer to the root of the outline }
  427.  
  428. function TOutlineViewer.GetRoot: Pointer;
  429. begin
  430.   Abstract;
  431. end;
  432.  
  433. { Called to retrieve the characters to display prior to the
  434.   text returned by GetText.  Can be overridden to return
  435.   change the appearance of the outline. My default calls
  436.   CreateGraph with the default. }
  437.  
  438. function TOutlineViewer.GetGraph(Level: Integer; Lines: LongInt;
  439.   Flags: Word): String;
  440. {const
  441.   LevelWidth = 2;
  442.   EndWidth   = LevelWidth + 2;
  443.   GraphChars = ' '#179#195#192#196#194'+'#196;
  444. {  GraphChars = ' '#186#204#200#205#203'+'#205;}
  445. const
  446.   LevelWidth = 3;
  447.   EndWidth   = LevelWidth;
  448.   GraphChars = ' '#179#195#192#196#196'+'#196;
  449. {  GraphChars = ' '#186#204#200#205#205'+'#205;}
  450. begin
  451.   GetGraph := Copy(CreateGraph(Level, Lines, Flags, LevelWidth, EndWidth,
  452.     GraphChars), EndWidth, 255);
  453. end;
  454.  
  455. { Returns a pointer to the node that is to be shown on line I }
  456.  
  457. function TOutlineViewer.GetNode(I: Integer): Pointer;
  458. var
  459.   Cur: Pointer;
  460.  
  461.   function IsNode(Node: Pointer; Level, Position: Integer; Lines: LongInt;
  462.     Flags: Word): Boolean; far;
  463.   begin
  464.     IsNode := I = Position;
  465.   end;
  466.  
  467. begin
  468.   GetNode := FirstThat(@IsNode);
  469. end;
  470.  
  471. { Overridden to return the number of children in Node. Will not be
  472.   called if HasChildren returns false.  }
  473.  
  474. function TOutlineViewer.GetNumChildren(Node: Pointer): Integer;
  475. begin
  476.   Abstract;
  477. end;
  478.  
  479. { Overriden to return the I'th child of Node. Will not be called if
  480.   HasChildren returns false. }
  481.  
  482. function TOutlineViewer.GetChild(Node: Pointer; I: Integer): Pointer;
  483. begin
  484.   Abstract;
  485. end;
  486.  
  487. { Overridden to return the text of Node }
  488.  
  489. function TOutlineViewer.GetText(Node: Pointer): String;
  490. begin
  491.   Abstract;
  492. end;
  493.  
  494. { Overriden to return if Node's children should be displayed.  Will
  495.   never be called if HasChildren returns False. }
  496.  
  497. function TOutlineViewer.IsExpanded(Node: Pointer): Boolean;
  498. begin
  499.   Abstract;
  500. end;
  501.  
  502. { Returns if Node is selected.  By default, returns true if Node is
  503.   Focused (i.e. single selection).  Can be overriden to handle
  504.   multiple selections. }
  505.  
  506. function TOutlineViewer.IsSelected(I: Integer): Boolean;
  507. begin
  508.   IsSelected := Foc = I;
  509. end;
  510.  
  511. { Internal function used by both FirstThat and ForEach to do the
  512.   actual iteration over the data. See FirstThat for more details }
  513.  
  514. function TOutlineViewer.Iterate(Action: Pointer; CallerFrame: Word;
  515.   CheckRslt: Boolean): Pointer;
  516. var
  517.   Position: Integer;
  518.  
  519.   function TraverseTree(Cur: Pointer; Level: Integer;
  520.     Lines: LongInt; LastChild: Boolean): Pointer; far;
  521.   label
  522.     Retn;
  523.   var
  524.     J, ChildCount: Integer;
  525.     Ret: Pointer;
  526.     Flags: Word;
  527.     Children: Boolean;
  528.   begin
  529.     TraverseTree := Cur;
  530.     if Cur = nil then Exit;
  531.  
  532.     Children := HasChildren(Cur);
  533.  
  534.     Flags := 0;
  535.     if LastChild then Inc(Flags, ovLast);
  536.     if Children and IsExpanded(Cur) then Inc(Flags, ovChildren);
  537.     if not Children or IsExpanded(Cur) then Inc(Flags, ovExpanded);
  538.  
  539.     Inc(Position);
  540.  
  541.     { Perform call }
  542.     asm
  543.         LES     DI,Cur                     { Push Cur }
  544.         PUSH    ES
  545.         PUSH    DI
  546.         MOV     BX,[BP+6]                  { Load parent frame into BX }
  547.         PUSH    Level
  548.         PUSH    WORD PTR SS:[BX].offset Position
  549.         PUSH    Lines.Word[2]
  550.         PUSH    Lines.Word[0]
  551.         PUSH    Flags
  552.         PUSH    WORD PTR SS:[BX].offset CallerFrame
  553.         CALL    DWORD PTR SS:[BX].offset Action
  554.         OR      AL,AL
  555.         MOV     BX,[BP+6]                   { Load parent frame into BX }
  556.         AND     AL,SS:[BX].offset CheckRslt { Force to 0 if CheckRslt False }
  557.         JNZ     Retn
  558.     end;
  559.  
  560.     if Children and IsExpanded(Cur) then
  561.     begin
  562.       ChildCount := GetNumChildren(Cur);
  563.  
  564.       if not LastChild then Lines := Lines or (1 shl Level);
  565.       for J := 0 to ChildCount - 1 do
  566.       begin
  567.         Ret := TraverseTree(GetChild(Cur, J), Level + 1, Lines,
  568.           J = (ChildCount - 1));
  569.         TraverseTree := Ret;
  570.         if Ret <> nil then Exit;
  571.       end;
  572.     end;
  573.     TraverseTree := nil;
  574.   Retn:
  575.   end;
  576.  
  577. begin
  578.   Position := -1;
  579.  
  580.   asm                           { Convert 0, 1 to 0, FF }
  581.         DEC     CheckRslt
  582.         NOT     CheckRslt
  583.   end;
  584.  
  585.   Iterate := TraverseTree(GetRoot, 0, 0, True);
  586. end;
  587.  
  588. { Called to handle an event }
  589.  
  590. procedure TOutlineViewer.HandleEvent(var Event: TEvent);
  591. const
  592.   MouseAutoToSkip = 3;
  593. var
  594.   Mouse: TPoint;
  595.   Cur: Pointer;
  596.   NewFocus: Integer;
  597.   Count: Integer;
  598.   Graph: String;
  599.   Dragged: Byte;
  600.  
  601.   function GetFocusedGraphic(var Graph: String): Pointer;
  602.   var
  603.     Lvl: Integer;
  604.     Lns: LongInt;
  605.     Flgs: Word;
  606.  
  607.     function IsFocused(Cur: Pointer; Level, Position: Integer;
  608.       Lines: LongInt; Flags: Word): Boolean; far;
  609.     begin
  610.       if Position = Foc then
  611.       begin
  612.         IsFocused := True;
  613.         Lvl := Level;
  614.         Lns := Lines;
  615.         Flgs := Flags;
  616.       end
  617.       else IsFocused := False;
  618.     end;
  619.  
  620.   begin
  621.     GetFocusedGraphic := FirstThat(@IsFocused);
  622.     Graph := GetGraph(Lvl, Lns, Flgs);
  623.   end;
  624.  
  625.  
  626. begin
  627.   inherited HandleEvent(Event);
  628.   case Event.What of
  629.     evMouseDown:
  630.       begin
  631.         Count := 0;
  632.         Dragged := 0;
  633.         repeat
  634.           if Dragged < 2 then Inc(Dragged);
  635.           MakeLocal(Event.Where, Mouse);
  636.           if MouseInView(Event.Where) then
  637.             NewFocus := Delta.Y + Mouse.Y
  638.           else
  639.           begin
  640.             if Event.What = evMouseAuto then Inc(Count);
  641.             if Count = MouseAutoToSkip then
  642.             begin
  643.               Count := 0;
  644.               if Mouse.Y < 0 then Dec(NewFocus);
  645.               if Mouse.Y >= Size.Y then Inc(NewFocus);
  646.             end;
  647.           end;
  648.           if Foc <> NewFocus then
  649.           begin
  650.             AdjustFocus(NewFocus);
  651.             DrawView;
  652.           end;
  653.         until not MouseEvent(Event, evMouseMove + evMouseAuto);
  654.         if Event.Double then Selected(Foc)
  655.         else
  656.         begin
  657.           if Dragged < 2 then
  658.           begin
  659.             Cur := GetFocusedGraphic(Graph);
  660.             if Mouse.X < Length(Graph) then
  661.             begin
  662.               Adjust(Cur, not IsExpanded(Cur));
  663.               Update;
  664.               DrawView;
  665.             end;
  666.           end;
  667.         end;
  668.       end;
  669.     evKeyboard:
  670.       begin
  671.         NewFocus := Foc;
  672.         case CtrlToArrow(Event.KeyCode) of
  673.           kbUp, kbLeft:    Dec(NewFocus);
  674.           kbDown, kbRight: Inc(NewFocus);
  675.           kbPgDn:          Inc(NewFocus, Size.Y - 1);
  676.           kbPgUp:          Dec(NewFocus, Size.Y - 1);
  677.           kbHome:          NewFocus := Delta.Y;
  678.           kbEnd:           NewFocus := Delta.Y + Size.Y - 1;
  679.           kbCtrlPgUp:      NewFocus := 0;
  680.           kbCtrlPgDn:      NewFocus := Limit.Y - 1;
  681.           kbCtrlEnter,
  682.           kbEnter:         Selected(NewFocus);
  683.         else
  684.           case Event.CharCode of
  685.             '-', '+': Adjust(GetNode(NewFocus), Event.CharCode = '+');
  686.             '*':      ExpandAll(GetNode(NewFocus));
  687.           else
  688.             Exit;
  689.           end;
  690.           Update;
  691.         end;
  692.         ClearEvent(Event);
  693.         AdjustFocus(NewFocus);
  694.         DrawView;
  695.       end;
  696.   end;
  697. end;
  698.  
  699. { Called to determine if the given node has children }
  700.  
  701. function TOutlineViewer.HasChildren(Node: Pointer): Boolean;
  702. begin
  703.   Abstract;
  704. end;
  705.  
  706. { Called whenever Node is selected by the user either via keyboard
  707.   control or by the mouse. }
  708.  
  709. procedure TOutlineViewer.Selected(I: Integer);
  710. begin
  711. end;
  712.  
  713. { Redraws the outline if the outliner sfFocus state changes }
  714.  
  715. procedure TOutlineViewer.SetState(AState: Word; Enable: Boolean);
  716. begin
  717.   inherited SetState(AState, Enable);
  718.   if AState and sfFocused <> 0 then DrawView;
  719. end;
  720.  
  721. { Store the object to a stream }
  722.  
  723. procedure TOutlineViewer.Store(var S: TStream);
  724. begin
  725.   inherited Store(S);
  726.   S.Write(Foc, SizeOf(Foc));
  727. end;
  728.  
  729. { Updates the limits of the outline viewer.  Should be called whenever
  730.   the data of the outline viewer changes.  This includes during
  731.   the initalization of base classes.  TOutlineViewer assumes that
  732.   the outline is empty.  If the outline becomes non-empty during the
  733.   initialization, Update must be called. Also, if during the operation
  734.   of the TOutlineViewer the data being displayed changes, Update
  735.   and DrawView must be called. }
  736.  
  737. procedure TOutlineViewer.Update;
  738. var
  739.   Count, MaxX: Integer;
  740.  
  741.   function CountNode(P: Pointer; Level, Position: Integer; Lines: LongInt;
  742.     Flags: Word): Boolean; far;
  743.   var
  744.     Len: Integer;
  745.   begin
  746.     Inc(Count);
  747.     Len := Length(GetText(P)) + Length(GetGraph(Level, Lines, Flags));
  748.     if MaxX < Len then MaxX := Len;
  749.     CountNode := False;
  750.   end;
  751.  
  752. begin
  753.   Count := 0;
  754.   MaxX := 0;
  755.   FirstThat(@CountNode);
  756.   SetLimit(MaxX, Count);
  757.   AdjustFocus(Foc);
  758. end;
  759.  
  760. { TOutline }
  761.  
  762. constructor TOutline.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  763.   ARoot: PNode);
  764. begin
  765.   inherited Init(Bounds, AHScrollBar, AVScrollBar);
  766.   Root := ARoot;
  767.   Update;
  768. end;
  769.  
  770. constructor TOutline.Load(var S: TStream);
  771.  
  772.   function LoadNode: PNode;
  773.   var
  774.     IsNode: Boolean;
  775.     Node: PNode;
  776.   begin
  777.     S.Read(IsNode, SizeOf(IsNode));
  778.     if IsNode then
  779.     begin
  780.       New(Node);
  781.       with Node^ do
  782.       begin
  783.         S.Read(Expanded, SizeOf(Expanded));
  784.         Text := S.ReadStr;
  785.         ChildList := LoadNode;
  786.         Next := LoadNode;
  787.       end;
  788.       LoadNode := Node;
  789.     end
  790.     else
  791.       LoadNode := nil;
  792.   end;
  793.  
  794. begin
  795.   inherited Load(S);
  796.   Root := LoadNode;
  797. end;
  798.  
  799. destructor TOutline.Done;
  800. begin
  801.   DisposeNode(Root);
  802.   inherited Done;
  803. end;
  804.  
  805. procedure TOutline.Adjust(Node: Pointer; Expand: Boolean);
  806. begin
  807.   PNode(Node)^.Expanded := Expand;
  808. end;
  809.  
  810. function TOutline.GetRoot: Pointer;
  811. begin
  812.   GetRoot := Root;
  813. end;
  814.  
  815. function TOutline.GetNumChildren(Node: Pointer): Integer;
  816. var
  817.   I: Integer;
  818.   P: PNode;
  819. begin
  820.   P := PNode(Node)^.ChildList;
  821.   I := 0;
  822.   while P <> nil do
  823.   begin
  824.     P := P^.Next;
  825.     Inc(I);
  826.   end;
  827.   GetNumChildren := I;
  828. end;
  829.  
  830. function TOutline.GetChild(Node: Pointer; I: Integer): Pointer;
  831. var
  832.   P: PNode;
  833. begin
  834.   P := PNode(Node)^.ChildList;
  835.   while (I <> 0) and (P <> nil) do
  836.   begin
  837.     P := P^.Next;
  838.     Dec(I);
  839.   end;
  840.   GetChild := P;
  841. end;
  842.  
  843. function TOutline.GetText(Node: Pointer): String;
  844. begin
  845.   GetText := PNode(Node)^.Text^;
  846. end;
  847.  
  848. function TOutline.IsExpanded(Node: Pointer): Boolean;
  849. begin
  850.   IsExpanded := PNode(Node)^.Expanded;
  851. end;
  852.  
  853. function TOutline.HasChildren(Node: Pointer): Boolean;
  854. begin
  855.   HasChildren := PNode(Node)^.ChildList <> nil;
  856. end;
  857.  
  858. procedure TOutline.Store(var S: TStream);
  859.  
  860.   procedure StoreNode(Node: PNode);
  861.   var
  862.     IsNode: Boolean;
  863.   begin
  864.     IsNode := Node <> nil;
  865.     S.Write(IsNode, SizeOf(IsNode));
  866.     if IsNode then
  867.     begin
  868.       with Node^ do
  869.       begin
  870.         S.Write(Expanded, SizeOf(Expanded));
  871.         S.WriteStr(Text);
  872.         StoreNode(ChildList);
  873.         StoreNode(Next);
  874.       end;
  875.     end;
  876.   end;
  877.    
  878. begin
  879.   inherited Store(S);
  880.   StoreNode(Root);
  881. end;
  882.  
  883. function NewNode(const AText: String; AChildren, ANext: PNode): PNode;
  884. var
  885.   P: PNode;
  886. begin
  887.   New(P);
  888.   with P^ do
  889.   begin
  890.     Text := NewStr(AText);
  891.     Next := ANext;
  892.     ChildList := AChildren;
  893.     Expanded := True;
  894.   end;
  895.   NewNode := P;
  896. end;
  897.  
  898. procedure DisposeNode(Node: PNode);
  899. begin
  900.   if Node <> nil then
  901.     with Node^ do
  902.     begin
  903.       if ChildList <> nil then DisposeNode(ChildList);
  904.       if Next <> nil then DisposeNode(Next);
  905.     end;
  906.   Dispose(Node);
  907. end;
  908.  
  909. procedure RegisterOutline;
  910. begin
  911.   RegisterType(ROutline);
  912. end;
  913.  
  914. end.
  915.