outline.pas

这是不可多得的源代码

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 1995-2001 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit Outline deprecated;

{$R-,H+,X+}

interface

{$R *.res}

uses Windows, Messages, Forms, Classes, Graphics, Menus, StdCtrls, Grids,
  Controls, SysUtils;

type
  OutlineError = class(TObject); { Raised by GetNodeAtIndex }
  EOutlineError = class(Exception);
  TOutlineNodeCompare = (ocLess, ocSame, ocGreater, ocInvalid);
  TAttachMode = (oaAdd, oaAddChild, oaInsert);
  TChangeRange = -1..1;
  TCustomOutline = class;

{ TOutlineNode }

{ The TOutlineNode is an encapsulation of an outliner item.  Access
  to a TOutlineNode is via the container class TOutline.  Each
  TOutlineNode contains user defined text and data.
  An item is also capable of containing up to 16368 sub-items.
  TOutlineNodes are also persistent.

  A TOutlineNode item can be interrogated about its current state :
    Expanded
      Whether the node is open or closed.
    Index
      The current Index of the node.  This changes as items are inserted and
      deleted.  The index will range from 1..n
    Level
      The current depth of the node with 1 being the top level
    HasItems
      Whether the item contains items
    IsVisible
      Whether the item is capable of being displayed. This value is only
      True if all its parent items are visible
    TopItem
      Obtains the parent of the item that resides at level 1
    FullPath
      Returns the fully qualified name of the item starting from its
      level 1 parent.  Each item is separated by the separator string
      specified in the TOutline Container
    Text
      Used to set and get the items text value
    Data
      Used to get and set the items data }

  TOutlineNode = class(TPersistent)
  private
    FList: TList;
    FText: string;
    FData: Pointer;
    FParent: TOutlineNode;
    FIndex: LongInt;
    FState: Boolean;
    FOutline: TCustomOutline;
    FExpandCount: LongInt;
    procedure ChangeExpandedCount(Value: LongInt);
    procedure CloseNode;
    procedure Clear;
    procedure Error(const ErrorString: string);
    function GetExpandedNodeCount: LongInt;
    function GetFullPath: string;
    function GetIndex: LongInt;
    function GetLastIndex: LongInt;
    function GetLevel: Cardinal;
    function GetList: TList;
    function GetMaxDisplayWidth(Value: Cardinal): Cardinal;
    function GetNode(Index: LongInt): TOutlineNode;
    function GetTopItem: Longint;
    function GetVisibleParent: TOutlineNode;
    function HasChildren: Boolean;
    function HasVisibleParent: Boolean;
    function IsEqual(Value: TOutlineNode): Boolean;
    procedure ReIndex(StartNode, EndNode: TOutlineNode; NewIndex: LongInt;
      IncludeStart: Boolean);
    procedure Repaint;
    function Resync(var NewIndex: LongInt; EndNode: TOutlineNode): Boolean;
    procedure SetExpandedState(Value: Boolean);
    procedure SetGoodIndex;
    procedure SetHorzScrollBar;
    procedure SetLevel(Level: Cardinal);
    procedure SetText(const Value: string);
  protected
    function GetVisibleNode(TargetCount: LongInt): TOutlineNode;
    function AddNode(Value: TOutlineNode): LongInt;
    function InsertNode(Index: LongInt; Value: TOutlineNode): LongInt;
    function GetNodeAtIndex(TargetIndex: LongInt): TOutlineNode;
    function GetDataItem(Value: Pointer): LongInt;
    function GetTextItem(const Value: string): LongInt;
    function HasAsParent(Value: TOutlineNode): Boolean;
    function GetRowOfNode(TargetNode: TOutlineNode;
      var RowCount: Longint): Boolean;
    procedure InternalRemove(Value: TOutlineNode; Index: Integer);
    procedure Remove(Value: TOutlineNode);
    procedure WriteNode(Buffer: PChar; Stream: TStream);
    property Outline: TCustomOutline read FOutline;
    property List: TList read GetList;
    property ExpandCount: LongInt read FExpandCount;
    property Items[Index: LongInt]: TOutlineNode read GetNode; default;
  public
    constructor Create(AOwner: TCustomOutline);
    destructor Destroy; override;
    procedure ChangeLevelBy(Value: TChangeRange);
    procedure Collapse;
    procedure Expand;
    procedure FullExpand;
    function GetDisplayWidth: Integer;
    function getFirstChild: LongInt;
    function GetLastChild: LongInt;
    function GetNextChild(Value: LongInt): LongInt;
    function GetPrevChild(Value: LongInt): LongInt;
    procedure MoveTo(Destination: LongInt; AttachMode: TAttachMode);
    property Parent: TOutlineNode read FParent;
    property Expanded: Boolean read FState write SetExpandedState;
    property Text: string read FText write SetText;
    property Data: Pointer read FData write FData;
    property Index: LongInt read GetIndex;
    property Level: Cardinal read GetLevel write SetLevel;
    property HasItems: Boolean read HasChildren;
    property IsVisible: Boolean read HasVisibleParent;
    property TopItem: Longint read GetTopItem;
    property FullPath: string read GetFullPath;
  end;

