simplegraph.pas

矢量绘图组件（开源版）

    fOnObjectChange: TGraphNotifyEvent;
    fOnObjectSelect: TGraphNotifyEvent;
    fOnObjectClick: TGraphNotifyEvent;
    fOnObjectDblClick: TGraphNotifyEvent;
    fOnObjectContextPopup: TGraphContextPopupEvent;
    fOnObjectBeforeDraw: TGraphObjectDrawEvent;
    fOnObjectAfterDraw: TGraphObjectDrawEvent;
    fOnObjectBeginDrag: TGraphBeginDragEvent;
    fOnObjectEndDrag: TGraphEndDragEvent;
    fOnObjectMouseEnter: TGraphNotifyEvent;
    fOnObjectMouseLeave: TGraphNotifyEvent;
    fOnObjectRead: TGraphStreamEvent;
    fOnObjectWrite: TGraphStreamEvent;
    fOnObjectHook: TGraphHookEvent;
    fOnObjectUnhook: TGraphHookEvent;
    fOnCanHookLink: TGraphCanHookEvent;
    fOnCanRemoveObject: TGraphCanRemoveEvent;
    fOnCanLinkObjects: TGraphCanLinkEvent;
    fOnCanMoveResizeNode: TCanMoveResizeNodeEvent;
    fOnNodeMoveResize: TGraphNodeResizeEvent;
    fOnGraphChange: TNotifyEvent;
    fOnBeforeDraw: TGraphDrawEvent;
    fOnAfterDraw: TGraphDrawEvent;
    fOnCommandModeChange: TNotifyEvent;
    {$IFNDEF COMPILER5_UP}
    fOnContextPopup: TContextPopupEvent;
    {$ENDIF}
    fOnInfoTip: TGraphInfoTipEvent;
    fOnZoomChange: TNotifyEvent;
    UpdatingScrollBars: Boolean;
    UpdateCount: Integer;
    SaveModified: Integer;
    SaveRangeChange: Boolean;
    SaveInvalidateRect: TRect;
    SaveBoundsChange: set of TGraphBoundsKind;
    SaveBounds: array[TGraphBoundsKind] of TRect;
    SuspendQueryEvents: Integer;
    UndoStorage: TMemoryStream;
    procedure SetGridSize(Value: TGridSize);
    procedure SetGridColor(Value: TColor);
    procedure SetShowGrid(Value: Boolean);
    procedure SetTransparent(Value: Boolean);
    procedure SetShowHiddenObjects(Value: Boolean);
    procedure SetHideSelection(Value: Boolean);
    procedure SetLockNodes(Value: Boolean);
    procedure SetLockLinks(Value: Boolean);
    procedure SetMarkerColor(Value: TColor);
    procedure SetMarkerSize(Value: TMarkerSize);
    procedure SetZoom(Value: TZoom);
    procedure SetDrawOrder(Value: TGraphDrawOrder);
    procedure SetFixedScrollBars(Value: Boolean);
    procedure SetCommandMode(Value: TGraphCommandMode);
    procedure SetHorzScrollBar(Value: TGraphScrollBar);
    procedure SetVertScrollBar(Value: TGraphScrollBar);
    procedure SetGraphConstraints(Value: TGraphConstraints);
    function GetBoundingRect(Kind: TGraphBoundsKind): TRect;
    function GetVisibleBounds: TRect;
    function GetCursorPos: TPoint;
    procedure SetCursorPos(const Pt: TPoint);
    procedure SetMarkedArea(const Value: TRect);
    {$IFNDEF COMPILER5_UP}
    procedure WMContextMenu(var Msg: TMessage); message WM_CONTEXTMENU;
    {$ENDIF}
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure WMPrint(var Msg: TWMPrint); message WM_PRINT;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMWindowPosChanging(var Msg: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure CNKeyDown(var Msg: TWMKeyDown); message CN_KEYDOWN;
    procedure CNKeyUp(var Msg: TWMKeyUp); message CN_KEYUP;
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
    procedure CMBiDiModeChanged(var Msg: TMessage); message CM_BIDIMODECHANGED;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure CMHintShow(var Msg: TCMHintShow); message CM_HINTSHOW;
    procedure ObjectListChanged(Sender: TObject; GraphObject: TGraphObject;
      Action: TGraphObjectListAction);
    procedure SelectedListChanged(Sender: TObject; GraphObject: TGraphObject;
      Action: TGraphObjectListAction);
    procedure DraggingListChanged(Sender: TObject; GraphObject: TGraphObject;
      Action: TGraphObjectListAction);
    procedure ObjectChanged(GraphObject: TGraphObject; Flags: TGraphChangeFlags);
    function ReadGraphObject(Stream: TStream): TGraphObject;
    procedure WriteGraphObject(Stream: TStream; GraphObject: TGraphObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); {$IFDEF COMPILER5_UP} override; {$ENDIF}
    procedure Click; override;
    procedure DblClick; override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure DoZoomChange; virtual;
    procedure DoGraphChange; virtual;
    procedure DoCommandModeChange; virtual;
    procedure DoBeforeDraw(ACanvas: TCanvas); virtual;
    procedure DoAfterDraw(ACanvas: TCanvas); virtual;
    procedure DoObjectClick(GraphObject: TGraphObject); virtual;
    procedure DoObjectDblClick(GraphObject: TGraphObject); virtual;
    procedure DoObjectInitInstance(GraphObject: TGraphObject); virtual;
    procedure DoObjectInsert(GraphObject: TGraphObject); virtual;
    procedure DoObjectRemove(GraphObject: TGraphObject); virtual;
    procedure DoObjectSelect(GraphObject: TGraphObject); virtual;
    procedure DoObjectChange(GraphObject: TGraphObject); virtual;
    procedure DoObjectMouseEnter(GraphObject: TGraphObject); virtual;
    procedure DoObjectMouseLeave(GraphObject: TGraphObject); virtual;
    procedure DoObjectBeforeDraw(ACanvas: TCanvas; GraphObject: TGraphObject); virtual;
    procedure DoObjectAfterDraw(ACanvas: TCanvas; GraphObject: TGraphObject); virtual;
    procedure DoObjectContextPopup(GraphObject: TGraphObject; const MousePos: TPoint;
      var Handled: Boolean); virtual;
    procedure DoObjectBeginDrag(GraphObject: TGraphObject; HT: DWORD); virtual;
    procedure DoObjectEndDrag(GraphObject: TGraphObject; HT: DWORD; Cancelled: Boolean); virtual;
    procedure DoObjectRead(GraphObject: TGraphObject; Stream: TStream); virtual;
    procedure DoObjectWrite(GraphObject: TGraphObject; Stream: TStream); virtual;
    procedure DoObjectUnhook(GraphObject: TGraphObject; Link: TGraphLink; Index: Integer); virtual;
    procedure DoObjectHook(GraphObject: TGraphObject; Link: TGraphLink; Index: Integer); virtual;
    procedure DoCanHookLink(GraphObject: TGraphObject; Link: TGraphLink;
      Index: Integer; var CanHook: Boolean); virtual;
    procedure DoCanLinkObjects(Link: TGraphLink; Source, Target: TGraphObject;
      var CanLink: Boolean); virtual;
    procedure DoCanMoveResizeNode(Node: TGraphNode; var aLeft, aTop, aWidth, aHeight: Integer;
      var CanMove, CanResize: Boolean); virtual;
    procedure DoCanRemoveObject(GraphObject: TGraphObject; var CanRemove: Boolean); virtual;
    procedure DoNodeMoveResize(Node: TGraphNode); virtual;
    procedure ReadObjects(Stream: TStream); virtual;
    procedure WriteObjects(Stream: TStream; ObjectList: TGraphObjectList); virtual;
    procedure RestoreObjects(Stream: TStream); virtual;
    procedure BackupObjects(Stream: TStream; ObjectList: TGraphObjectList); virtual;
    procedure DrawGrid(Canvas: TCanvas); virtual;
    procedure DrawObjects(Canvas: TCanvas; ObjectList: TGraphObjectList); virtual;
    procedure DrawEditStates(Canvas: TCanvas); virtual;
    function CreateUniqueID(GraphObject: TGraphObject): DWORD; virtual;
    function GetAsMetafile(RefDC: HDC; ObjectList: TGraphObjectList): TMetafile; virtual;
    function GetAsBitmap(ObjectList: TGraphObjectList): TBitmap; virtual;
    function GetObjectsBounds(ObjectList: TGraphObjectList): TRect; virtual;
    procedure AdjustDC(DC: HDC; Org: PPoint = nil); virtual;
    procedure GPToCP(var Points; Count: Integer);
    procedure CPToGP(var Points; Count: Integer);
    procedure UpdateScrollBars; virtual;
    procedure CalcAutoRange; virtual;
    function BeginDragObject(GraphObject: TGraphObject;
      const Pt: TPoint; HT: DWORD): Boolean; virtual;
    procedure PerformDragBy(dX, dY: Integer); virtual;
    procedure EndDragObject(Accept: Boolean); virtual;
    procedure PerformInvalidate(pRect: PRect);
    procedure CheckObjectAtCursor(const Pt: TPoint); virtual;
    procedure RenewObjectAtCursor(NewObjectAtCursor: TGraphObject); virtual;
    function InsertObjectByMouse(var Pt: TPoint; GraphObjectClass: TGraphObjectClass;
      GridSnap: Boolean): TGraphObject;
    function DefaultKeyHandler(var Key: Word; Shift: TShiftState): Boolean; virtual;
  protected
    property CanvasRecall: TCanvasRecall read fCanvasRecall;
    property DragSourcePt: TPoint read fDragSourcePt write fDragSourcePt;
    property DragTargetPt: TPoint read fDragTargetPt write fDragTargetPt;
    property DragHitTest: DWORD read fDragHitTest write fDragHitTest;
    property DragModified: Boolean read fDragModified;
    property ValidMarkedArea: Boolean read fValidMarkedArea;
    property MarkedArea: TRect read fMarkedArea write SetMarkedArea;
  public
    class procedure Register(ANodeClass: TGraphNodeClass); overload;
    class procedure Unregister(ANodeClass: TGraphNodeClass); overload;
    class function NodeClassCount: Integer;
    class function NodeClasses(Index: Integer): TGraphNodeClass;
    class procedure Register(ALinkClass: TGraphLinkClass); overload;
    class procedure Unregister(ALinkClass: TGraphLinkClass); overload;
    class function LinkClassCount: Integer;
    class function LinkClasses(Index: Integer): TGraphLinkClass;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure Invalidate; override;
    procedure InvalidateRect(const Rect: TRect);
    procedure Draw(Canvas: TCanvas);
    procedure Print(Canvas: TCanvas; const Rect: TRect);
    procedure ToggleSelection(const Rect: TRect; KeepOld: Boolean;
      GraphObjectClass: TGraphObjectClass = nil);
    function FindObjectAt(X, Y: Integer;
      LookAfter: TGraphObject = nil): TGraphObject;
    function FindObjectByID(ID: DWORD): TGraphObject;
    function InsertNode(const Bounds: TRect;
      ANodeClass: TGraphNodeClass = nil): TGraphNode;
    function InsertLink(Source, Target: TGraphObject;
      ALinkClass: TGraphLinkClass = nil): TGraphLink; overload;
    function InsertLink(Source: TGraphObject; const Pts: array of TPoint;
      ALinkClass: TGraphLinkClass = nil): TGraphLink; overload;
    function InsertLink(const Pts: array of TPoint; Target: TGraphObject;
      ALinkClass: TGraphLinkClass = nil): TGraphLink; overload;
    function InsertLink(const Pts: array of TPoint;
      ALinkClass: TGraphLinkClass = nil): TGraphLink; overload;
    procedure ScrollInView(GraphObject: TGraphObject); overload;
    procedure ScrollInView(const Rect: TRect); overload;
    procedure ScrollInView(const Pt: TPoint); overload;
    procedure ScrollCenter(GraphObject: TGraphObject); overload;
    procedure ScrollCenter(const Rect: TRect); overload;
    procedure ScrollCenter(const Pt: TPoint); overload;
    procedure ScrollBy(DeltaX, DeltaY: Integer);
    function ZoomRect(const Rect: TRect): Boolean;
    function ZoomObject(GraphObject: TGraphObject): Boolean;
    function ZoomSelection: Boolean;
    function ZoomGraph: Boolean;
    function ChangeZoom(NewZoom: Integer; Origin: TGraphZoomOrigin): Boolean;
    function ChangeZoomBy(Delta: Integer; Origin: TGraphZoomOrigin): Boolean;
    function AlignSelection(Horz: THAlignOption; Vert: TVAlignOption): Boolean;
    function ResizeSelection(Horz: TResizeOption; Vert: TResizeOption): Boolean;
    function ForEachObject(Callback: TGraphForEachMethod; UserData: Integer;
      Selection: Boolean = False): Integer;
    function FindNextObject(StartIndex: Integer; Inclusive, Backward,
      Wrap: Boolean; GraphObjectClass: TGraphObjectClass = nil): TGraphObject;
    function SelectNextObject(Backward: Boolean;
      GraphObjectClass: TGraphObjectClass = nil): Boolean;
    function ObjectsCount(GraphObjectClass: TGraphObjectClass = nil): Integer;
    function SelectedObjectsCount(GraphObjectClass: TGraphObjectClass = nil): Integer;
    procedure ClearSelection;
    procedure Clear;
    procedure SaveAsMetafile(const Filename: String);
    procedure SaveAsBitmap(const Filename: String);
    procedure CopyToGraphic(Graphic: TGraphic);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromFile(const Filename: String);
    procedure SaveToFile(const Filename: String);
    procedure MergeFromStream(Stream: TStream; OffsetX, OffsetY: Integer);
    procedure MergeFromFile(const Filename: String; OffsetX, OffsetY: Integer);
    procedure CopyToClipboard(Selection: Boolean = True);
    function PasteFromClipboard: Boolean;
    procedure SnapOffset(const Pt: TPoint; var dX, dY: Integer);
    function SnapPoint(const Pt: TPoint): TPoint;
    function ClientToGraph(X, Y: Integer): TPoint;
    function GraphToClient(X, Y: Integer): TPoint;
    function ScreenToGraph(X, Y: Integer): TPoint;
    function GraphToScreen(X, Y: Integer): TPoint;
    property DragSource: TGraphObject read fDragSource;
    property ObjectAtCursor: TGraphObject read fObjectAtCursor;
    property CursorPos: TPoint read GetCursorPos write SetCursorPos;
    property VisibleBounds: TRect read GetVisibleBounds;
    property GraphBounds: TRect index bkGraph read GetBoundingRect;
    property SelectionBounds: TRect index bkSelected read GetBoundingRect;
    property DraggingBounds: TRect index bkDragging read GetBoundingRect;
    property Objects: TGraphObjectList read fObjects;
    property SelectedObjects: TGraphObjectList read fSelectedObjects;
    property DraggingObjects: TGraphObjectList read fDraggingObjects;
    property Modified: Boolean read fModified write fModified;
    property CommandMode: TGraphCommandMode read fCommandMode write SetCommandMode;
    property DefaultNodeClass: TGraphNodeClass read fDefaultNodeClass write fDefaultNodeClass;
    property DefaultLinkClass: TGraphLinkClass read fDefaultLinkClass write fDefaultLinkClass;
  published
    property Align;
    property Anchors;
    property BiDiMode;
    property ClipboardFormats: TGraphClipboardFormats read fClipboardFormats write fClipboardFormats default [cfNative];
    property Color;
    property Constraints;
    property DefaultKeyMap: Boolean read fDefaultKeyMap write fDefaultKeyMap default True;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DrawOrder: TGraphDrawOrder read fDrawOrder write SetDrawOrder default doDefault;
    property Enabled;
    property FixedScrollBars: Boolean read fFixedScrollBars write SetFixedScrollBars default False;
    property Font;
    property GraphConstraints: TGraphConstraints read fGraphConstraints write SetGraphConstraints;
    property GridColor: TColor read fGridColor write SetGridColor default clGray;
    property GridSize: TGridSize read fGridSize write SetGridSize default 8;
    property Height;
    property HideSelection: Boolean read fHideSelection write SetHideSelection default False;
    property HorzScrollBar: TGraphScrollBar read fHorzScrollBar write SetHorzScrollBar;
    property LockLinks: Boolean read fLockLinks write SetLockLinks default False;
    property LockNodes: Boolean read fLockNodes write SetLockNodes default False;
    property MarkerColor: TColor read fMarkerColor write SetMarkerColor default clBlack;
    property MarkerSize: TMarkerSize read fMarkerSize write SetMarkerSize default 3;
    property MinNodeSize: Word read fMinNodeSize write fMinNodeSize default 16;
    property ObjectPopupMenu: TPopupMenu read fObjectPopupMenu write fObjectPopupMenu;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowGrid: Boolean read fShowGrid write SetShowGrid default True;
    property ShowHiddenObjects: Boolean read fShowHiddenObjects write SetShowHiddenObjects default False;
    property ShowHint;
    property SnapToGrid: Boolean read fSnapToGrid write fSnapToGrid default True;
    property TabOrder;
    property TabStop;
    property Transparent: Boolean read fTransparent write SetTransparent default False;