home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / SOURCE / VCL / OUTLINE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-03  |  67.9 KB  |  2,582 lines

  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Outline;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. {$R OUTLINE}
  17.  
  18. uses Windows, Messages, Forms, Classes, Graphics, Menus, StdCtrls, Grids,
  19.   Controls, SysUtils;
  20.  
  21. type
  22.   OutlineError = class(TObject); { Raised by GetNodeAtIndex }
  23.   EOutlineError = class(Exception);
  24.   TOutlineNodeCompare = (ocLess, ocSame, ocGreater, ocInvalid);
  25.   TAttachMode = (oaAdd, oaAddChild, oaInsert);
  26.   TChangeRange = -1..1;
  27.   TCustomOutline = class;
  28.  
  29. { TOutlineNode }
  30.  
  31. { The TOutlineNode is an encapsulation of an outliner item.  Access
  32.   to a TOutlineNode is via the container class TOutline.  Each
  33.   TOutlineNode contains user defined text and data.
  34.   An item is also capable of containing up to 16368 sub-items.
  35.   TOutlineNodes are also persistent.
  36.  
  37.   A TOutlineNode item can be interrogated about its current state :
  38.     Expanded
  39.       Whether the node is open or closed.
  40.     Index
  41.       The current Index of the node.  This changes as items are inserted and
  42.       deleted.  The index will range from 1..n
  43.     Level
  44.       The current depth of the node with 1 being the top level
  45.     HasItems
  46.       Whether the item contains items
  47.     IsVisible
  48.       Whether the item is capable of being displayed. This value is only
  49.       True if all its parent items are visible
  50.     TopItem
  51.       Obtains the parent of the item that resides at level 1
  52.     FullPath
  53.       Returns the fully qualified name of the item starting from its
  54.       level 1 parent.  Each item is separated by the separator string
  55.       specified in the TOutline Container
  56.     Text
  57.       Used to set and get the items text value
  58.     Data
  59.       Used to get and set the items data }
  60.  
  61.   TOutlineNode = class(TPersistent)
  62.   private
  63.     FList: TList;
  64.     FText: string;
  65.     FData: Pointer;
  66.     FParent: TOutlineNode;
  67.     FIndex: LongInt;
  68.     FState: Boolean;
  69.     FOutline: TCustomOutline;
  70.     FExpandCount: LongInt;
  71.     procedure ChangeExpandedCount(Value: LongInt);
  72.     procedure CloseNode;
  73.     procedure Clear;
  74.     procedure Error(const ErrorString: string);
  75.     function GetExpandedNodeCount: LongInt;
  76.     function GetFullPath: string;
  77.     function GetIndex: LongInt;
  78.     function GetLastIndex: LongInt;
  79.     function GetLevel: Cardinal;
  80.     function GetList: TList;
  81.     function GetMaxDisplayWidth(Value: Cardinal): Cardinal;
  82.     function GetNode(Index: LongInt): TOutlineNode;
  83.     function GetTopItem: Longint;
  84.     function GetVisibleParent: TOutlineNode;
  85.     function HasChildren: Boolean;
  86.     function HasVisibleParent: Boolean;
  87.     function IsEqual(Value: TOutlineNode): Boolean;
  88.     procedure ReIndex(StartNode, EndNode: TOutlineNode; NewIndex: LongInt;
  89.       IncludeStart: Boolean);
  90.     procedure Repaint;
  91.     function Resync(var NewIndex: LongInt; EndNode: TOutlineNode): Boolean;
  92.     procedure SetExpandedState(Value: Boolean);
  93.     procedure SetGoodIndex;
  94.     procedure SetHorzScrollBar;
  95.     procedure SetLevel(Level: Cardinal);
  96.     procedure SetText(const Value: string);
  97.   protected
  98.     constructor Create(AOwner: TCustomOutline);
  99.     destructor Destroy; override;
  100.     function GetVisibleNode(TargetCount: LongInt): TOutlineNode;
  101.     function AddNode(Value: TOutlineNode): LongInt;
  102.     function InsertNode(Index: LongInt; Value: TOutlineNode): LongInt;
  103.     function GetNodeAtIndex(TargetIndex: LongInt): TOutlineNode;
  104.     function GetDataItem(Value: Pointer): LongInt;
  105.     function GetTextItem(const Value: string): LongInt;
  106.     function HasAsParent(Value: TOutlineNode): Boolean;
  107.     function GetRowOfNode(TargetNode: TOutlineNode;
  108.       var RowCount: Longint): Boolean;
  109.     procedure InternalRemove(Value: TOutlineNode; Index: Integer);
  110.     procedure Remove(Value: TOutlineNode);
  111.     procedure WriteNode(Buffer: PChar; Stream: TStream);
  112.     property Outline: TCustomOutline read FOutline;
  113.     property List: TList read GetList;
  114.     property ExpandCount: LongInt read FExpandCount;
  115.     property Items[Index: LongInt]: TOutlineNode read GetNode; default;
  116.   public
  117.     procedure ChangeLevelBy(Value: TChangeRange);
  118.     procedure Collapse;
  119.     procedure Expand;
  120.     procedure FullExpand;
  121.     function GetDisplayWidth: Integer;
  122.     function GetFirstChild: LongInt;
  123.     function GetLastChild: LongInt;
  124.     function GetNextChild(Value: LongInt): LongInt;
  125.     function GetPrevChild(Value: LongInt): LongInt;
  126.     procedure MoveTo(Destination: LongInt; AttachMode: TAttachMode);
  127.     property Parent: TOutlineNode read FParent;
  128.     property Expanded: Boolean read FState write SetExpandedState;
  129.     property Text: string read FText write SetText;
  130.     property Data: Pointer read FData write FData;
  131.     property Index: LongInt read GetIndex;
  132.     property Level: Cardinal read GetLevel write SetLevel;
  133.     property HasItems: Boolean read HasChildren;
  134.     property IsVisible: Boolean read HasVisibleParent;
  135.     property TopItem: Longint read GetTopItem;
  136.     property FullPath: string read GetFullPath;
  137.   end;
  138.  
  139. { TCustomOutline }
  140.  
  141. { The TCustomOutline object is a container class for TOutlineNodes.
  142.   All TOutlineNodes contained within a TOutline are presented
  143.   to the user as a flat array of TOutlineNodes, with a parent
  144.   TOutlineNode containing an index value that is one less than
  145.   its first child (if it has any children).
  146.  
  147.   Interaction with a TOutlineNode is typically accomplished through
  148.   the TCustomOutline using the following properties:
  149.     CurItem
  150.       Reads and writes the current item
  151.     ItemCount
  152.       Returns the total number of TOutlineNodes with the TCustomOutline.
  153.       Note this can be computationally expensive as all indexes will
  154.       be forced to be updated!!
  155.     Items
  156.       Allows Linear indexing into the hierarchical list of TOutlineNodes
  157.     SelectedItem
  158.       Returns the Index of the TOutlineNode which has the focus or 0 if
  159.       no TOutlineNode has been selected
  160.  
  161.   The TCustomOutline has a number of properties which will affect all
  162.   TOutlineNodes owned by the TCustomOutline:
  163.     OutlineStyle
  164.       Sets the visual style of the outliner
  165.     ItemSeparator
  166.       Sets the delimiting string for all TOutlineNodes
  167.     PicturePlus, PictureMinus, PictureOpen, PictureClosed, PictureLeaf
  168.       Sets custom bitmaps for these items }
  169.  
  170.   TBitmapArrayRange = 0..4;
  171.   EOutlineChange = procedure (Sender: TObject; Index: LongInt) of object;
  172.   TOutlineStyle = (osText, osPlusMinusText, osPictureText,
  173.     osPlusMinusPictureText, osTreeText, osTreePictureText);
  174.   TOutlineBitmap = (obPlus, obMinus, obOpen, obClose, obLeaf);
  175.   TOutlineBitmaps = set of TOutlineBitmap;
  176.   TBitmapArray = array[TBitmapArrayRange] of TBitmap;
  177.   TOutlineType = (otStandard, otOwnerDraw);
  178.   TOutlineOption = (ooDrawTreeRoot, ooDrawFocusRect, ooStretchBitmaps);
  179.   TOutlineOptions = set of TOutlineOption;
  180.  
  181.  
  182.   TCustomOutline = class(TCustomGrid)
  183.   private
  184.     FBlockInsert: Boolean;
  185.     FRootNode: TOutlineNode;
  186.     FGoodNode: TOutlineNode;
  187.     UpdateCount: Integer;
  188.     FCurItem: TOutlineNode;
  189.     FSeparator: string;
  190.     FFontSize: Integer;
  191.     FStrings: TStrings;
  192.     FUserBitmaps: TOutlineBitmaps;
  193.     FOldBitmaps: TOutlineBitmaps;
  194.     FPictures: TBitmapArray;
  195.     FOnExpand: EOutlineChange;
  196.     FOnCollapse: EOutlineChange;
  197.     FOutlineStyle: TOutlineStyle;
  198. //    FMaskColor: TColor;
  199.     FItemHeight: Integer;
  200.     FStyle: TOutlineType;
  201.     FOptions: TOutlineOptions;
  202.     FIgnoreScrollResize: Boolean;
  203.     FSelectedItem: TOutlineNode;
  204.     FOnDrawItem: TDrawItemEvent;
  205.     FSettingWidth: Boolean;
  206.     FSettingHeight: Boolean;
  207.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  208.     function GetItemCount: LongInt;
  209.     function AttachNode(Index: LongInt; Str: string;
  210.       Ptr: Pointer; AttachMode: TAttachMode): LongInt;
  211.     function Get(Index: LongInt): TOutlineNode;
  212.     function GetSelectedItem: LongInt;
  213.     procedure SetSelectedItem(Value: Longint);
  214.     function CompareNodes(Value1, Value2: TOutlineNode): TOutlineNodeCompare;
  215.     procedure Error(const ErrorString: string);
  216.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  217.     function ResizeGrid: Boolean;
  218.     procedure DoExpand(Node: TOutlineNode);
  219.     procedure Init;
  220.     procedure MoveNode(Destination, Source: LongInt;
  221.       AttachMode: TAttachMode);
  222.     procedure ClearBitmap(var Bitmap: TBitmap; Kind: TOutlineBitmap);
  223.     procedure ChangeBitmap(Value: TBitmap; Kind: TOutlineBitmap);
  224.     procedure SetRowHeight;
  225.     procedure SetCurItem(Value: LongInt);
  226.     procedure CreateGlyph;
  227.     procedure SetStrings(Value: TStrings);
  228.     function GetStrings: TStrings;
  229.     function IsCurItem(Value: LongInt): Boolean;
  230.     procedure SetPicture(Index: Integer; Value: TBitmap);
  231.     function GetPicture(Index: Integer): TBitmap;
  232.     procedure DrawPictures(BitMaps: array of TBitmap; ARect: TRect);
  233.     procedure DrawText(Node: TOutlineNode; Rect: TRect);
  234.     procedure SetOutlineStyle(Value: TOutlineStyle);
  235.     procedure DrawTree(ARect: TRect; Node: TOutlineNode);
  236. //    procedure SetMaskColor(Value: TColor);
  237.     procedure SetItemHeight(Value: Integer);
  238.     procedure SetStyle(Value: TOutlineType);
  239.     procedure SetOutlineOptions(Value: TOutlineOptions);
  240.     function StoreBitmap(Index: Integer): Boolean;
  241.     procedure ReadBinaryData(Stream: TStream);
  242.     procedure WriteBinaryData(Stream: TStream);
  243.     procedure SetHorzScrollBar;
  244.     procedure ResetSelectedItem;
  245.     procedure SetRowFromNode(Node: TOutlineNode);
  246.   protected
  247.     procedure Loaded; override;
  248.     procedure Click; override;
  249.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  250.     procedure KeyPress(var Key: Char); override;
  251.     function SetGoodIndex(Value: TOutlineNode): TOutlineNode;
  252.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  253.       AState: TGridDrawState); override;
  254.     procedure DblClick; override;
  255.     procedure SetLevel(Node: TOutlineNode; CurLevel, NewLevel: Cardinal);
  256.     function BadIndex(Value: TOutlineNode): Boolean;
  257.     procedure DeleteNode(Node: TOutlineNode; CurIndex: LongInt);
  258.     procedure Expand(Index: LongInt); dynamic;
  259.     procedure Collapse(Index: LongInt); dynamic;
  260.     procedure DefineProperties(Filer: TFiler); override;
  261.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  262.       X, Y: Integer); override;
  263.     procedure Move(Destination, Source: LongInt; AttachMode: TAttachMode);
  264.     procedure SetDisplayWidth(Value: Integer);
  265.     property Lines: TStrings read GetStrings write SetStrings;
  266.     property OutlineStyle: TOutlineStyle read FOutlineStyle write SetOutlineStyle default osTreePictureText;
  267.     property OnExpand: EOutlineChange read FOnExpand write FOnExpand;
  268.     property OnCollapse: EOutlineChange read FOnCollapse write FOnCollapse;
  269.     property Options: TOutlineOptions read FOptions write SetOutlineOptions
  270.       default [ooDrawTreeRoot, ooDrawFocusRect];
  271.     property Style: TOutlineType read FStyle write SetStyle default otStandard;
  272.     property ItemHeight: Integer read FItemHeight write SetItemHeight;
  273.     property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
  274.     property ItemSeparator: string read FSeparator write FSeparator;
  275.     property PicturePlus: TBitmap index 0 read GetPicture write SetPicture stored StoreBitmap;
  276.     property PictureMinus: TBitmap index 1 read GetPicture write SetPicture stored StoreBitmap;
  277.     property PictureOpen: TBitmap index 2 read GetPicture write SetPicture stored StoreBitmap;
  278.     property PictureClosed: TBitmap index 3 read GetPicture write SetPicture stored StoreBitmap;
  279.     property PictureLeaf: TBitmap index 4 read GetPicture write SetPicture stored StoreBitmap;
  280.   public
  281.     constructor Create(AOwner: TComponent); override;
  282.     destructor Destroy; override;
  283.     function Add(Index: LongInt; const Text: string): LongInt;
  284.     function AddChild(Index: LongInt; const Text: string): LongInt;
  285.     function AddChildObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
  286.     function AddObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
  287.     function Insert(Index: LongInt; const Text: string): LongInt;
  288.     function InsertObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
  289.     procedure Delete(Index: LongInt);
  290.     function GetDataItem(Value: Pointer): Longint;
  291.     function GetItem(X, Y: Integer): LongInt;
  292.     function GetNodeDisplayWidth(Node: TOutlineNode): Integer;
  293.     function GetTextItem(const Value: string): Longint;
  294.     function GetVisibleNode(Index: LongInt): TOutlineNode;
  295.     procedure FullExpand;
  296.     procedure FullCollapse;
  297.     procedure LoadFromFile(const FileName: string);
  298.     procedure LoadFromStream(Stream: TStream);
  299.     procedure SaveToFile(const FileName: string);
  300.     procedure SaveToStream(Stream: TStream);
  301.     procedure BeginUpdate;
  302.     procedure EndUpdate;
  303.     procedure SetUpdateState(Value: Boolean);
  304.     procedure Clear;
  305.     property ItemCount: LongInt read GetItemCount;
  306.     property Items[Index: LongInt]: TOutlineNode read Get; default;
  307.     property SelectedItem: Longint read GetSelectedItem write SetSelectedItem;
  308.     property Row;
  309.     property Canvas;
  310.   end;
  311.  
  312.   TOutline = class(TCustomOutline)
  313.   published
  314.     property Lines;
  315.     property OutlineStyle;
  316.     property OnExpand;
  317.     property OnCollapse;
  318.     property Options;
  319.     property Style;
  320.     property ItemHeight;
  321.     property OnDrawItem;
  322.     property Align;
  323.     property Enabled;
  324.     property Font;
  325.     property Color;
  326.     property ParentColor;
  327.     property ParentCtl3D;
  328.     property Ctl3D;
  329.     property TabOrder;
  330.     property TabStop;
  331.     property Visible;
  332.     property OnClick;
  333.     property DragMode;
  334.     property DragCursor;
  335.     property OnDragDrop;
  336.     property OnDragOver;
  337.     property OnEndDrag;
  338.     property OnStartDrag;
  339.     property OnEnter;
  340.     property OnExit;
  341.     property OnMouseDown;
  342.     property OnMouseMove;
  343.     property OnMouseUp;
  344.     property OnDblClick;
  345.     property OnKeyDown;
  346.     property OnKeyPress;
  347.     property OnKeyUp;
  348.     property BorderStyle;
  349.     property ItemSeparator;
  350.     property PicturePlus;
  351.     property PictureMinus;
  352.     property PictureOpen;
  353.     property PictureClosed;
  354.     property PictureLeaf;
  355.     property ParentFont;
  356.     property ParentShowHint;
  357.     property ShowHint;
  358.     property PopupMenu;
  359.     property ScrollBars;
  360.   end;
  361.  
  362. implementation
  363.  
  364. uses Consts;
  365.  
  366. const
  367.   MaxLevels = 255;
  368.   TAB = Chr(9);
  369.   InvalidIndex = -1;
  370.   BitmapWidth = 14;
  371.   BitmapHeight = 14;
  372.  
  373. type
  374.  
  375. { TOutlineStrings }
  376.  
  377.   TOutlineStrings = class(TStrings)
  378.   private
  379.     Outline: TCustomOutline;
  380.     procedure ReadData(Reader: TReader);
  381.     procedure WriteData(Writer: TWriter);
  382.   protected
  383.     procedure DefineProperties(Filer: TFiler); override;
  384.     function Get(Index: Integer): string; override;
  385.     function GetCount: Integer; override;
  386.   public
  387.     function Add(const S: string): Integer; override;
  388.     procedure Clear; override;
  389.     procedure Delete(Index: Integer); override;
  390.     procedure Insert(Index: Integer; const S: string); override;
  391.     procedure PutObject(Index: Integer; AObject: TObject); override;
  392.     function GetObject(Index: Integer): TObject; override;
  393.   end;
  394.  
  395. function GetBufStart(Buffer: PChar; var Level: Cardinal): PChar;
  396. begin
  397.   Level := 0;
  398.   while Buffer^ in [' ', #9] do
  399.   begin
  400.     Inc(Buffer);
  401.     Inc(Level);
  402.   end;
  403.   Result := Buffer;
  404. end;
  405.  
  406. function PutString(BufPtr: PChar; const S: string): PChar;
  407. var
  408.   I: Integer;
  409. begin
  410.   for I := 1 to Length(S) do
  411.   begin
  412.     BufPtr^ := S[I];
  413.     Inc(BufPtr);
  414.   end;
  415.   Word(Pointer(BufPtr)^) := $0A0D;
  416.   Inc(BufPtr, 2);
  417.   Result := BufPtr;
  418. end;
  419.  
  420.  
  421. {TOutlineNode}
  422.  
  423. constructor TOutlineNode.Create(AOwner: TCustomOutline);
  424. begin
  425.   FOutline := AOwner;
  426. end;
  427.  
  428. destructor TOutlineNode.Destroy;
  429. var
  430.   CurIndex: LongInt;
  431.   LastNode: Boolean;
  432. begin
  433.   with Outline do
  434.     if FRootNode = Self then FIgnoreScrollResize := True;
  435.   try
  436.     CurIndex := 0;
  437.     if Parent <> nil then CurIndex := Outline.FCurItem.Index;
  438.     if FList <> nil then Clear;
  439.     if Outline.FSelectedItem = Self then Outline.ResetSelectedItem;
  440.     if Parent <> nil then
  441.     begin
  442.       LastNode := Parent.List.Last = Self;
  443.       Parent.Remove(Self);
  444.       if Parent.List.Count = 0 then
  445.         Outline.SetRowFromNode(Parent)
  446.       else if LastNode then
  447.         Outline.SetRowFromNode(TOutlineNode(Parent.List.Last));
  448.       Outline.DeleteNode(Self, CurIndex);
  449.     end;
  450.   finally
  451.     with Outline do
  452.       if FRootNode = Self then FIgnoreScrollResize := False;
  453.   end;
  454.   inherited Destroy;
  455. end;
  456.  
  457. procedure TOutlineNode.Clear;
  458. var
  459.   I: Integer;
  460.   Node: TOutlineNode;
  461. begin
  462.   for I := 0 to FList.Count - 1 do
  463.   begin
  464.     Node := FList.Items[I];
  465.     Node.FParent := nil;
  466.     Node.Destroy;
  467.   end;
  468.   FList.Destroy;
  469.   FList := nil;
  470. end;
  471.  
  472. procedure TOutlineNode.SetHorzScrollBar;
  473. begin
  474.   if (Parent <> nil) and Parent.Expanded then
  475.     Outline.SetHorzScrollBar;
  476. end;
  477.  
  478. function TOutlineNode.GetList: TList;
  479. begin
  480.   if FList = nil then FList := TList.Create;
  481.   Result := FList;
  482. end;
  483.  
  484. function TOutlineNode.GetNode(Index: LongInt): TOutlineNode;
  485. begin
  486.   Result := List[Index];
  487. end;
  488.  
  489. function TOutlineNode.GetLastIndex: LongInt;
  490. begin
  491.   if List.Count <> 0 then
  492.     Result := TOutlineNode(List.Last).GetLastIndex
  493.   else
  494.     Result := Index;
  495. end;
  496.  
  497. procedure TOutlineNode.SetText(const Value: string);
  498. var
  499.  NodeRow: LongInt;
  500. begin
  501.   FText := Value;
  502.   if not Assigned(FParent) then Exit;
  503.  
  504.   if Parent.Expanded then
  505.   begin
  506.     NodeRow := 0;
  507.     with Outline do
  508.     begin
  509.       FRootNode.GetRowOfNode(Self, NodeRow);
  510.       InvalidateCell(0, NodeRow - 2);
  511.     end;
  512.   end;
  513.   SetHorzScrollBar;
  514. end;
  515.  
  516. procedure TOutlineNode.ChangeExpandedCount(Value: LongInt);
  517. begin
  518.   if not Expanded then Exit;
  519.   Inc(FExpandCount, Value);
  520.   if Parent <> nil then Parent.ChangeExpandedCount(Value);
  521. end;
  522.  
  523. function TOutlineNode.GetIndex: LongInt;
  524. begin
  525.   if Outline.BadIndex(Self) then SetGoodIndex;
  526.   Result := FIndex;
  527. end;
  528.  
  529. function TOutlineNode.GetLevel: Cardinal;
  530. var
  531.   Node: TOutlineNode;
  532. begin
  533.   Result := 0;
  534.   Node := Parent;
  535.   while Node <> nil do
  536.   begin
  537.     Inc(Result);
  538.     Node := Node.Parent;
  539.   end;
  540. end;
  541.  
  542. procedure TOutlineNode.SetLevel(Level: Cardinal);
  543. var
  544.   CurLevel: Cardinal;
  545. begin
  546.   CurLevel := GetLevel;
  547.   if Level = CurLevel then Exit;
  548.   Outline.SetLevel(Self, CurLevel, Level);
  549. end;
  550.  
  551. procedure TOutlineNode.ChangeLevelBy(Value: TChangeRange);
  552. begin
  553.   Level := Level + Value;
  554. end;
  555.  
  556. function TOutlineNode.GetDisplayWidth: Integer;
  557. begin
  558.   Result := Outline.GetNodeDisplayWidth(Self);
  559. end;
  560.  
  561. function TOutlineNode.HasVisibleParent: Boolean;
  562. begin
  563.   Result := (Parent <> nil) and (Parent.Expanded);
  564. end;
  565.  
  566. function TOutlineNode.GetVisibleParent: TOutlineNode;
  567. begin
  568.   Result := Self;
  569.   while (Result.Parent <> nil) and not Result.Parent.Expanded do
  570.     Result := Result.Parent;
  571. end;
  572.  
  573. function TOutlineNode.GetFullPath: string;
  574. begin
  575.   if Parent <> nil then
  576.     if Parent.Parent <> nil then
  577.       Result := Parent.GetFullPath + Outline.ItemSeparator + Text
  578.     else
  579.       Result := Text
  580.   else Result := EmptyStr;
  581. end;
  582.  
  583. function TOutlineNode.HasAsParent(Value: TOutlineNode): Boolean;
  584. begin
  585.   if Self = Value then
  586.     Result := True
  587.   else if Parent <> nil then Result := Parent.HasAsParent(Value)
  588.   else Result := False;
  589. end;
  590.  
  591. function TOutlineNode.GetTopItem: Longint;
  592. var
  593.   Node: TOutlineNode;
  594. begin
  595.   Result := 0;
  596.   if Parent = nil then Exit;
  597.   Node := Self;
  598.   while Node.Parent <> nil do
  599.   begin
  600.     if Node.Parent.Parent = nil then
  601.       Result := Node.FIndex;
  602.     Node := Node.Parent;
  603.   end;
  604. end;
  605.  
  606. function TOutlineNode.GetFirstChild: LongInt;
  607. begin
  608.   if List.Count > 0 then Result := Items[0].Index
  609.   else Result := InvalidIndex;
  610. end;
  611.  
  612. function TOutlineNode.GetLastChild: LongInt;
  613. begin
  614.   if List.Count > 0 then Result := Items[List.Count - 1].Index
  615.   else Result := InvalidIndex;
  616. end;
  617.  
  618. function TOutlineNode.GetNextChild(Value: LongInt): LongInt;
  619. var
  620.  I: Integer;
  621. begin
  622.   Result := InvalidIndex;
  623.   for I := 0 to List.Count - 1 do
  624.   begin
  625.     if Items[I].Index = Value then
  626.     begin
  627.       if I < List.Count - 1 then Result := Items[I + 1].Index;
  628.       Break;
  629.     end;
  630.   end;
  631. end;
  632.  
  633. function TOutlineNode.GetPrevChild(Value: LongInt): LongInt;
  634. var
  635.  I: Integer;
  636. begin
  637.   Result := InvalidIndex;
  638.   for I := List.Count - 1 downto 0 do
  639.   begin
  640.     if Items[I].Index = Value then
  641.     begin
  642.       if I > 0 then Result := Items[I - 1].Index;
  643.       Break;
  644.     end;
  645.   end;
  646. end;
  647.  
  648. procedure TOutlineNode.MoveTo(Destination: LongInt; AttachMode: TAttachMode);
  649. begin
  650.   Outline.Move(Destination, Index, AttachMode);
  651. end;
  652.  
  653. procedure TOutlineNode.FullExpand;
  654. var
  655.   I: Integer;
  656. begin
  657.   if HasItems then
  658.   begin
  659.     Expanded := True;
  660.     for I := 0 to List.Count - 1 do
  661.       Items[I].FullExpand;
  662.   end;
  663. end;
  664.  
  665. function TOutlineNode.GetRowOfNode(TargetNode: TOutlineNode;
  666.   var RowCount: Longint): Boolean;
  667. var
  668.   I: Integer;
  669. begin
  670.   Inc(RowCount);
  671.   if TargetNode = Self then
  672.   begin
  673.     Result := True;
  674.     Exit;
  675.   end;
  676.  
  677.   Result := False;
  678.   if not Expanded then Exit;
  679.  
  680.   for I := 0 to List.Count - 1 do
  681.   begin
  682.     Result := Items[I].GetRowOfNode(TargetNode, RowCount);
  683.     if Result then Exit
  684.   end;
  685. end;
  686.  
  687. function TOutlineNode.GetVisibleNode(TargetCount: LongInt): TOutlineNode;
  688. var
  689.   I, J: Integer;
  690.   ExpandedCount, NodeCount, NodesParsed: LongInt;
  691.   Node: TOutlineNode;
  692.   Count: Integer;
  693. begin
  694.   if TargetCount = 0 then
  695.   begin
  696.     Result := Self;
  697.     Exit;
  698.   end;
  699.  
  700.   Result := nil;
  701.   Count := List.Count;
  702.   NodesParsed := 0;
  703.  
  704.   { Quick exit if we are lucky }
  705.   if ExpandCount = Count then
  706.   begin
  707.     Result := Items[TargetCount - 1];
  708.     Exit;
  709.   end;
  710.  
  711.   I := 0;
  712.   while I <= Count - 1 do
  713.   begin
  714.     for J := I to Count - 1 do
  715.       if Items[J].Expanded then Break;
  716.  
  717.     if J > I then
  718.     begin
  719.       if J - I >= TargetCount then
  720.       begin
  721.         Result := Items[I + TargetCount - 1];
  722.         Break;
  723.       end;
  724.       Dec(TargetCount, J - I);
  725.     end;
  726.  
  727.     Node := Items[J];
  728.     NodeCount := Node.ExpandCount + 1;
  729.     ExpandedCount := NodeCount + J - I;
  730.  
  731.     Inc(NodesParsed, ExpandedCount);
  732.     if NodeCount >= TargetCount then
  733.     begin
  734.       Result := Node.GetVisibleNode(Pred(TargetCount));
  735.       Break;
  736.     end
  737.     else if ExpandCount - NodesParsed = Count - (J + 1) then
  738.     begin
  739.       Result := Items[TargetCount - NodeCount + J];
  740.       Exit;
  741.     end
  742.     else begin
  743.       Dec(TargetCount, NodeCount);
  744.       I := J;
  745.     end;
  746.     Inc(I);
  747.   end;
  748.   if Result = nil then Error(SOutlineIndexError);
  749. end;
  750.  
  751. function TOutlineNode.GetNodeAtIndex(TargetIndex: LongInt): TOutlineNode;
  752. var
  753.   I: Integer;
  754.   Node: TOutlineNode;
  755.   Lower: Integer;
  756.   Upper: Integer;
  757.  
  758.   function RecurseNode: TOutlineNode;
  759.   begin
  760.     if Node.Index = TargetIndex then
  761.       Result := Node
  762.     else
  763.       Result := Node.GetNodeAtIndex(TargetIndex);
  764.   end;
  765.  
  766. begin
  767.   if TargetIndex = Index then
  768.   begin
  769.     Result := Self;
  770.     Exit;
  771.   end;
  772.  
  773.   Lower := 0;
  774.   Upper := List.Count - 1;
  775.   Result := nil;
  776.   while Upper >= Lower do
  777.   begin
  778.     I := (Lower + Upper) div 2;
  779.     Node := Items[I];
  780.     if Lower = Upper then
  781.     begin
  782.       Result := RecurseNode;
  783.       Break;
  784.     end
  785.     else if Node.Index > TargetIndex then Upper := Pred(I)
  786.     else if (Node.Index < TargetIndex) and (I < Upper) and
  787.       (Items[I + 1].Index <= TargetIndex) then Lower := Succ(I)
  788.     else begin
  789.       Result := RecurseNode;
  790.       Break;
  791.     end;
  792.   end;
  793.   if Result = nil then Raise OutlineError.Create;
  794. end;
  795.  
  796. function TOutlineNode.GetDataItem(Value: Pointer): LongInt;
  797. var
  798.   I: Integer;
  799. begin
  800.   if Value = Data then
  801.   begin
  802.     Result := Index;
  803.     Exit;
  804.   end;
  805.  
  806.   Result := 0;
  807.   for I := 0 to List.Count - 1 do
  808.   begin
  809.     Result := Items[I].GetDataItem(Value);
  810.     if Result <> 0 then Break;
  811.   end;
  812. end;
  813.  
  814. function TOutlineNode.GetTextItem(const Value: string): LongInt;
  815. var
  816.   I: Integer;
  817. begin
  818.   if Value = Text then
  819.   begin
  820.     Result := Index;
  821.     Exit;
  822.   end;
  823.  
  824.   Result := 0;
  825.   for I := 0 to List.Count - 1 do
  826.   begin
  827.     Result := Items[I].GetTextItem(Value);
  828.     if Result <> 0 then Break;
  829.   end;
  830. end;
  831.  
  832. procedure TOutlineNode.Expand;
  833. begin
  834.   Expanded := True;
  835. end;
  836.  
  837. procedure TOutlineNode.Collapse;
  838. begin
  839.   Expanded := False;
  840. end;
  841.  
  842. procedure TOutlineNode.SetExpandedState(Value: Boolean);
  843. var
  844.   ParentNode: TOutlineNode;
  845. begin
  846.   if FState <> Value then
  847.   begin
  848.     if Value then
  849.     begin
  850.       ParentNode := Self.Parent;
  851.       while ParentNode <> nil do
  852.       begin
  853.         if not ParentNode.Expanded then Error(SOutlineExpandError);
  854.         ParentNode := ParentNode.Parent;
  855.       end;
  856.       Outline.Expand(Index);
  857.       FState := True;
  858.       ChangeExpandedCount(List.Count);
  859.     end
  860.     else begin
  861.       CloseNode;
  862.       if List.Count > 0 then ChangeExpandedCount(-List.Count);
  863.       if Outline.ResizeGrid then Outline.Invalidate;
  864.       Outline.Collapse(Index);
  865.       FState := False;
  866.     end;
  867.     SetHorzScrollBar;
  868.     Repaint;
  869.   end;
  870. end;
  871.  
  872. procedure TOutlineNode.CloseNode;
  873. var
  874.   I: Integer;
  875. begin
  876.   for I := 0 to List.Count - 1 do
  877.     Items[I].CloseNode;
  878.   if List.Count > 0 then ChangeExpandedCount(-List.Count);
  879.   FState := False;
  880. end;
  881.  
  882. procedure TOutlineNode.Repaint;
  883. begin
  884.   if Outline <> nil then
  885.     if Outline.ResizeGrid then Outline.Invalidate;
  886. end;
  887.  
  888. procedure TOutlineNode.SetGoodIndex;
  889. var
  890.   StartNode: TOutlineNode;
  891.   ParentNode: TOutlineNode;
  892. begin
  893.   StartNode := Outline.SetGoodIndex(Self);
  894.   ParentNode := StartNode.Parent;
  895.   if ParentNode <> nil then
  896.     ParentNode.ReIndex(StartNode, Self, StartNode.FIndex, True)
  897.   else if Self <> Outline.FRootNode then
  898.     FIndex := Succ(StartNode.FIndex);
  899.   Outline.FGoodNode := Self;
  900. end;
  901.  
  902. function TOutlineNode.AddNode(Value: TOutlineNode): LongInt;
  903. begin
  904.   List.Add(Value);
  905.   Value.FParent := Self;
  906.   ChangeExpandedCount(Value.ExpandCount + 1);
  907.   if not Outline.FBlockInsert then Value.SetGoodIndex;
  908.   with Value do
  909.   begin
  910.     Result := FIndex;
  911.     SetHorzScrollBar;
  912.   end;
  913. end;
  914.  
  915. function TOutlineNode.InsertNode(Index: LongInt; Value: TOutlineNode): LongInt;
  916. var
  917.   CurIndex: LongInt;
  918.   I: Integer;
  919. begin
  920.   for I := 0 to List.Count - 1 do
  921.   begin
  922.     CurIndex := Items[I].FIndex;
  923.     if CurIndex = Index then
  924.     begin
  925.       List.Insert(I, Value);
  926.       Value.FParent := Self;
  927.       Break;
  928.     end;
  929.   end;
  930.   ChangeExpandedCount(Value.ExpandCount + 1);
  931.   if not Outline.FBlockInsert then Value.SetGoodIndex;
  932.   with Value do
  933.   begin
  934.     Result := FIndex;
  935.     SetHorzScrollBar;
  936.   end;
  937. end;
  938.  
  939. procedure TOutlineNode.InternalRemove(Value: TOutlineNode; Index: Integer);
  940. begin
  941.   if Index <> 0 then
  942.     Outline.SetGoodIndex(Items[Index - 1]) else
  943.     Outline.SetGoodIndex(Self);
  944.   List.Delete(Index);
  945.   ChangeExpandedCount(-(Value.ExpandCount + 1));
  946.   if (List.Count = 0) and (Parent <> nil) then Expanded := False;
  947.   SetHorzScrollBar;
  948. end;
  949.  
  950. procedure TOutlineNode.Remove(Value: TOutlineNode);
  951. begin
  952.   InternalRemove(Value, List.IndexOf(Value));
  953. end;
  954.  
  955. procedure TOutlineNode.ReIndex(StartNode, EndNode: TOutlineNode;
  956.   NewIndex: LongInt; IncludeStart: Boolean);
  957. var
  958.   I: Integer;
  959. begin
  960.   for I := List.IndexOf(StartNode) to List.Count - 1 do
  961.   begin
  962.     if IncludeStart then
  963.     begin
  964.       if Items[I].Resync(NewIndex, EndNode) then Exit;
  965.     end
  966.     else
  967.       IncludeStart := True;
  968.   end;
  969.  
  970.   if Parent <> nil then
  971.     Parent.ReIndex(Self, EndNode, NewIndex, False);
  972. end;
  973.  
  974. function TOutlineNode.Resync(var NewIndex: LongInt; EndNode: TOutlineNode): Boolean;
  975. var
  976.   I: Integer;
  977. begin
  978.   FIndex := NewIndex;
  979.   if EndNode = Self then
  980.   begin
  981.     Result := True;
  982.     Exit;
  983.   end;
  984.  
  985.   Result := False;
  986.   Inc(NewIndex);
  987.   for I := 0 to List.Count - 1 do
  988.   begin
  989.     Result := Items[I].Resync(NewIndex, EndNode);
  990.     if Result then Exit;
  991.   end;
  992. end;
  993.  
  994. function TOutlineNode.GetExpandedNodeCount: LongInt;
  995. var
  996.   I : Integer;
  997. begin
  998.   Result := 1;
  999.   if Expanded then
  1000.     for I := 0 to List.Count - 1 do
  1001.       Inc(Result, Items[I].GetExpandedNodeCount);
  1002. end;
  1003.  
  1004.  
  1005. function TOutlineNode.GetMaxDisplayWidth(Value: Cardinal): Cardinal;
  1006. var
  1007.   I : Integer;
  1008.   Width: Cardinal;
  1009. begin
  1010.   Width := GetDisplayWidth;
  1011.   if Width > Value then Result := Width
  1012.   else Result := Value;
  1013.   if Expanded then
  1014.     for I := 0 to List.Count - 1 do
  1015.       Result := Items[I].GetMaxDisplayWidth(Result);
  1016. end;
  1017.  
  1018. procedure TOutlineNode.Error(const ErrorString: string);
  1019. begin
  1020.   raise EOutlineError.Create(ErrorString);
  1021. end;
  1022.  
  1023. function TOutlineNode.HasChildren: Boolean;
  1024. begin
  1025.   Result := List.Count > 0;
  1026. end;
  1027.  
  1028. procedure TOutlineNode.WriteNode(Buffer: PChar; Stream: TStream);
  1029. var
  1030.   BufPtr: PChar;
  1031.   NodeLevel: Word;
  1032.   I: Integer;
  1033. begin
  1034.   if Parent <> nil then
  1035.   begin
  1036.     BufPtr := Buffer;
  1037.     NodeLevel := Level;
  1038.     while NodeLevel > 1 do
  1039.     begin
  1040.       BufPtr^ := Tab;
  1041.       Dec(NodeLevel);
  1042.       Inc(BufPtr);
  1043.     end;
  1044.     BufPtr := PutString(BufPtr, Text);
  1045.     Stream.WriteBuffer(Buffer[0], BufPtr - Buffer);
  1046.   end;
  1047.   for I := 0 to List.Count - 1 do
  1048.     Items[I].WriteNode(Buffer, Stream);
  1049. end;
  1050.  
  1051. function TOutlineNode.IsEqual(Value: TOutlineNode): Boolean;
  1052. begin
  1053.   Result := (Text = Value.Text) and (Data = Value.Data) and
  1054.     (ExpandCount = Value.ExpandCount);
  1055. end;
  1056.  
  1057. { TOutlineStrings }
  1058.  
  1059. function TOutlineStrings.Get(Index: Integer): string;
  1060. var
  1061.   Node: TOutlineNode;
  1062.   Level: Word;
  1063.   I: Integer;
  1064. begin
  1065.   Node := Outline[Index + 1];
  1066.   Level := Node.Level;
  1067.   Result := EmptyStr;
  1068.   for I := 0 to Level - 2 do
  1069.     Result := Result + TAB;
  1070.   Result := Result + Node.Text;
  1071. end;
  1072.  
  1073. function TOutlineStrings.GetCount: Integer;
  1074. begin
  1075.   Result := Outline.ItemCount;
  1076. end;
  1077.  
  1078. procedure TOutlineStrings.Clear;
  1079. begin
  1080.   Outline.Clear;
  1081. end;
  1082.  
  1083. procedure TOutlineStrings.DefineProperties(Filer: TFiler);
  1084.  
  1085.   function WriteNodes: Boolean;
  1086.   var
  1087.     I: Integer;
  1088.     Ancestor: TOutlineStrings;
  1089.   begin
  1090.     Ancestor := TOutlineStrings(Filer.Ancestor);
  1091.     if (Ancestor <> nil) and (Ancestor.Outline.ItemCount = Outline.ItemCount) and
  1092.       (Ancestor.Outline.ItemCount > 0) then
  1093.     begin
  1094.       Result := False;
  1095.       for I := 1 to Outline.ItemCount - 1 do
  1096.       begin
  1097.         Result := not Outline[I].IsEqual(Ancestor.Outline[I]);
  1098.         if Result then Break;
  1099.       end
  1100.     end else Result := Outline.ItemCount > 0;
  1101.   end;
  1102.  
  1103. begin
  1104.   Filer.DefineProperty('Nodes', ReadData, WriteData, WriteNodes);
  1105. end;
  1106.  
  1107. procedure TOutlineStrings.ReadData(Reader: TReader);
  1108. var
  1109.   StringList: TStringList;
  1110.   MemStream: TMemoryStream;
  1111. begin
  1112.   Reader.ReadListBegin;
  1113.   StringList := TStringList.Create;
  1114.   try
  1115.     while not Reader.EndOfList do StringList.Add(Reader.ReadString);
  1116.     MemStream := TMemoryStream.Create;
  1117.     try
  1118.       StringList.SaveToStream(MemStream);
  1119.       MemStream.Position := 0;
  1120.       Outline.LoadFromStream(MemStream);
  1121.     finally
  1122.       MemStream.Free;
  1123.     end;
  1124.   finally
  1125.     StringList.Free;
  1126.   end;
  1127.   Reader.ReadListEnd;
  1128. end;
  1129.  
  1130. procedure TOutlineStrings.WriteData(Writer: TWriter);
  1131. var
  1132.   I: Integer;
  1133.   MemStream: TMemoryStream;
  1134.   StringList: TStringList;
  1135. begin
  1136.   Writer.WriteListBegin;
  1137.   MemStream := TMemoryStream.Create;
  1138.   try
  1139.     Outline.SaveToStream(MemStream);
  1140.     MemStream.Position := 0;
  1141.     StringList := TStringList.Create;
  1142.     try
  1143.       StringList.LoadFromStream(MemStream);
  1144.       for I := 0 to StringList.Count - 1 do
  1145.         Writer.WriteString(StringList.Strings[I]);
  1146.     finally
  1147.       StringList.Free;
  1148.     end;
  1149.   finally
  1150.     MemStream.Free;
  1151.   end;
  1152.   Writer.WriteListEnd;
  1153. end;
  1154.  
  1155. function TOutlineStrings.Add(const S: string): Integer;
  1156. var
  1157.   Level, OldLevel, I: Cardinal;
  1158.   NewStr: string;
  1159.   NumNodes: LongInt;
  1160.   LastNode: TOutlineNode;
  1161. begin
  1162.   NewStr := GetBufStart(PChar(S), Level);
  1163.   NumNodes := Outline.ItemCount;
  1164.   if NumNodes > 0 then LastNode := Outline[Outline.ItemCount]
  1165.   else LastNode := Outline.FRootNode;
  1166.   OldLevel := LastNode.Level;
  1167.   if (Level > OldLevel) or (LastNode = Outline.FRootNode) then
  1168.   begin
  1169.     if Level - OldLevel > 1 then Outline.Error(SOutlineFileLoad);
  1170.   end
  1171.   else begin
  1172.     for I := OldLevel downto Level + 1 do
  1173.     begin
  1174.       LastNode := LastNode.Parent;
  1175.       if not Assigned(LastNode) then Outline.Error(SOutlineFileLoad);
  1176.     end;
  1177.   end;
  1178.   Result := Outline.AddChild(LastNode.Index, NewStr) - 1;
  1179. end;
  1180.  
  1181. procedure TOutlineStrings.Delete(Index: Integer);
  1182. begin
  1183.   Outline.Delete(Index + 1);
  1184. end;
  1185.  
  1186. procedure TOutlineStrings.Insert(Index: Integer; const S: string);
  1187. begin
  1188.   Outline.Insert(Index + 1, S);
  1189. end;
  1190.  
  1191. procedure TOutlineStrings.PutObject(Index: Integer; AObject: TObject);
  1192. var
  1193.   Node: TOutlineNode;
  1194. begin
  1195.   Node := Outline[Index + 1];
  1196.   Node.Data := Pointer(AObject);
  1197. end;
  1198.  
  1199. function TOutlineStrings.GetObject(Index: Integer): TObject;
  1200. begin
  1201.   Result := TObject(Outline[Index + 1].Data);
  1202. end;
  1203.  
  1204.  
  1205. {TCustomOutline}
  1206.  
  1207. const
  1208.   Images: array[TBitmapArrayRange] of PChar = ('PLUS', 'MINUS', 'OPEN', 'CLOSED', 'LEAF');
  1209.  
  1210. constructor TCustomOutline.Create(AOwner: TComponent);
  1211. begin
  1212.   inherited Create(AOwner);
  1213.   Width := 121;
  1214.   Height := 97;
  1215.   Color := clWindow;
  1216.   ParentColor := False;
  1217.   SetRowHeight;
  1218.   RowCount := 0;
  1219.   ColCount := 1;
  1220.   FixedCols := 0;
  1221.   FixedRows := 0;
  1222.   DefaultDrawing := False;
  1223.   Init;
  1224.   FStrings := TOutlineStrings.Create;
  1225.   TOutlineStrings(FStrings).Outline := Self;
  1226.   inherited Options := [];
  1227.   Options := [ooDrawTreeRoot, ooDrawFocusRect];
  1228.   ItemSeparator := '\';
  1229.   FOutlineStyle := osTreePictureText;
  1230.   CreateGlyph;
  1231. end;
  1232.  
  1233. destructor TCustomOutline.Destroy;
  1234. var
  1235.   I: Integer;
  1236. begin
  1237.   FStrings.Free;
  1238.   FRootNode.Free;
  1239.   for I := Low(FPictures) to High(FPictures) do FPictures[I].Free;
  1240.   inherited Destroy;
  1241. end;
  1242.  
  1243. procedure TCustomOutline.Init;
  1244. begin
  1245.   if FRootNode = nil then FRootNode := TOutlineNode.Create(Self);
  1246.   FRootNode.FState := True;
  1247.   ResetSelectedItem;
  1248.   FGoodNode := FRootNode;
  1249.   FCurItem := FRootNode;
  1250.   FBlockInsert := False;
  1251.   UpdateCount := 0;
  1252.   ResizeGrid;
  1253. end;
  1254.  
  1255. procedure TCustomOutline.CreateGlyph;
  1256. var
  1257.   I: Integer;
  1258. begin
  1259.   FUserBitmaps := [];
  1260.   FOldBitmaps := [];
  1261.   for I := Low(FPictures) to High(FPictures) do
  1262.   begin
  1263.     FPictures[I] := TBitmap.Create;
  1264.     FPictures[I].Handle := LoadBitmap(HInstance, Images[I]);
  1265.   end;
  1266. end;
  1267.  
  1268. procedure TCustomOutline.SetRowHeight;
  1269. var
  1270.   ScreenDC: HDC;
  1271. begin
  1272.   if Style <> otOwnerDraw then
  1273.   begin
  1274.     ScreenDC := GetDC(0);
  1275.     try
  1276.       FFontSize := MulDiv(Font.Size, GetDeviceCaps(ScreenDC, LOGPIXELSY), 72);
  1277.       DefaultRowHeight := MulDiv(FFontSize, 120, 100);
  1278.       FItemHeight := DefaultRowHeight;
  1279.     finally
  1280.       ReleaseDC(0, ScreenDC);
  1281.     end;
  1282.   end
  1283. end;
  1284.  
  1285. procedure TCustomOutline.Clear;
  1286. begin
  1287.   FRootNode.Destroy;
  1288.   FRootNode := nil;
  1289.   Init;
  1290. end;
  1291.  
  1292. procedure TCustomOutline.DefineProperties(Filer: TFiler);
  1293.  
  1294.   function WriteOutline: Boolean;
  1295.   var
  1296.     Ancestor: TCustomOutline;
  1297.   begin
  1298.     Ancestor := TCustomOutline(Filer.Ancestor);
  1299.     if Ancestor <> nil then
  1300.       Result := (Ancestor.FUserBitmaps <> []) and
  1301.         (Ancestor.FUserBitmaps - FUserBitmaps <> [])
  1302.     else Result := FUserBitmaps <> [];
  1303.   end;
  1304.  
  1305. begin
  1306.   inherited DefineProperties(Filer);
  1307.   Filer.DefineBinaryProperty('Data', ReadBinaryData, WriteBinaryData,
  1308.     WriteOutline);
  1309. end;
  1310.  
  1311. procedure TCustomOutline.ReadBinaryData(Stream: TStream);
  1312. begin
  1313.   Stream.ReadBuffer(FOldBitmaps, SizeOf(FOldBitmaps));
  1314. end;
  1315.  
  1316. procedure TCustomOutline.WriteBinaryData(Stream: TStream);
  1317. begin
  1318.   Stream.WriteBuffer(FuserBitmaps, SizeOf(FUserBitmaps));
  1319. end;
  1320.  
  1321. function TCustomOutline.IsCurItem(Value: LongInt): Boolean;
  1322. begin
  1323.   Result := Value = FCurItem.Index;
  1324. end;
  1325.  
  1326. function TCustomOutline.GetItemCount: LongInt;
  1327. begin
  1328.   Result := FRootNode.GetLastIndex;
  1329. end;
  1330.  
  1331. procedure TCustomOutline.MoveNode(Destination, Source: LongInt;
  1332.   AttachMode: TAttachMode);
  1333. var
  1334.   SourceNode: TOutlineNode;
  1335.   DestNode: TOutLineNode;
  1336.   OldParent: TOutlineNode;
  1337.   OldIndex: Integer;
  1338. begin
  1339.   if Destination = Source then Exit;
  1340.   DestNode := FCurItem;
  1341.   if not IsCurItem(Destination) then
  1342.     try
  1343.       DestNode := FRootNode.GetNodeAtIndex(Destination);
  1344.     except
  1345.       on OutlineError do Error(SOutlineIndexError);
  1346.     end;
  1347.  
  1348.   SourceNode := FCurItem;
  1349.   if not IsCurItem(Source) then
  1350.     try
  1351.       SourceNode := FRootNode.GetNodeAtIndex(Source);
  1352.     except
  1353.       on OutlineError do Error(SOutlineIndexError);
  1354.     end;
  1355.  
  1356.   if DestNode.HasAsParent(SourceNode) then Exit;
  1357.  
  1358.   if DestNode.GetLevel > MaxLevels then Error(SOutlineMaxLevels);
  1359.   if (FGoodNode = FRootNode) and (FRootNode.List.Count <> 0) then
  1360.     TOutlineNode(FRootNode[0]).SetGoodIndex;
  1361.   OldParent := SourceNode.Parent;
  1362.   OldIndex := -1;
  1363.   case AttachMode of
  1364.     oaInsert:
  1365.       begin
  1366.         if DestNode.Parent = OldParent then
  1367.         begin
  1368.           OldIndex := OldParent.List.IndexOf(SourceNode);
  1369.           if OldParent.List.IndexOf(DestNode) < OldIndex then
  1370.             OldIndex := OldIndex + 1 else
  1371.             OldIndex := -1;
  1372.         end;
  1373.         DestNode.Parent.InsertNode(DestNode.Index, SourceNode);
  1374.       end;
  1375.     oaAddChild: DestNode.AddNode(SourceNode);
  1376.     oaAdd: DestNode.Parent.AddNode(SourceNode);
  1377.   end;
  1378.   if OldIndex <> -1 then
  1379.     OldParent.InternalRemove(SourceNode, OldIndex) else
  1380.     OldParent.Remove(SourceNode);
  1381.   if not DestNode.Expanded then SourceNode.Expanded := False;
  1382.   if (FGoodNode = FRootNode) and (FRootNode.List.Count <> 0) then
  1383.     TOutlineNode(FRootNode[0]).SetGoodIndex;
  1384.   ResizeGrid;
  1385.   Invalidate;
  1386. end;
  1387.  
  1388. function TCustomOutline.AttachNode(Index: LongInt; Str: string;
  1389.   Ptr: Pointer; AttachMode: TAttachMode): LongInt;
  1390. var
  1391.   NewNode: TOutlineNode;
  1392.   CurrentNode: TOutLineNode;
  1393. begin
  1394.   Result := 0;
  1395.   NewNode := TOutlineNode.Create(Self);
  1396.   with NewNode do
  1397.   begin
  1398.     Text := Str;
  1399.     Data := Ptr;
  1400.     FIndex := InvalidIndex;
  1401.   end;
  1402.   try
  1403.     CurrentNode := FCurItem;
  1404.     if not IsCurItem(Index) then
  1405.       try
  1406.         CurrentNode := FRootNode.GetNodeAtIndex(Index);
  1407.       except
  1408.         on OutlineError do Error(SOutlineIndexError);
  1409.       end;
  1410.  
  1411.     if AttachMode = oaAdd then
  1412.     begin
  1413.       CurrentNode := CurrentNode.Parent;
  1414.       if CurrentNode = nil then Error(SOutlineError);
  1415.       AttachMode := oaAddChild;
  1416.     end;
  1417.  
  1418.     with CurrentNode do
  1419.     begin
  1420.       case AttachMode of
  1421.         oaInsert: Result := Parent.InsertNode(Index, NewNode);
  1422.         oaAddChild:
  1423.           begin
  1424.              if GetLevel > MaxLevels then Error(SOutlineMaxLevels);
  1425.              Result := AddNode(NewNode);
  1426.           end;
  1427.       end;
  1428.     end;
  1429.     if ResizeGrid then Invalidate;
  1430.   except
  1431.     NewNode.Destroy;
  1432.     Application.HandleException(Self);
  1433.   end;
  1434. end;
  1435.  
  1436. function TCustomOutline.Get(Index: LongInt): TOutlineNode;
  1437. begin
  1438.   Result := FCurItem;
  1439.   if not IsCurItem(Index) then
  1440.     try
  1441.       Result := FRootNode.GetNodeAtIndex(Index);
  1442.     except
  1443.       on OutlineError do Error(SOutlineIndexError);
  1444.     end;
  1445.   if Result = FRootNode then Error(SOutlineError);
  1446. end;
  1447.  
  1448. function TCustomOutline.GetSelectedItem: LongInt;
  1449. begin
  1450.   if FSelectedItem <> FRootNode then
  1451.   begin
  1452.     if not FSelectedItem.IsVisible then
  1453.       FSelectedItem := FSelectedItem.GetVisibleParent;
  1454.   end
  1455.   else if FRootNode.List.Count > 0 then
  1456.     FSelectedItem := FRootNode.GetVisibleNode(Row + 1);
  1457.   Result := FSelectedItem.Index
  1458. end;
  1459.  
  1460. procedure TCustomOutline.ResetSelectedItem;
  1461. begin
  1462.   FSelectedItem := FRootNode;
  1463. end;
  1464.  
  1465. procedure TCustomOutline.SetRowFromNode(Node: TOutlineNode);
  1466. var
  1467.   RowValue: LongInt;
  1468. begin
  1469.   if Node <> FRootNode then
  1470.   begin
  1471.     RowValue := 0;
  1472.     FRootNode.GetRowOfNode(Node, RowValue);
  1473.     Row := RowValue - 2;
  1474.   end;
  1475. end;
  1476.  
  1477. procedure TCustomOutline.SetSelectedItem(Value: Longint);
  1478. var
  1479.   Node: TOutlineNode;
  1480. begin
  1481.   if FBlockInsert then Exit;
  1482.   if (Value = 0) and (FRootNode.List.Count > 0) then Value := 1;
  1483.   if Value > 0 then
  1484.   begin
  1485.     Node := FSelectedItem;
  1486.     if Value <> FSelectedItem.Index then
  1487.     try
  1488.       Node := FRootNode.GetNodeAtIndex(Value);
  1489.     except
  1490.       on OutlineError do Error(SOutlineIndexError);
  1491.     end;
  1492.     if not Node.IsVisible then Node := Node.GetVisibleParent;
  1493.     FSelectedItem := Node;
  1494.     SetRowFromNode(Node);
  1495.   end
  1496.   else Error(SOutlineSelection);
  1497. end;
  1498.  
  1499. function TCustomOutline.Insert(Index: LongInt; const Text: string): LongInt;
  1500. begin
  1501.   Result := InsertObject(Index, Text, nil);
  1502. end;
  1503.  
  1504. function TCustomOutline.InsertObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
  1505. begin
  1506.   Result := -1;
  1507.   if Index > 0 then Result := AttachNode(Index, Text, Data, oaInsert)
  1508.   else if Index = 0 then Result := AddChildObject(Index, Text, Data)
  1509.   else Error(SOutlineError);
  1510.   SetCurItem(Index);
  1511. end;
  1512.  
  1513. function TCustomOutline.Add(Index: LongInt; const Text: string): LongInt;
  1514. begin
  1515.   Result := AddObject(Index, Text, nil);
  1516. end;
  1517.  
  1518. function TCustomOutline.AddObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
  1519. begin
  1520.   Result := -1;
  1521.   if Index > 0 then Result := AttachNode(Index, Text, Data, oaAdd)
  1522.   else If Index = 0 then Result := AddChildObject(Index, Text, Data)
  1523.   else Error(SOutlineError);
  1524.   SetCurItem(Index);
  1525. end;
  1526.  
  1527. function TCustomOutline.AddChild(Index: LongInt; const Text: string): LongInt;
  1528. begin
  1529.   Result := AddChildObject(Index, Text, nil);
  1530. end;
  1531.  
  1532. function TCustomOutline.AddChildObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
  1533. begin
  1534.   Result := -1;
  1535.   if Index >= 0 then Result := AttachNode(Index, Text, Data, oaAddChild)
  1536.   else Error(SOutlineError);
  1537.   SetCurItem(Index);
  1538. end;
  1539.  
  1540. procedure TCustomOutline.Delete(Index: LongInt);
  1541. begin
  1542.   if Index > 0 then
  1543.   begin
  1544.     try
  1545.       FRootNode.GetNodeAtIndex(Index).Free;
  1546.     except
  1547.       on OutlineError do Error(SOutlineIndexError);
  1548.     end;
  1549.   end
  1550.   else Error(SOutlineError);
  1551. end;
  1552.  
  1553. procedure TCustomOutline.Move(Destination, Source: LongInt; AttachMode: TAttachMode);
  1554. begin
  1555.   if (AttachMode = oaAddChild) or (Destination > 0) then
  1556.     MoveNode(Destination, Source, AttachMode)
  1557.   else Error(SOutlineError);
  1558. end;
  1559.  
  1560. procedure TCustomOutline.DeleteNode(Node: TOutlineNode; CurIndex: LongInt);
  1561. begin
  1562.   if (FGoodNode = FRootNode) and (FRootNode.List.Count <> 0) then
  1563.     FRootNode[0].SetGoodIndex;
  1564.   try
  1565.     FCurItem := FRootNode.GetNodeAtIndex(CurIndex);
  1566.   except
  1567.     on OutlineError do FCurItem := FRootNode;
  1568.   end;
  1569.   if (FSelectedItem = FRootNode) and (Node <> FRootNode) then
  1570.     GetSelectedItem;
  1571.   if ResizeGrid then Invalidate;
  1572. end;
  1573.  
  1574. procedure TCustomOutline.SetLevel(Node: TOutlineNode; CurLevel, NewLevel: Cardinal);
  1575. var
  1576.   NumLevels: Integer;
  1577.  
  1578.   procedure MoveUp(Node: TOutlineNode; NumLevels: Cardinal);
  1579.   var
  1580.     Parent: TOutlineNode;
  1581.     I: Cardinal;
  1582.     Index: Integer;
  1583.   begin
  1584.     Parent := Node;
  1585.     for I := NumLevels downto 1 do
  1586.       Parent := Parent.Parent;
  1587.     Index := Parent.Parent.GetNextChild(Parent.Index);
  1588.     if Index = InvalidIndex then Node.MoveTo(Parent.Parent.Index, oaAddChild)
  1589.     else Node.MoveTo(Index, oaInsert);
  1590.   end;
  1591.  
  1592.   procedure MoveDown(Node: TOutlineNode; NumLevels: Cardinal);
  1593.   var
  1594.     Parent: TOutlineNode;
  1595.     I: Cardinal;
  1596.   begin
  1597.     while NumLevels > 0 do
  1598.     begin
  1599.       Parent := Node.Parent;
  1600.       for I := Parent.List.Count - 1 downto 0 do
  1601.         if Parent.Items[I].Index = Node.Index then Break;
  1602.       if I > 0 then
  1603.       begin
  1604.         Parent := Parent.Items[I - 1];
  1605.         Node.MoveTo(Parent.Index, oaAddChild);
  1606.       end else Error(SOutlineBadLevel);
  1607.       Dec(NumLevels);
  1608.     end;
  1609.   end;
  1610.  
  1611. begin
  1612.   NumLevels := CurLevel - NewLevel;
  1613.   if (NewLevel > 0) then
  1614.   begin
  1615.     if (NumLevels > 0) then MoveUp(Node, NumLevels)
  1616.     else MoveDown(Node, ABS(NumLevels));
  1617.   end
  1618.   else Error(SOutlineBadLevel);
  1619. end;
  1620.  
  1621. procedure TCustomOutline.Click;
  1622. begin
  1623.   if FRootNode.List.Count > 0 then
  1624.     SelectedItem := FRootNode.GetVisibleNode(Row + 1).Index;
  1625.   inherited Click;
  1626. end;
  1627.  
  1628. procedure TCustomOutline.WMSize(var Message: TWMSize);
  1629. begin
  1630.   inherited;
  1631.   if FSettingWidth or FSettingHeight then Exit;
  1632.   if (ScrollBars in [ssNone, ssVertical]) or
  1633.     ((Style = otOwnerDraw) and Assigned(FOnDrawItem)) then
  1634.     DefaultColWidth := ClientWidth
  1635.   else SetHorzScrollBar;
  1636. end;
  1637.  
  1638. procedure TCustomOutline.KeyPress(var Key: Char);
  1639. begin
  1640.   inherited KeyPress(Key);
  1641.   if FSelectedItem <> FRootNode then
  1642.     case Key of
  1643.       '+': FSelectedItem.Expanded := True;
  1644.       '-': FSelectedItem.Expanded := False;
  1645.       '*': FSelectedItem.FullExpand;
  1646.     end;
  1647. end;
  1648.  
  1649. procedure TCustomOutline.KeyDown(var Key: Word; Shift: TShiftState);
  1650. var
  1651.   Node: TOutlineNode;
  1652. begin
  1653.   inherited KeyDown(Key, Shift);
  1654.   if FRootNode.List.Count = 0 then Exit;
  1655.   Node := FRootNode.GetVisibleNode(Row + 1);
  1656.   case Key of
  1657.     VK_HOME:
  1658.       begin
  1659.         SelectedItem := TOutlineNode(FRootNode.List.First).Index;
  1660.         Exit;
  1661.       end;
  1662.     VK_END:
  1663.       begin
  1664.         Node := TOutlineNode(FRootNode.List.Last);
  1665.         while Node.Expanded and Node.HasItems do
  1666.           Node := TOutlineNode(Node.List.Last);
  1667.         SelectedItem := Node.Index;
  1668.         Exit;
  1669.       end;
  1670.     VK_RETURN:
  1671.       begin
  1672.         Node.Expanded := not Node.Expanded;
  1673.         Exit;
  1674.       end;
  1675.     VK_MULTIPLY:
  1676.       begin
  1677.         if ssCtrl in Shift then
  1678.         begin
  1679.           FullExpand;
  1680.           Exit;
  1681.         end;
  1682.       end;
  1683.     VK_RIGHT:
  1684.       begin
  1685.         if (not Node.HasItems) or (not Node.Expanded) then MessageBeep(0)
  1686.         else SelectedItem := SelectedItem + 1;
  1687.         Exit;
  1688.       end;
  1689.     VK_LEFT:
  1690.       begin
  1691.         if Node.Parent = FRootNode then MessageBeep(0)
  1692.         else SelectedItem := Node.Parent.Index;
  1693.         Exit;
  1694.       end;
  1695.     VK_UP:
  1696.       if ssCtrl in Shift then
  1697.       begin
  1698.         with Node.Parent do
  1699.         begin
  1700.           if List.First = Node then MessageBeep(0)
  1701.           else SelectedItem := Items[List.IndexOf(Node) - 1].Index;
  1702.         end;
  1703.         Exit;
  1704.       end;
  1705.     VK_DOWN:
  1706.       if ssCtrl in Shift then
  1707.       begin
  1708.         with Node.Parent do
  1709.         begin
  1710.           if List.Last = Node then MessageBeep(0)
  1711.           else SelectedItem := Items[List.IndexOf(Node) + 1].Index;
  1712.         end;
  1713.         Exit;
  1714.       end;
  1715.   end;
  1716.   SelectedItem := FRootNode.GetVisibleNode(Row + 1).Index;
  1717. end;
  1718.  
  1719. procedure TCustomOutline.DblClick;
  1720. var
  1721.   Node: TOutlineNode;
  1722. begin
  1723.   inherited DblClick;
  1724.   Node := FSelectedItem;
  1725.   if Node <> FRootNode then DoExpand(Node);
  1726. end;
  1727.  
  1728. procedure TCustomOutline.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1729.   X, Y: Integer);
  1730. begin
  1731.   inherited MouseDown(Button, Shift, X, Y);
  1732.   ResetSelectedItem;
  1733.   GetSelectedItem;
  1734. end;
  1735.  
  1736. procedure TCustomOutline.FullExpand;
  1737. begin
  1738.   FRootNode.FullExpand;
  1739. end;
  1740.  
  1741. procedure TCustomOutline.FullCollapse;
  1742. var
  1743.   I: Integer;
  1744. begin
  1745.   for I := 0 to FRootNode.List.Count - 1 do
  1746.     FRootNode.Items[I].Expanded := False;
  1747. end;
  1748.  
  1749. procedure TCustomOutline.SetHorzScrollBar;
  1750. begin
  1751.   if (ScrollBars in [ssHorizontal, ssBoth]) and
  1752.     (UpdateCount <= 0) and not FIgnoreScrollResize and
  1753.     not ((Style = otOwnerDraw) and Assigned(FOnDrawItem)) then
  1754.     SetDisplayWidth(FRootNode.GetMaxDisplayWidth(0));
  1755. end;
  1756.  
  1757. procedure TCustomOutline.DoExpand(Node: TOutlineNode);
  1758. begin
  1759.   with Node do
  1760.     Expanded := not Expanded;
  1761. end;
  1762.  
  1763. procedure TCustomOutline.BeginUpdate;
  1764. begin
  1765.   if UpdateCount = 0 then SetUpdateState(True);
  1766.   Inc(UpdateCount);
  1767. end;
  1768.  
  1769. procedure TCustomOutline.EndUpdate;
  1770. begin
  1771.   Dec(UpdateCount);
  1772.   if UpdateCount = 0 then SetUpdateState(False);
  1773. end;
  1774.  
  1775. procedure TCustomOutline.SetUpdateState(Value: Boolean);
  1776. begin
  1777.   if FBlockInsert <> Value then
  1778.   begin
  1779.     FBlockInsert := Value;
  1780.     if not FBlockInsert then
  1781.     begin
  1782.       if ResizeGrid then Invalidate;
  1783.       if FRootNode.List.Count > 0 then
  1784.         TOutlineNode(FRootNode.List.First).SetGoodIndex
  1785.       else
  1786.         FRootNode.SetGoodIndex;
  1787.       SetHorzScrollBar;
  1788.     end;
  1789.   end;
  1790. end;
  1791.  
  1792. function TCustomOutline.ResizeGrid: Boolean;
  1793. var
  1794.   OldRowCount: LongInt;
  1795. begin
  1796.   Result := False;
  1797.   if not FBlockInsert then
  1798.   begin
  1799.     OldRowCount := RowCount;
  1800.     FSettingHeight := True;
  1801.     try
  1802.       RowCount := FRootNode.ExpandCount;
  1803.     finally
  1804.       FSettingHeight := False;
  1805.     end;
  1806.     Result := RowCount <> OldRowCount;
  1807.     if FSelectedItem <> FRootNode then SelectedItem := FSelectedItem.Index;
  1808.   end;
  1809. end;
  1810.  
  1811. function TCustomOutline.BadIndex(Value: TOutlineNode): Boolean;
  1812. begin
  1813.   Result := CompareNodes(Value, FGoodNode) = ocGreater;
  1814. end;
  1815.  
  1816. function TCustomOutline.SetGoodIndex(Value: TOutlineNode): TOutlineNode;
  1817. var
  1818.   ParentNode: TOutlineNode;
  1819.   Index: Integer;
  1820.   Compare: TOutlineNodeCompare;
  1821. begin
  1822.   Compare := CompareNodes(FGoodNode, Value);
  1823.  
  1824.   case Compare of
  1825.     ocLess,
  1826.     ocSame:
  1827.       Result := FGoodNode;
  1828.     ocGreater:
  1829.       begin
  1830.         ParentNode := Value.Parent;
  1831.         Index := ParentNode.List.IndexOf(Value);
  1832.         if Index <> 0 then
  1833.           Result := ParentNode[Index - 1]
  1834.         else
  1835.           Result := ParentNode;
  1836.       end;
  1837.     ocInvalid:
  1838.       Result := FRootNode;
  1839.   else
  1840.     Result := FRootNode;    
  1841.   end;
  1842.  
  1843.   FGoodNode := Result;
  1844. end;
  1845.  
  1846. function TCustomOutline.CompareNodes(Value1, Value2: TOutlineNode): TOutlineNodeCompare;
  1847. var
  1848.   Level1: Integer;
  1849.   Level2: Integer;
  1850.   Index1: Integer;
  1851.   Index2: Integer;
  1852.   Value1ParentNode: TOutlineNode;
  1853.   Value2ParentNode: TOutlineNode;
  1854.   CommonNode: TOutlineNode;
  1855.  
  1856.   function GetParentNodeAtLevel(Value: TOutlineNode; Level: Integer): TOutlineNode;
  1857.   begin
  1858.     while Level > 0 do
  1859.     begin
  1860.       Value := Value.Parent;
  1861.       Dec(Level);
  1862.     end;
  1863.   Result := Value;
  1864.   end;
  1865.  
  1866. begin
  1867.   if Value1 = Value2 then
  1868.   begin
  1869.     Result := ocSame;
  1870.     Exit;
  1871.   end;
  1872.  
  1873.   Value1ParentNode := Value1;
  1874.   Value2ParentNode := Value2;
  1875.  
  1876.   Level1 := Value1.GetLevel;
  1877.   Level2 := Value2.GetLevel;
  1878.  
  1879.   if Level1 > Level2 then
  1880.     Value1ParentNode := GetParentNodeAtLevel(Value1, Level1 - Level2)
  1881.   else if Level2 > Level1 then
  1882.     Value2ParentNode := GetParentNodeAtLevel(Value2, Level2 - Level1);
  1883.  
  1884.   while Value1ParentNode.Parent <> Value2ParentNode.Parent do
  1885.   begin
  1886.     Value1ParentNode := Value1ParentNode.Parent;
  1887.     Value2ParentNode := Value2ParentNode.Parent;
  1888.   end;
  1889.  
  1890.   CommonNode := Value1ParentNode.Parent;
  1891.   if CommonNode <> nil then
  1892.   begin
  1893.     Index1 := CommonNode.List.IndexOf(Value1ParentNode);
  1894.     Index2 := CommonNode.List.IndexOf(Value2ParentNode);
  1895.     if Index1 < Index2 then Result := ocLess
  1896.     else if Index2 < Index1 then Result := ocGreater
  1897.     else begin
  1898.       if Level1 > Level2 then Result := ocGreater
  1899.       else if Level1 = Level2 then Result := ocSame
  1900.       else Result := ocLess;
  1901.     end
  1902.   end
  1903.   else
  1904.     Result := ocInvalid;
  1905. end;
  1906.  
  1907. function TCustomOutline.GetDataItem(Value: Pointer): Longint;
  1908. begin
  1909.   Result := FRootNode.GetDataItem(Value);
  1910. end;
  1911.  
  1912. function TCustomOutline.GetItem(X, Y: Integer): LongInt;
  1913. var
  1914.   Value: TGridCoord;
  1915. begin
  1916.   Result := -1;
  1917.   Value := MouseCoord(X, Y);
  1918.   with Value do
  1919.    if (Y > 0) or (FRootNode.List.Count > 0) then
  1920.      Result := FRootNode.GetVisibleNode(Y + 1).Index;
  1921. end;
  1922.  
  1923. function TCustomOutline.GetTextItem(const Value: string): Longint;
  1924. begin
  1925.   Result := FRootNode.GetTextItem(Value);
  1926. end;
  1927.  
  1928. procedure TCustomOutline.SetCurItem(Value: LongInt);
  1929. begin
  1930.   if Value < 0 then Error(SInvalidCurrentItem);
  1931.   if not IsCurItem(Value) then
  1932.     try
  1933.       FCurItem := FRootNode.GetNodeAtIndex(Value);
  1934.     except
  1935.       on OutlineError do Error(SOutlineIndexError);
  1936.     end;
  1937. end;
  1938.  
  1939. procedure TCustomOutline.SetOutlineStyle(Value: TOutlineStyle);
  1940. begin
  1941.   if FOutlineStyle <> Value then
  1942.   begin
  1943.     FOutlineStyle := Value;
  1944.     SetHorzScrollBar;
  1945.     Invalidate;
  1946.   end;
  1947. end;
  1948.  
  1949. procedure TCustomOutline.CMFontChanged(var Message: TMessage);
  1950. begin
  1951.   inherited;
  1952.   SetRowHeight;
  1953.   SetHorzScrollBar;
  1954. end;
  1955.  
  1956. procedure TCustomOutline.SetDisplayWidth(Value: Integer);
  1957. begin
  1958.   FSettingWidth := True;
  1959.   try
  1960.     if DefaultColWidth <> Value then DefaultColWidth := Value;
  1961.   finally
  1962.     FSettingWidth := False;
  1963.   end;
  1964. end;
  1965.  
  1966. function TCustomOutline.GetNodeDisplayWidth(Node: TOutlineNode): Integer;
  1967. var
  1968.   Delta: Integer;
  1969.   TextLength: Integer;
  1970. begin
  1971.   Result := 0;
  1972.   Delta := (DefaultRowHeight - FFontSize) div 2;
  1973.  
  1974.   with Canvas do
  1975.   begin
  1976.     Font := Self.Font;
  1977.     TextLength := TextWidth(Node.Text) + 1;
  1978.   end;
  1979.  
  1980.   case OutlineStyle of
  1981.     osText: Inc(Result, DefaultRowHeight * (Node.Level - 1));
  1982.     osPlusMinusPictureText: Inc(Result, DefaultRowHeight * (Node.Level + 1));
  1983.     osPlusMinusText,
  1984.     osPictureText: Inc(Result, DefaultRowHeight * Node.Level);
  1985.     osTreeText:
  1986.       begin
  1987.         Inc(Result, DefaultRowHeight * (Node.Level - 1) - Delta);
  1988.         if ooDrawTreeRoot in Options then Inc(Result, DefaultRowHeight);
  1989.       end;
  1990.     osTreePictureText:
  1991.       begin
  1992.         Inc(Result, DefaultRowHeight * (Node.Level) - Delta);
  1993.         if ooDrawTreeRoot in Options then Inc(Result, DefaultRowHeight);
  1994.       end;
  1995.   end;
  1996.   Inc(Result, TextLength);
  1997.   if Result < 0 then Result := 0;
  1998. end;
  1999.  
  2000. function TCustomOutline.GetVisibleNode(Index: LongInt): TOutlineNode;
  2001. begin
  2002.   Result := FRootNode.GetVisibleNode(Index + 1);
  2003. end;
  2004.  
  2005. procedure TCustomOutline.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
  2006. var
  2007.   Node: TOutlineNode;
  2008.   Expanded: Boolean;
  2009.   HasChildren: Boolean;
  2010.   IndentLevel: Word;
  2011.   Bitmap1, Bitmap2: TBitmap;
  2012.   TextLength: Integer;
  2013.   Delta: Integer;
  2014.   InitialLeft: Integer;
  2015.  
  2016.   function GetBitmap(Value: TOutlineBitmap): TBitmap;
  2017.   begin
  2018.     Result := FPictures[Ord(Value)];
  2019.   end;
  2020.  
  2021.   procedure DrawFocusCell;
  2022.   begin
  2023.     Inc(ARect.Right, TextLength);
  2024.     if (Row = ARow) and (Node.Text <> '') then
  2025.       Canvas.FillRect(ARect);
  2026.   end;
  2027.  
  2028.   procedure DrawTheText;
  2029.   begin
  2030.     Inc(ARect.Left, DefaultRowHeight * (IndentLevel - 1));
  2031.     ARect.Right := ARect.Left;
  2032.     DrawFocusCell;
  2033.     DrawText(Node, ARect);
  2034.   end;
  2035.  
  2036.   procedure DrawPlusMinusPicture;
  2037.   begin
  2038.     Inc(ARect.Left, DefaultRowHeight * (IndentLevel - 1));
  2039.     if HasChildren then
  2040.     begin
  2041.       if Expanded then
  2042.       begin
  2043.         Bitmap1 := GetBitmap(obMinus);
  2044.         Bitmap2 := GetBitmap(obOpen);
  2045.       end
  2046.       else begin
  2047.         Bitmap1 := GetBitmap(obPlus);
  2048.         Bitmap2 := GetBitmap(obClose);
  2049.       end;
  2050.     end
  2051.     else begin
  2052.       Bitmap1 := nil;
  2053.       Bitmap2 := GetBitmap(obLeaf);
  2054.     end;
  2055.     ARect.Left := ARect.Left + DefaultRowHeight * 2;
  2056.     ARect.Right := ARect.Left;
  2057.     DrawFocusCell;
  2058.     DrawText(Node, ARect);
  2059.     Dec(ARect.Left, DefaultRowHeight * 2);
  2060.     DrawPictures([Bitmap1, Bitmap2], ARect);
  2061.   end;
  2062.  
  2063.   procedure DrawPictureText;
  2064.   var
  2065.     Style: TOutlineBitmap;
  2066.   begin
  2067.     Inc(ARect.Left, DefaultRowHeight * (IndentLevel - 1));
  2068.     if HasChildren then
  2069.     begin
  2070.       if Expanded then Style := obOpen
  2071.       else Style := obClose
  2072.     end
  2073.     else Style := obLeaf;
  2074.     Bitmap1 := GetBitmap(Style);
  2075.     ARect.Left := ARect.Left + DefaultRowHeight;
  2076.     ARect.Right := ARect.Left;
  2077.     DrawFocusCell;
  2078.     DrawText(Node, ARect);
  2079.     Dec(ARect.Left, DefaultRowHeight);
  2080.     DrawPictures([Bitmap1], ARect);
  2081.   end;
  2082.  
  2083.   procedure DrawPlusMinusText;
  2084.   var
  2085.     Style: TOutlineBitmap;
  2086.   begin
  2087.     Inc(ARect.Left, DefaultRowHeight * IndentLevel);
  2088.     ARect.Right := ARect.Left;
  2089.     DrawFocusCell;
  2090.     DrawText(Node, ARect);
  2091.     if HasChildren then
  2092.     begin
  2093.       if Expanded then Style := obMinus
  2094.       else Style := obPlus;
  2095.       Bitmap1 := GetBitmap(Style);
  2096.       Dec(ARect.Left, DefaultRowHeight);
  2097.       DrawPictures([Bitmap1], ARect);
  2098.     end;
  2099.   end;
  2100.  
  2101.   procedure DrawTheTree;
  2102.   begin
  2103.     DrawTree(ARect, Node);
  2104.     Inc(ARect.Left, DefaultRowHeight * (IndentLevel - 1) - Delta);
  2105.     if ooDrawTreeRoot in Options then Inc(ARect.Left, DefaultRowHeight);
  2106.     ARect.Right := ARect.Left + Delta;
  2107.     DrawFocusCell;
  2108.     Inc(ARect.Left, Delta);
  2109.     DrawText(Node, ARect);
  2110.   end;
  2111.  
  2112.   procedure DrawTreePicture;
  2113.   var
  2114.     Style: TOutlineBitmap;
  2115.   begin
  2116.     DrawTree(ARect, Node);
  2117.     Inc(ARect.Left, DefaultRowHeight * (IndentLevel - 1) - Delta);
  2118.     if ooDrawTreeRoot in Options then Inc(ARect.Left, DefaultRowHeight);
  2119.     ARect.Left := ARect.Left + DefaultRowHeight;
  2120.     ARect.Right := ARect.Left + Delta;
  2121.     DrawFocusCell;
  2122.     DrawText(Node, ARect);
  2123.     Dec(ARect.Left, DefaultRowHeight - Delta);
  2124.     if HasChildren then
  2125.     begin
  2126.       if Expanded then Style := obOpen
  2127.       else Style := obClose;
  2128.     end
  2129.     else Style := obLeaf;
  2130.     Bitmap1 := GetBitmap(Style);
  2131.     DrawPictures([Bitmap1], ARect);
  2132.   end;
  2133.  
  2134. begin
  2135.   if FRootNode.List.Count = 0 then
  2136.   begin
  2137.     with Canvas do
  2138.     begin
  2139.       Brush.Color := Color;
  2140.       FillRect(ARect);
  2141.     end;
  2142.     Exit;
  2143.   end;
  2144.  
  2145.   if (Style = otOwnerDraw) and Assigned(FOnDrawItem) then
  2146.   begin
  2147.     if Row = ARow then
  2148.     begin
  2149.       if GetFocus = Self.Handle then
  2150.       begin
  2151.         FOnDrawItem(Self, ARow, ARect, [odFocused, odSelected]);
  2152.         if ooDrawFocusRect in Options then
  2153.           DrawFocusRect(Canvas.Handle, ARect);
  2154.       end
  2155.       else FOnDrawItem(Self, ARow, ARect, [odSelected])
  2156.     end
  2157.     else OnDrawItem(Self, ARow, ARect, []);
  2158.     Exit;
  2159.   end;
  2160.  
  2161.   InitialLeft := ARect.Left;
  2162.   Node := GetVisibleNode(ARow);
  2163.   Delta := (ARect.Bottom - ARect.Top - FFontSize) div 2;
  2164.  
  2165.   with Canvas do
  2166.   begin
  2167.     Font := Self.Font;
  2168.     Brush.Color := Color;
  2169.     FillRect(ARect);
  2170.     TextLength := TextWidth(Node.Text) + 1;
  2171.     if Row = ARow then
  2172.     begin
  2173.       Brush.Color := clHighlight;
  2174.       Font.Color := clHighlightText;
  2175.     end;
  2176.   end;
  2177.  
  2178.   Expanded := Node.Expanded;
  2179.   HasChildren := Node.HasItems;
  2180.   IndentLevel := Node.GetLevel;
  2181.   case OutlineStyle of
  2182.     osText: DrawTheText;
  2183.     osPlusMinusText: DrawPlusMinusText;
  2184.     osPlusMinusPictureText: DrawPlusMinusPicture;
  2185.     osPictureText: DrawPictureText;
  2186.     osTreeText: DrawTheTree;
  2187.     osTreePictureText: DrawTreePicture;
  2188.   end;
  2189.  
  2190.   if (Row = ARow) and (Node.Text <> '') then
  2191.   begin
  2192.     ARect.Left := InitialLeft + DefaultRowHeight * (IndentLevel - 1);
  2193.     if OutlineStyle >= osTreeText then
  2194.     begin
  2195.       Dec(ARect.Left, Delta);
  2196.       if ooDrawTreeRoot in Options then Inc(ARect.Left, DefaultRowHeight);
  2197.     end;
  2198.     if (OutlineStyle <> osText) and (OutlineStyle <> osTreeText) then
  2199.       Inc(ARect.Left, DefaultRowHeight);
  2200.     if OutlineStyle = osPlusMinusPictureText then
  2201.       Inc(ARect.Left, DefaultRowHeight);
  2202.     if (GetFocus = Self.Handle) and (ooDrawFocusRect in Options) then
  2203.       DrawFocusRect(Canvas.Handle, ARect);
  2204.   end;
  2205. end;
  2206.  
  2207. procedure TCustomOutline.DrawTree(ARect: TRect; Node: TOutlineNode);
  2208. var
  2209.   Offset: Word;
  2210.   Height: Word;
  2211.   OldPen: TPen;
  2212.   I: Integer;
  2213.   ParentNode: TOutlineNode;
  2214.   IndentLevel: Integer;
  2215. begin
  2216.   Offset := DefaultRowHeight div 2;
  2217.   Height := ARect.Bottom;
  2218.   IndentLevel := Node.GetLevel;
  2219.   I := IndentLevel - 3;
  2220.   if ooDrawTreeRoot in Options then Inc(I);
  2221.   OldPen := TPen.Create;
  2222.   try
  2223.     OldPen.Assign(Canvas.Pen);
  2224.     with Canvas do
  2225.     begin
  2226.       Pen.Color := clBlack;
  2227.       Pen.Width := 1;
  2228.       try
  2229.         ParentNode := Node.Parent;
  2230.         while (ParentNode.Parent <> nil) and
  2231.           ((ooDrawTreeRoot in Options) or
  2232.           (ParentNode.Parent.Parent <> nil)) do
  2233.         begin
  2234.           with ParentNode.Parent do
  2235.           begin
  2236.             if List.IndexOf(ParentNode) < List.Count - 1 then
  2237.             begin
  2238.               Canvas.MoveTo(ARect.Left + DefaultRowHeight * I + Offset, ARect.Top);
  2239.               Canvas.LineTo(ARect.Left + DefaultRowHeight * I + Offset, Height);
  2240.             end;
  2241.           end;
  2242.           ParentNode := ParentNode.Parent;
  2243.           Dec(I);
  2244.         end;
  2245.  
  2246.         with Node.Parent do
  2247.           if List.IndexOf(Node) = List.Count - 1 then
  2248.             Height := ARect.Top + Offset;
  2249.  
  2250.         if (ooDrawTreeRoot in Options) or (IndentLevel > 1) then
  2251.         begin
  2252.           if not (ooDrawTreeRoot in Options) then Dec(IndentLevel);
  2253.           with ARect do
  2254.           begin
  2255.             Inc(Left, DefaultRowHeight * (IndentLevel - 1));
  2256.             MoveTo(Left + Offset, Top);
  2257.             LineTo(Left + Offset, Height);
  2258.             MoveTo(Left + Offset, Top + Offset);
  2259.             LineTo(Left + Offset + FFontSize div 2, Top + Offset);
  2260.           end;
  2261.         end;
  2262.       finally
  2263.         Pen.Assign(OldPen);
  2264.       end;
  2265.     end;
  2266.   finally
  2267.     OldPen.Destroy;
  2268.   end;
  2269. end;
  2270.  
  2271. procedure TCustomOutline.DrawPictures(BitMaps: array of TBitmap; ARect: TRect);
  2272. var
  2273.   I: Word;
  2274.   Rect: TRect;
  2275.   Value: TBitmap;
  2276.   Offset: Word;
  2277.   Delta: Integer;
  2278.   OldTop: Integer;
  2279.   OldColor: TColor;
  2280. begin
  2281.   OldColor := Canvas.Brush.Color;
  2282.   Canvas.Brush.Color := Color;
  2283.   Offset := (DefaultRowHeight - FFontSize) div 2;
  2284.   Rect.Top := ARect.Top + Offset;
  2285.   Rect.Bottom := Rect.Top + FFontSize;
  2286.   for I := Low(Bitmaps) to High(Bitmaps) do
  2287.   begin
  2288.     Value := BitMaps[I];
  2289.     Rect.Left := ARect.Left + Offset - 1;
  2290.     Rect.Right := Rect.Left + FFontSize;
  2291.     Inc(ARect.Left, DefaultRowHeight);
  2292.     if Value <> nil then
  2293.     begin
  2294.       if not (ooStretchBitmaps in Options) then
  2295.       begin
  2296.         if Rect.Top + Value.Height < Rect.Bottom then
  2297.           Rect.Bottom := Rect.Top + Value.Height;
  2298.         if Rect.Left + Value.Width < Rect.Right then
  2299.           Rect.Right := Rect.Left + Value.Width;
  2300.         Delta := (FFontSize - (Rect.Bottom - Rect.Top)) div 2;
  2301.         if Delta > 0 then
  2302.         begin
  2303.           Delta := (DefaultRowHeight - (Rect.Bottom - Rect.Top)) div 2;
  2304.           OldTop := Rect.Top;
  2305.           Rect.Top := ARect.Top + Delta;
  2306.           Rect.Bottom := Rect.Bottom - OldTop + Rect.Top;
  2307.         end;
  2308.         Canvas.BrushCopy(Rect, Value,
  2309.           Bounds(0, 0, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top),
  2310.           Value.TransparentColor);
  2311.       end else
  2312.         Canvas.BrushCopy(Rect, Value,
  2313.           Bounds(0, 0, Value.Width, Value.Height),
  2314.           Value.TransparentColor);
  2315.     end;
  2316.   end;
  2317.   Canvas.Brush.Color := OldColor;
  2318. end;
  2319.  
  2320. procedure TCustomOutline.DrawText(Node: TOutlineNode; Rect: TRect);
  2321. begin
  2322.   Windows.DrawText(Canvas.Handle, PChar(Node.Text), Length(Node.Text), Rect,
  2323.     DT_LEFT or DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
  2324. end;
  2325.  
  2326. function TCustomOutline.StoreBitmap(Index: Integer): Boolean;
  2327. begin
  2328.   Result := TOutlineBitmap(Index) in FUserBitmaps;
  2329. end;
  2330.  
  2331. procedure TCustomOutline.ClearBitmap(var Bitmap: TBitmap; Kind: TOutlineBitmap);
  2332. begin
  2333.   if Bitmap <> nil then
  2334.   begin
  2335.     Bitmap.Free;
  2336.     Bitmap := nil;
  2337.   end;
  2338. end;
  2339.  
  2340. procedure TCustomOutline.ChangeBitmap(Value: TBitmap; Kind: TOutlineBitmap);
  2341. var
  2342.   Bitmap: ^TBitmap;
  2343. begin
  2344.   Bitmap := @FPictures[Ord(Kind)];
  2345.   Include(FUserBitmaps, Kind);
  2346.   if Value = nil then ClearBitmap(Bitmap^, Kind)
  2347.   else Bitmap^.Assign(Value);
  2348.   Invalidate;
  2349. end;
  2350.  
  2351. procedure TCustomOutline.SetPicture(Index: Integer; Value: TBitmap);
  2352. begin
  2353.   ChangeBitmap(Value, TOutlineBitmap(Index));
  2354. end;
  2355.  
  2356. function TCustomOutline.GetPicture(Index: Integer): TBitmap;
  2357. begin
  2358.   if csLoading in ComponentState then
  2359.     Include(FUserBitmaps, TOutlineBitmap(Index));
  2360.   Result := FPictures[Index];
  2361. end;
  2362.  
  2363. procedure TCustomOutline.LoadFromFile(const FileName: string);
  2364. var
  2365.   Stream: TStream;
  2366. begin
  2367.   Stream := TFileStream.Create(FileName, fmOpenRead);
  2368.   try
  2369.     LoadFromStream(Stream);
  2370.   finally
  2371.     Stream.Free;
  2372.   end;
  2373. end;
  2374.  
  2375. {procedure TCustomOutline.SetMaskColor(Value: TColor);
  2376. begin
  2377.   FMaskColor := Value;
  2378.   Invalidate;
  2379. end;}
  2380.  
  2381. procedure TCustomOutline.SetItemHeight(Value: Integer);
  2382. begin
  2383.   FItemHeight := Value;
  2384.   if Style <> otOwnerDraw then SetRowHeight
  2385.   else begin
  2386.     DefaultRowHeight := ItemHeight;
  2387.     FFontSize := MulDiv(ItemHeight, 100, 120);
  2388.     Invalidate;
  2389.   end;
  2390. end;
  2391.  
  2392. procedure TCustomOutline.SetStyle(Value: TOutlineType);
  2393. begin
  2394.   if Style <> Value then
  2395.   begin
  2396.     FStyle := Value;
  2397.     if Value = otStandard then SetRowHeight;
  2398.   end;
  2399. end;
  2400.  
  2401. procedure TCustomOutline.SetOutlineOptions(Value: TOutlineOptions);
  2402. begin
  2403.   if Value <> FOptions then
  2404.   begin
  2405.     FOptions := Value;
  2406.     Invalidate;
  2407.   end;
  2408. end;
  2409.  
  2410. function LineStart(Buffer, BufPos: PChar): PChar;
  2411. begin
  2412.   if BufPos - Buffer - 2 > 0 then
  2413.   begin
  2414.     Dec(BufPos, 2);
  2415.     while (BufPos^ <> #$0D) and (BufPos > Buffer) do Dec(BufPos);
  2416.     if BufPos > Buffer then
  2417.     begin
  2418.       Inc(BufPos);
  2419.       if BufPos^ = #$0A then Inc(BufPos);
  2420.     end;
  2421.     Result := BufPos;
  2422.   end
  2423.   else Result := Buffer;
  2424. end;
  2425.  
  2426. function GetString(BufPtr: PChar; var S: string): PChar;
  2427. var
  2428.   Start: PChar;
  2429. begin
  2430.   Start := BufPtr;
  2431.   while not (BufPtr^ in [#13, #26]) do Inc(BufPtr);
  2432.   SetString(S, Start, Integer(BufPtr - Start));
  2433.   if BufPtr^ = #13 then Inc(BufPtr);
  2434.   if BufPtr^ = #10 then Inc(BufPtr);
  2435.   Result := BufPtr;
  2436. end;
  2437.  
  2438. procedure TCustomOutline.LoadFromStream(Stream: TStream);
  2439. const
  2440.   EOF = Chr($1A);
  2441.   BufSize = 4096;
  2442. var
  2443.   Count: Integer;
  2444.   Buffer, BufPtr, BufEnd, BufTop: PChar;
  2445.   ParentNode, NewNode: TOutlineNode;
  2446.   Str: string;
  2447.   Level, OldLevel: Cardinal;
  2448.   I: Integer;
  2449. begin
  2450.   GetMem(Buffer, BufSize);
  2451.   try
  2452.     OldLevel := 0;
  2453.     Clear;
  2454.     ParentNode := FRootNode;
  2455.     BufEnd := Buffer + BufSize;
  2456.     BufTop := BufEnd;
  2457.     repeat
  2458.       Count := BufEnd - BufTop;
  2459.       if Count <> 0 then System.Move(BufTop[0], Buffer[0], Count);
  2460.       BufTop := Buffer + Count;
  2461.       Inc(BufTop, Stream.Read(BufTop[0], BufEnd - BufTop));
  2462.       if BufTop < BufEnd then BufTop[0] := EOF else
  2463.       begin
  2464.         BufTop := LineStart(Buffer, BufTop);
  2465.         if BufTop = Buffer then Error(SOutlineLongLine);
  2466.       end;
  2467.       BufPtr := Buffer;
  2468.       while (BufPtr < BufTop) and (BufPtr[0] <> EOF) do
  2469.       begin
  2470.         BufPtr := GetBufStart(BufPtr, Level);
  2471.         BufPtr := GetString(BufPtr, Str);
  2472.         NewNode := TOutlineNode.Create(Self);
  2473.         try
  2474.           NewNode.Text := Str;
  2475.           if (Level > OldLevel) or (ParentNode = FRootNode) then
  2476.           begin
  2477.             if Level - OldLevel > 1 then Error(SOutlineFileLoad);
  2478.           end
  2479.           else
  2480.           begin
  2481.             for I := OldLevel downto Level do
  2482.             begin
  2483.               ParentNode := ParentNode.Parent;
  2484.               if ParentNode = nil then Error(SOutlineFileLoad);
  2485.             end;
  2486.           end;
  2487.           ParentNode.List.Add(NewNode);
  2488.           NewNode.FParent := ParentNode;
  2489.           ParentNode := NewNode;
  2490.           OldLevel := Level;
  2491.         except
  2492.           NewNode.Free;
  2493.           Raise;
  2494.         end;
  2495.       end;
  2496.     until (BufPtr < BufEnd) and (BufPtr[0] = EOF);
  2497.   finally
  2498.     FreeMem(Buffer, BufSize);
  2499.     if not (csLoading in ComponentState) then Loaded;
  2500.   end;
  2501. end;
  2502.  
  2503. procedure TCustomOutline.Loaded;
  2504. var
  2505.   Item: TOutlineBitmap;
  2506. begin
  2507.   inherited Loaded;
  2508.   with FRootNode do
  2509.   begin
  2510.     FExpandCount := List.Count;
  2511.     Row := 0;
  2512.     ResetSelectedItem;
  2513.     if ResizeGrid then Invalidate;
  2514.     if List.Count > 0 then
  2515.     begin
  2516.       TOutlineNode(List.First).SetGoodIndex;
  2517.       FSelectedItem := List.First;
  2518.     end;
  2519.     if csDesigning in ComponentState then FullExpand;
  2520.   end;
  2521.   for Item := obPlus to obLeaf do
  2522.     if (Item in FOldBitmaps) and not (Item in FUserBitmaps) then
  2523.       ChangeBitmap(nil, Item);
  2524.   FOldBitmaps := [];
  2525.   SetHorzScrollBar;
  2526. end;
  2527.  
  2528. procedure TCustomOutline.SaveToFile(const FileName: string);
  2529. var
  2530.   Stream: TStream;
  2531. begin
  2532.   Stream := TFileStream.Create(FileName, fmCreate);
  2533.   try
  2534.     SaveToStream(Stream);
  2535.   finally
  2536.     Stream.Free;
  2537.   end;
  2538. end;
  2539.  
  2540. procedure TCustomOutline.SaveToStream(Stream: TStream);
  2541. const
  2542.   BufSize = 4096;
  2543. var
  2544.   Buffer: PChar;
  2545. begin
  2546.   GetMem(Buffer, BufSize);
  2547.   try
  2548.     FRootNode.WriteNode(Buffer, Stream);
  2549.   finally
  2550.     FreeMem(Buffer, BufSize);
  2551.   end;
  2552. end;
  2553.  
  2554. procedure TCustomOutline.SetStrings(Value: TStrings);
  2555. begin
  2556.   FStrings.Assign(Value);
  2557.   if csDesigning in ComponentState then FRootNode.FullExpand;
  2558.   SetHorzScrollBar;
  2559. end;
  2560.  
  2561. function TCustomOutline.GetStrings: TStrings;
  2562. begin
  2563.   Result := FStrings;
  2564. end;
  2565.  
  2566. procedure TCustomOutline.Error(const ErrorString: string);
  2567. begin
  2568.   Raise EOutlineError.Create(ErrorString);
  2569. end;
  2570.  
  2571. procedure TCustomOutline.Expand(Index: LongInt);
  2572. begin
  2573.   if Assigned(FOnExpand) then FOnExpand(Self, Index);
  2574. end;
  2575.  
  2576. procedure TCustomOutline.Collapse(Index: LongInt);
  2577. begin
  2578.   if Assigned(FOnCollapse) then FOnCollapse(Self, Index);
  2579. end;
  2580.  
  2581. end.
  2582.