{ TCustomOutline }

{ The TCustomOutline object is a container class for TOutlineNodes.
  All TOutlineNodes contained within a TOutline are presented
  to the user as a flat array of TOutlineNodes, with a parent
  TOutlineNode containing an index value that is one less than
  its first child (if it has any children).

  Interaction with a TOutlineNode is typically accomplished through
  the TCustomOutline using the following properties:
    CurItem
      Reads and writes the current item
    ItemCount
      Returns the total number of TOutlineNodes with the TCustomOutline.
      Note this can be computationally expensive as all indexes will
      be forced to be updated!!
    Items
      Allows Linear indexing into the hierarchical list of TOutlineNodes
    SelectedItem
      Returns the Index of the TOutlineNode which has the focus or 0 if
      no TOutlineNode has been selected

  The TCustomOutline has a number of properties which will affect all
  TOutlineNodes owned by the TCustomOutline:
    OutlineStyle
      Sets the visual style of the outliner
    ItemSeparator
      Sets the delimiting string for all TOutlineNodes
    PicturePlus, PictureMinus, PictureOpen, PictureClosed, PictureLeaf
      Sets custom bitmaps for these items }

  TBitmapArrayRange = 0..4;
  EOutlineChange = procedure (Sender: TObject; Index: LongInt) of object;
  TOutlineStyle = (osText, osPlusMinusText, osPictureText,
    osPlusMinusPictureText, osTreeText, osTreePictureText);
  TOutlineBitmap = (obPlus, obMinus, obOpen, obClose, obLeaf);
  TOutlineBitmaps = set of TOutlineBitmap;
  TBitmapArray = array[TBitmapArrayRange] of TBitmap;
  TOutlineType = (otStandard, otOwnerDraw);
  TOutlineOption = (ooDrawTreeRoot, ooDrawFocusRect, ooStretchBitmaps);
  TOutlineOptions = set of TOutlineOption;


  TCustomOutline = class(TCustomGrid)
  private
    FBlockInsert: Boolean;
    FRootNode: TOutlineNode;
    FGoodNode: TOutlineNode;
    UpdateCount: Integer;
    FCurItem: TOutlineNode;
    FSeparator: string;
    FFontSize: Integer;
    FStrings: TStrings;
    FUserBitmaps: TOutlineBitmaps;
    FOldBitmaps: TOutlineBitmaps;
    FPictures: TBitmapArray;
    FOnExpand: EOutlineChange;
    FOnCollapse: EOutlineChange;
    FOutlineStyle: TOutlineStyle;
