simplegraph.pas

矢量绘图组件（开源版）

    fRegion: HRGN;
    fTextRect: TRect;
    procedure SetLeft(Value: Integer);
    procedure SetTop(Value: Integer);
    procedure SetWidth(Value: Integer);
    procedure SetHeight(Value: Integer);
    procedure SetAlignment(Value: TAlignment);
    procedure SetLayout(Value: TTextLayout);
    procedure SetMargin(Value: Integer);
    procedure SetNodeOptions(Value: TGraphNodeOptions);
    procedure SetBackground(Value: TPicture);
    procedure SetBackgroundMargins(const Value: TRect);
    procedure BackgroundChanged(Sender: TObject);
    procedure ReadBackgroundMargins(Reader: TReader);
    procedure WriteBackgroundMargins(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure Initialize; override;
    function FixHookAnchor: TPoint; override;
    function RelativeHookAnchor(RefPt: TPoint): TPoint; override;
    function LinkIntersect(const LinkPt: TPoint; const LinkAngle: Double): TPoints; virtual; abstract;
    procedure BoundsChanged(dX, dY, dCX, dCY: Integer); override;
    function UpdateTextPlacement(Recalc: Boolean; dX, dY: Integer): Boolean; override;
    procedure QueryMaxTextRect(out Rect: TRect); virtual;
    procedure QueryTextRect(out Rect: TRect); virtual;
    function CreateRegion: HRGN; virtual; abstract;
    function CreateClipRgn(Canvas: TCanvas): HRGN; virtual;
    procedure QueryVisualRect(out Rect: TRect); override;
    function QueryHitTest(const Pt: TPoint): DWORD; override;
    function QueryCursor(HT: DWORD): TCursor; override;
    function QueryMobility(HT: DWORD): TObjectSides; override;
    function OffsetHitTest(HT: DWORD; dX, dY: Integer): Boolean; override;
    procedure SnapHitTestOffset(HT: DWORD; var dX, dY: Integer); override;
    function BeginFollowDrag(HT: DWORD): Boolean; override;
    procedure MoveBy(dX, dY: Integer); override;
    procedure DrawControlPoints(Canvas: TCanvas); override;
    procedure DrawHighlight(Canvas: TCanvas); override;
    procedure DrawText(Canvas: TCanvas); override;
    procedure DrawBackground(Canvas: TCanvas); virtual;
    procedure DrawBorder(Canvas: TCanvas); virtual; abstract;
    procedure DrawBody(Canvas: TCanvas); override;
    procedure SetBoundsRect(const Rect: TRect); override;
    function GetBoundsRect: TRect; override;
    function GetCenter: TPoint; virtual;
  protected
    property Region: HRGN read fRegion;
    property TextRect: TRect read fTextRect;
  public
    constructor Create(AOwner: TSimpleGraph); override;
    constructor CreateNew(AOwner: TSimpleGraph; const Bounds: TRect); virtual;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function ContainsRect(const Rect: TRect): Boolean; override;
    procedure CanMoveResize(var NewLeft, NewTop, NewWidth, NewHeight: Integer;
      out CanMove, CanResize: Boolean); virtual;
    procedure SetBounds(aLeft, aTop, aWidth, aHeight: Integer); virtual;
    property Center: TPoint read GetCenter;
    property BackgroundMargins: TRect read fBackgroundMargins write SetBackgroundMargins;
  published
    property Left: Integer read fLeft write SetLeft;
    property Top: Integer read fTop write SetTop;
    property Width: Integer read fWidth write SetWidth;
    property Height: Integer read fHeight write SetHeight;
    property Alignment: TAlignment read fAlignment write SetAlignment default taCenter;
    property Layout: TTextLayout read fLayout write SetLayout default tlCenter;
    property Margin: Integer read fMargin write SetMargin default 8;
    property Background: TPicture read fBackground write SetBackground;
    property NodeOptions: TGraphNodeOptions read fNodeOptions write SetNodeOptions
      default [gnoMovable, gnoResizable, gnoShowBackground];
  end;

  { TPolygonalNode }

  TPolygonalNode = class(TGraphNode)
  private
    fVertices: TPoints;
  protected
    procedure Initialize; override;
    procedure BoundsChanged(dX, dY, dCX, dCY: Integer); override;
    function GetCenter: TPoint; override;
    function CreateRegion: HRGN; override;
    procedure DrawBorder(Canvas: TCanvas); override;
    function LinkIntersect(const LinkPt: TPoint; const LinkAngle: Double): TPoints; override;
    procedure DefineVertices(const ARect: TRect; var Points: TPoints); virtual; abstract;
  public
    destructor Destroy; override;
    property Vertices: TPoints read fVertices;
  end;

  { TRoundRectangularNode }

  TRoundRectangularNode = class(TGraphNode)
  protected
    function CreateRegion: HRGN; override;
    procedure DrawBorder(Canvas: TCanvas); override;
    function LinkIntersect(const LinkPt: TPoint; const LinkAngle: Double): TPoints; override;
  end;

  { TEllipticNode }

  TEllipticNode = class(TGraphNode)
  protected
    function CreateRegion: HRGN; override;
    procedure DrawBorder(Canvas: TCanvas); override;
    function LinkIntersect(const LinkPt: TPoint; const LinkAngle: Double): TPoints; override;
  end;

  { TTriangularNode }

  TTriangularNode = class(TPolygonalNode)
  protected
    procedure QueryMaxTextRect(out Rect: TRect); override;
    procedure DefineVertices(const ARect: TRect; var Points: TPoints); override;
  end;

  { TRectangularNode }

  TRectangularNode = class(TPolygonalNode)
  protected
    procedure DefineVertices(const ARect: TRect; var Points: TPoints); override;
  end;

  { TRhomboidalNode }

  TRhomboidalNode = class(TPolygonalNode)
  protected
    procedure QueryMaxTextRect(out Rect: TRect); override;
    procedure DefineVertices(const ARect: TRect; var Points: TPoints); override;
  end;

  { TPentagonalNode }

  TPentagonalNode = class(TPolygonalNode)
  protected
    procedure QueryMaxTextRect(out Rect: TRect); override;
    procedure DefineVertices(const ARect: TRect; var Points: TPoints); override;
  end;

  { THexagonalNode }

  THexagonalNode = class(TPolygonalNode)
  protected
    procedure QueryMaxTextRect(out Rect: TRect); override;
    procedure DefineVertices(const ARect: TRect; var Points: TPoints); override;
  end;

  { TGraphConstraints }

  TGraphConstraints = class(TPersistent)
  private
    fOwner: TSimpleGraph;
    fBoundsRect: TRect;
    fSourceRect: TRect;
    fOnChange: TNotifyEvent;
    procedure SetBoundsRect(const Rect: TRect);
    function GetField(Index: Integer): Integer;
    procedure SetField(Index: Integer; Value: Integer);
  protected
    function GetOwner: TPersistent; override;
    procedure DoChange; virtual;
  public
    constructor Create(AOwner: TSimpleGraph);
    procedure Assign(Source: TPersistent); override;
    procedure SetBounds(aLeft, aTop, aWidth, aHeight: Integer);
    function WithinBounds(const Pts: array of TPoint): Boolean;
    function ConfinePt(var Pt: TPoint): Boolean;
    function ConfineRect(var Rect: TRect): Boolean;
    function ConfineOffset(var dX, dY: Integer; Mobility: TObjectSides): Boolean;
    property Owner: TSimpleGraph read fOwner;
    property BoundsRect: TRect read fBoundsRect write SetBoundsRect;
    property SourceRect: TRect read fSourceRect write fSourceRect;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  published
    property MinLeft: Integer index 0 read GetField write SetField default 0;
    property MinTop: Integer index 1 read GetField write SetField default 0;
    property MaxRight: Integer index 2 read GetField write SetField default $0000FFFF;
    property MaxBottom: Integer index 3 read GetField write SetField default $0000FFFF;
  end;

  { TSimpleGraph }

  TGraphNodeClass = class of TGraphNode;
  TGraphLinkClass = class of TGraphLink;

  TGridSize = 4..128;
  TMarkerSize = 3..9;
  TZoom = 5..36863;

  TGraphBoundsKind = (bkGraph, bkSelected, bkDragging);

  TGraphCommandMode = (cmViewOnly, cmPan, cmEdit, cmInsertNode, cmInsertLink);

  TGraphDrawOrder = (doDefault, doNodesOnTop, doLinksOnTop);

  TGraphClipboardFormat = (cfNative, cfMetafile, cfBitmap);
  TGraphClipboardFormats = set of TGraphClipboardFormat;

  TGraphZoomOrigin = (zoTopLeft, zoCenter, zoCursor, zoCursorCenter);

  THAlignOption = (haNoChange, haLeft, haCenter, haRight, haSpaceEqually);
  TVAlignOption = (vaNoChange, vaTop, vaCenter, vaBottom, vaSpaceEqually);

  TResizeOption = (roNoChange, roSmallest, roLargest);

  TGraphNotifyEvent = procedure(Graph: TSimpleGraph;
    GraphObject: TGraphObject) of object;
  TGraphContextPopupEvent = procedure(Graph: TSimpleGraph; GraphObject: TGraphObject;
    const MousePos: TPoint; var Handled: Boolean) of object;
  TGraphDrawEvent = procedure(Graph: TSimpleGraph; Canvas: TCanvas) of object;
  TGraphObjectDrawEvent = procedure(Graph: TSimpleGraph; GraphObject: TGraphObject;
    Canvas: TCanvas) of object;
  TGraphInfoTipEvent = procedure(Graph: TSimpleGraph; GraphObject: TGraphObject;
    var InfoTip: String) of object;
  TGraphHookEvent = procedure(Graph: TSimpleGraph; GraphObject: TGraphObject;
    Link: TGraphLink; Index: Integer) of object;
  TGraphCanHookEvent = procedure(Graph: TSimpleGraph; GraphObject: TGraphObject;
    Link: TGraphLink; Index: Integer; var CanHook: Boolean) of object;
  TGraphCanLinkEvent = procedure(Graph: TSimpleGraph; Link: TGraphLink;
    Source, Target: TGraphObject; var CanLink: Boolean) of object;
  TCanMoveResizeNodeEvent = procedure(Graph: TSimpleGraph; Node: TGraphNode;
    var NewLeft, NewTop, NewWidth, NewHeight: Integer;
    var CanMove, CanResize: Boolean) of object;
  TGraphNodeResizeEvent = procedure(Graph: TSimpleGraph; Node: TGraphNode) of object;
  TGraphCanRemoveEvent = procedure(Graph: TSimpleGraph; GraphObject: TGraphObject;
    var CanRemove: Boolean) of object;
  TGraphBeginDragEvent = procedure(Graph: TSimpleGraph; GraphObject: TGraphObject;
    HT: DWORD) of object;
  TGraphEndDragEvent = procedure(Graph: TSimpleGraph; GraphObject: TGraphObject;
    HT: DWORD; Cancelled: Boolean) of object;
  TGraphStreamEvent = procedure(Graph: TSimpleGraph; GraphObject: TGraphObject;
    Stream: TStream) of object;

  TGraphForEachMethod = function(GraphObject: TGraphObject;
    UserData: Integer): Boolean of object;

  {$IFNDEF COMPILER5_UP}
  TContextPopupEvent = procedure(Sender: TObject; MousePos: TPoint;
    var Handled: Boolean) of object;
  {$ENDIF}

  {$IFNDEF COMPILER7_UP}
  TWMPrint = packed record
    Msg: Cardinal;
    DC: HDC;
    Flags: Cardinal;
    Result: Integer;
  end;
  {$ENDIF}

  TSimpleGraph = class(TCustomControl)
  private
    fGridSize: TGridSize;
    fGridColor: TColor;
    fShowGrid: Boolean;
    fSnapToGrid: Boolean;
    fShowHiddenObjects: Boolean;
    fHideSelection: Boolean;
    fLockNodes: Boolean;
    fLockLinks: Boolean;
    fMarkerColor: TColor;
    fMarkerSize: TMarkerSize;
    fZoom: TZoom;
    fObjects: TGraphObjectList;
    fSelectedObjects: TGraphObjectList;
    fDraggingObjects: TGraphObjectList;
    fDefaultKeyMap: Boolean;
    fObjectPopupMenu: TPopupMenu;
    fDefaultNodeClass: TGraphNodeClass;
    fDefaultLinkClass: TGraphLinkClass;
    fModified: Boolean;
    fCommandMode: TGraphCommandMode;
    fHorzScrollBar: TGraphScrollBar;
    fVertScrollBar: TGraphScrollBar;
    fGraphConstraints: TGraphConstraints;
    fMinNodeSize: Word;
    fDrawOrder: TGraphDrawOrder;
    fFixedScrollBars: Boolean;
    fValidMarkedArea: Boolean;
    fMarkedArea: TRect;
    fTransparent: Boolean;
    fDragSource: TGraphObject;
    fDragHitTest: DWORD;
    fDragSourcePt: TPoint;
    fDragTargetPt: TPoint;
    fDragModified: Boolean;
    fCanvasRecall: TCanvasRecall;
    fClipboardFormats: TGraphClipboardFormats;
    fObjectAtCursor: TGraphObject;
    fOnObjectInitInstance: TGraphNotifyEvent;
    fOnObjectInsert: TGraphNotifyEvent;
    fOnObjectRemove: TGraphNotifyEvent;