simplegraph.pas

矢量绘图组件（开源版）

{------------------------------------------------------------------------------}
{                                                                              }
{  TSimpleGraph v2.61                                                          }
{  by Kambiz R. Khojasteh                                                      }
{                                                                              }
{  [e-mail]                                                       }
{  http://www.delphiarea.com                                                   }
{                                                                              }
{------------------------------------------------------------------------------}

{$I DELPHIAREA.INC}

unit SimpleGraph;

interface

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

const
  // Custom Cursors
  crHandFlat  = 51;
  crHandGrab  = 52;
  crHandPnt   = 53;
  crXHair1    = 54;
  crXHair2    = 55;
  crXHair3    = 56;
  crXHairLink = 57;

const
  // Default Graph Hit Test Flags
  GHT_NOWHERE       = $00000000;
  GHT_TRANSPARENT   = $00000001;
  GHT_LEFT          = $00000002;
  GHT_TOP           = $00000004;
  GHT_RIGHT         = $00000008;
  GHT_BOTTOM        = $00000010;
  GHT_TOPLEFT       = $00000020;
  GHT_TOPRIGHT      = $00000040;
  GHT_BOTTOMLEFT    = $00000080;
  GHT_BOTTOMRIGHT   = $00000100;
  GHT_CLIENT        = $00000200;
  GHT_CAPTION       = $00000400;
  GHT_POINT         = $00000800;  // High word contains the point's index
  GHT_LINE          = $00001000;  // High word contains the line's index

const
  GHT_BODY_MASK     = GHT_CLIENT or GHT_CAPTION;
  GHT_SIDES_MASK    = GHT_LEFT or GHT_TOP or GHT_RIGHT or GHT_BOTTOM or
                      GHT_TOPLEFT or GHT_TOPRIGHT or GHT_BOTTOMLEFT or
                      GHT_BOTTOMRIGHT;

type

  TSimpleGraph = class;
  TGraphObject = class;
  TGraphLink = class;
  TGraphNode = class;

  TPoints = array of TPoint;

  EGraphStreamError      = class(EStreamError);
  EGraphInvalidOperation = class(EInvalidOperation);
  EPointListError        = class(EListError);

  { TGraphScrollBar -- for internal use only }

  TGraphScrollBar = class(TPersistent)
  private
    fOwner: TSimpleGraph;
    fIncrement: TScrollBarInc;
    fPageIncrement: TScrollBarInc;
    fPosition: Integer;
    fRange: Integer;
    fCalcRange: Integer;
    fKind: TScrollBarKind;
    fMargin: Word;
    fVisible: Boolean;
    fTracking: Boolean;
    fSmooth: Boolean;
    fDelay: Integer;
    fButtonSize: Integer;
    fColor: TColor;
    fParentColor: Boolean;
    fSize: Integer;
    fStyle: TScrollBarStyle;
    fThumbSize: Integer;
    fPageDiv: Integer;
    fLineDiv: Integer;
    fUpdateNeeded: Boolean;
    procedure DoSetRange(Value: Integer);
    function GetScrollPos: Integer;
    procedure SetButtonSize(Value: Integer);
    procedure SetColor(Value: TColor);
    procedure SetParentColor(Value: Boolean);
    procedure SetPosition(Value: Integer);
    procedure SetSize(Value: Integer);
    procedure SetStyle(Value: TScrollBarStyle);
    procedure SetThumbSize(Value: Integer);
    procedure SetVisible(Value: Boolean);
    function IsIncrementStored: Boolean;
  protected
    constructor Create(AOwner: TSimpleGraph; AKind: TScrollBarKind);
    function ControlSize(ControlSB, AssumeSB: Boolean): Integer;
    procedure CalcAutoRange;
    procedure Update(ControlSB, AssumeSB: Boolean);
    function NeedsScrollBarVisible: Boolean;
    procedure ScrollMessage(var Msg: TWMScroll);
  public
    procedure Assign(Source: TPersistent); override;
    procedure ChangeBiDiPosition;
    property Kind: TScrollBarKind read fKind;
    function IsScrollBarVisible: Boolean;
    property ScrollPos: Integer read GetScrollPos;
    property Range: Integer read fRange;
    property Owner: TSimpleGraph read fOwner;
  published
    property ButtonSize: Integer read fButtonSize write SetButtonSize default 0;
    property Color: TColor read fColor write SetColor default clBtnHighlight;
    property Increment: TScrollBarInc read fIncrement write fIncrement stored IsIncrementStored default 8;
    property Margin: Word read fMargin write fMargin default 0;
    property ParentColor: Boolean read fParentColor write SetParentColor default True;
    property Position: Integer read fPosition write SetPosition default 0;
    property Smooth: Boolean read fSmooth write fSmooth default False;
    property Size: Integer read fSize write SetSize default 0;
    property Style: TScrollBarStyle read fStyle write SetStyle default ssRegular;
    property ThumbSize: Integer read fThumbSize write SetThumbSize default 0;
    property Tracking: Boolean read fTracking write fTracking default False;
    property Visible: Boolean read fVisible write SetVisible default True;
  end;

  { TGraphStreamableObject -- for internal use only }

  TGraphStreamableObject = class(TComponent)
  private
    fID: DWORD;
    fG: TGraphObject;
    fDummy: Integer;
  published
    property ID: DWORD read fID write fID;
    property G: TGraphObject read fG write fG stored True;
    property Left: Integer read fDummy write fDummy stored False;
    property Top: Integer read fDummy write fDummy stored False;
    property Tag stored False;
    property Name stored False;
  end;

  { TMemoryHandleStream }

  TMemoryHandleStream = class(TMemoryStream)
  private
    fHandle: THandle;
    fReleaseHandle: Boolean;
  protected
    function Realloc(var NewCapacity: Longint): Pointer; override;
  public
    constructor Create(MemHandle: THandle); virtual;
    destructor Destroy; override;
    property Handle: THandle read fHandle;
    property ReleaseHandle: Boolean read fReleaseHandle write fReleaseHandle;
  end;

  { TCanvasRecall }

  TCanvasRecall = class(TObject)
  private
    fPen: TPen;
    fFont: TFont;
    fBrush: TBrush;
    fCopyMode: TCopyMode;
    fTextFlags: Integer;
    fReference: TCanvas;
    procedure SetReference(Value: TCanvas);
  public
    constructor Create(AReference: TCanvas);
    destructor Destroy; override;
    procedure Store;
    procedure Retrieve;
    property Reference: TCanvas read fReference write SetReference;
  end;

  { TCompatibleCanvas }

  TCompatibleCanvas = class(TCanvas)
  public
    constructor Create;
    destructor Destroy; override;
  end;

  { TGraphObjectList }

  TGraphObjectListAction = (glAdded, glRemoved, glReordered);

  TGraphObjectListEvent = procedure(Sender: TObject; GraphObject: TGraphObject;
    Action: TGraphObjectListAction) of object;

  TGraphObjectList = class(TPersistent)
  private
    fItems: array of TGraphObject;
    fCount: Integer;
    fCapacity: Integer;
    fOnChange: TGraphObjectListEvent;
    EnumIndex: Integer;
    EnumDir: Integer;
    procedure SetCapacity(Value: Integer);
    function GetItems(Index: Integer): TGraphObject;
  protected
    procedure Grow;
    function Replace(OldItem, NewItem: TGraphObject): Integer;
    procedure NotifyAction(Item: TGraphObject; Action: TGraphObjectListAction); virtual;
  public
    destructor Destroy; override;
    procedure Clear;
    procedure Assign(Source: TPersistent); override;
    function Add(Item: TGraphObject): Integer;
    procedure Insert(Index: Integer; Item: TGraphObject);
    procedure Delete(Index: Integer);
    function Remove(Item: TGraphObject): Integer;
    procedure Move(CurIndex, NewIndex: Integer);
    function IndexOf(Item: TGraphObject): Integer;
    function First: TGraphObject;
    function Prior: TGraphObject;
    function Next: TGraphObject;
    function Last: TGraphObject;
    property Count: Integer read fCount;
    property Capacity: Integer read fCapacity write SetCapacity;
    property Items[Index: Integer]: TGraphObject read GetItems; default;
    property OnChange: TGraphObjectListEvent read fOnChange write fOnChange;
  end;

  { TGraphObject }

  TGraphObjectState = (osCreating, osDestroying, osLoading, osReading, osWriting,
    osUpdating, osDragging, osDragDisabled, osConverting);
  TGraphObjectStates = set of TGraphObjectState;

  TGraphChangeFlag = (gcView, gcData, gcText, gcPlacement, gcDependency);
  TGraphChangeFlags = set of TGraphChangeFlag;

  TGraphDependencyChangeFlag = (gdcChanged, gdcRemoved);

  TGraphObjectOption = (goLinkable, goSelectable, goShowCaption);
  TGraphObjectOptions = set of TGraphObjectOption;

  TObjectSide = (osLeft, osTop, osRight, osBottom);
  TObjectSides = set of TObjectSide;

  TGraphObjectClass = class of TGraphObject;

  TGraphObject = class(TPersistent)
  private
    fID: DWORD;
    fOwner: TSimpleGraph;
    fBrush: TBrush;
    fPen: TPen;
    fText: String;
    fHint: String;
    fFont: TFont;
    fParentFont: Boolean;
    fOptions: TGraphObjectOptions;
    fVisible: Boolean;
    fSelected: Boolean;
    fStates: TGraphObjectStates;
    fDependentList: TGraphObjectList;
    fLinkInputList: TGraphObjectList;
    fLinkOutputList: TGraphObjectList;
    fTextToShow: String;
    fTag: Integer;
    fData: Pointer;
    fHasCustomData: Boolean;
    fVisualRect: TRect;
    fVisualRectFlags: TGraphChangeFlags;
    UpdateCount: Integer;
    PendingChanges: TGraphChangeFlags;
    DragDisableCount: Integer;
    procedure SetBrush(Value: TBrush);
    procedure SetPen(Value: TPen);
    procedure SetText(const Value: String);
    procedure SetHint(const Value: String);
    procedure SetFont(Value: TFont);
    procedure SetParentFont(Value: Boolean);
    procedure SetVisible(Value: Boolean);
    procedure SetSelected(Value: Boolean);
    function GetZOrder: Integer;
    procedure SetZOrder(Value: Integer);
    procedure SetOptions(Value: TGraphObjectOptions);
    procedure SetHasCustomData(Value: Boolean);
    function GetShowing: Boolean;
    function GetDragging: Boolean;
    function GetDependents(Index: Integer): TGraphObject;
    function GetDependentCount: Integer;