//    FMaskColor: TColor;
    FItemHeight: Integer;
    FStyle: TOutlineType;
    FOptions: TOutlineOptions;
    FIgnoreScrollResize: Boolean;
    FSelectedItem: TOutlineNode;
    FOnDrawItem: TDrawItemEvent;
    FSettingWidth: Boolean;
    FSettingHeight: Boolean;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    function GetItemCount: LongInt;
    function AttachNode(Index: LongInt; Str: string;
      Ptr: Pointer; AttachMode: TAttachMode): LongInt;
    function Get(Index: LongInt): TOutlineNode;
    function GetSelectedItem: LongInt;
    procedure SetSelectedItem(Value: Longint);
    function CompareNodes(Value1, Value2: TOutlineNode): TOutlineNodeCompare;
    procedure Error(const ErrorString: string);
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    function ResizeGrid: Boolean;
    procedure DoExpand(Node: TOutlineNode);
    procedure Init;
    procedure MoveNode(Destination, Source: LongInt;
      AttachMode: TAttachMode);
    procedure ClearBitmap(var Bitmap: TBitmap; Kind: TOutlineBitmap);
    procedure ChangeBitmap(Value: TBitmap; Kind: TOutlineBitmap);
    procedure SetRowHeight;
    procedure SetCurItem(Value: LongInt);
    procedure CreateGlyph;
    procedure SetStrings(Value: TStrings);
    function GetStrings: TStrings;
    function IsCurItem(Value: LongInt): Boolean;
    procedure SetPicture(Index: Integer; Value: TBitmap);
    function GetPicture(Index: Integer): TBitmap;
    procedure DrawPictures(BitMaps: array of TBitmap; ARect: TRect);
    procedure DrawText(Node: TOutlineNode; Rect: TRect);
    procedure SetOutlineStyle(Value: TOutlineStyle);
    procedure DrawTree(ARect: TRect; Node: TOutlineNode);
//    procedure SetMaskColor(Value: TColor);
    procedure SetItemHeight(Value: Integer);
    procedure SetStyle(Value: TOutlineType);
    procedure SetOutlineOptions(Value: TOutlineOptions);
    function StoreBitmap(Index: Integer): Boolean;
    procedure ReadBinaryData(Stream: TStream);
    procedure WriteBinaryData(Stream: TStream);
    procedure SetHorzScrollBar;
    procedure ResetSelectedItem;
    procedure SetRowFromNode(Node: TOutlineNode);
  protected
    procedure Loaded; override;
    procedure Click; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    function SetGoodIndex(Value: TOutlineNode): TOutlineNode;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
    procedure DblClick; override;
    procedure SetLevel(Node: TOutlineNode; CurLevel, NewLevel: Cardinal);
    function BadIndex(Value: TOutlineNode): Boolean;
    procedure DeleteNode(Node: TOutlineNode; CurIndex: LongInt);
    procedure Expand(Index: LongInt); dynamic;
    procedure Collapse(Index: LongInt); dynamic;
    procedure DefineProperties(Filer: TFiler); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Move(Destination, Source: LongInt; AttachMode: TAttachMode);
    procedure SetDisplayWidth(Value: Integer);
    property Lines: TStrings read GetStrings write SetStrings;
    property OutlineStyle: TOutlineStyle read FOutlineStyle write SetOutlineStyle default osTreePictureText;
    property OnExpand: EOutlineChange read FOnExpand write FOnExpand;
    property OnCollapse: EOutlineChange read FOnCollapse write FOnCollapse;
    property Options: TOutlineOptions read FOptions write SetOutlineOptions
      default [ooDrawTreeRoot, ooDrawFocusRect];
    property Style: TOutlineType read FStyle write SetStyle default otStandard;
    property ItemHeight: Integer read FItemHeight write SetItemHeight;
    property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property ItemSeparator: string read FSeparator write FSeparator;
    property PicturePlus: TBitmap index 0 read GetPicture write SetPicture stored StoreBitmap;
    property PictureMinus: TBitmap index 1 read GetPicture write SetPicture stored StoreBitmap;
    property PictureOpen: TBitmap index 2 read GetPicture write SetPicture stored StoreBitmap;
    property PictureClosed: TBitmap index 3 read GetPicture write SetPicture stored StoreBitmap;
    property PictureLeaf: TBitmap index 4 read GetPicture write SetPicture stored StoreBitmap;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Add(Index: LongInt; const Text: string): LongInt;
    function AddChild(Index: LongInt; const Text: string): LongInt;
    function AddChildObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
    function AddObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
    function Insert(Index: LongInt; const Text: string): LongInt;
    function InsertObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
    procedure Delete(Index: LongInt);
    function GetDataItem(Value: Pointer): Longint;
    function GetItem(X, Y: Integer): LongInt;
    function GetNodeDisplayWidth(Node: TOutlineNode): Integer;
    function GetTextItem(const Value: string): Longint;
    function GetVisibleNode(Index: LongInt): TOutlineNode;
    procedure FullExpand;
    procedure FullCollapse;
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure SetUpdateState(Value: Boolean);
    procedure Clear;
    property ItemCount: LongInt read GetItemCount;
    property Items[Index: LongInt]: TOutlineNode read Get; default;
    property SelectedItem: Longint read GetSelectedItem write SetSelectedItem;
    property Row;
    property Canvas;
  end;

  TOutline = class(TCustomOutline)
  published
    property Lines;
    property OutlineStyle;
    property OnExpand;
    property OnCollapse;
    property Options;
    property Style;
    property ItemHeight;
    property OnDrawItem;
    property Align;
    property Enabled;
    property Font;
    property Color;
    property ParentColor;
    property ParentCtl3D;
    property Ctl3D;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property DragMode;
    property DragKind;
    property DragCursor;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnStartDock;
    property OnStartDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property BorderStyle;
    property ItemSeparator;
    property PicturePlus;
    property PictureMinus;
    property PictureOpen;
    property PictureClosed;
    property PictureLeaf;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property PopupMenu;
    property ScrollBars;
    property OnContextPopup;
  end;

implementation

uses Consts;

const
  MaxLevels = 255;
  TAB = Chr(9);
  InvalidIndex = -1;
  BitmapWidth = 14;
  BitmapHeight = 14;

type

{ TOutlineStrings }

  TOutlineStrings = class(TStrings)
  private
    Outline: TCustomOutline;
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
  public
    function Add(const S: string): Integer; override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    function GetObject(Index: Integer): TObject; override;
  end;

function GetBufStart(Buffer: PChar; var Level: Cardinal): PChar;
begin
  Level := 0;
  while Buffer^ in [' ', #9] do
  begin
    Inc(Buffer);
    Inc(Level);
  end;
  Result := Buffer;
end;

function PutString(BufPtr: PChar; const S: string): PChar;
var
  I: Integer;
begin
  for I := 1 to Length(S) do
  begin
    BufPtr^ := S[I];
    Inc(BufPtr);
  end;
  Word(Pointer(BufPtr)^) := $0A0D;
  Inc(BufPtr, 2);
  Result := BufPtr;
end;


{TOutlineNode}

constructor TOutlineNode.Create(AOwner: TCustomOutline);
begin
  FOutline := AOwner;
end;

destructor TOutlineNode.Destroy;
var
  CurIndex: LongInt;
  LastNode: Boolean;
begin
  with Outline do
    if FRootNode = Self then FIgnoreScrollResize := True;
  try
    CurIndex := 0;
    if Parent <> nil then CurIndex := Outline.FCurItem.Index;
    if FList <> nil then Clear;
    if Outline.FSelectedItem = Self then Outline.ResetSelectedItem;
    if Parent <> nil then
    begin
      LastNode := Parent.List.Last = Self;
      Parent.Remove(Self);
      if Parent.List.Count = 0 then
        Outline.SetRowFromNode(Parent)
      else if LastNode then
        Outline.SetRowFromNode(TOutlineNode(Parent.List.Last));
      Outline.DeleteNode(Self, CurIndex);
    end;
  finally
    with Outline do
      if FRootNode = Self then FIgnoreScrollResize := False;
  end;
  inherited Destroy;
end;

procedure TOutlineNode.Clear;
var
  I: Integer;
  Node: TOutlineNode;
begin
  for I := 0 to FList.Count - 1 do
  begin
    Node := FList.Items[I];
    Node.FParent := nil;
    Node.Destroy;
  end;
  FList.Free;
  FList := nil;
end;

procedure TOutlineNode.SetHorzScrollBar;
begin
  if (Parent <> nil) and Parent.Expanded then
    Outline.SetHorzScrollBar;
end;

function TOutlineNode.GetList: TList;
begin
  if FList = nil then FList := TList.Create;