simplegraph.pas

很不错的绘制矢量图的控件。还有一个使用控件的例子。delphi7以上才可安装

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

{$I DELPHIAREA.INC}

{$Q-R-O+}

unit SimpleGraph;

interface

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

const
  crHandFlat  = 51;
  crHandGrab  = 52;
  crHandPnt   = 53;
  crXHair1    = 54;
  crXHair2    = 55;

type

  TSimpleGraph = class;
  TGraphObject = class;

  EGraphStreamError = class(EStreamError);

  { MemoryHandleStream }

  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;

  { 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;
    constructor Create(AOwner: TSimpleGraph; AKind: TScrollBarKind);
    procedure CalcAutoRange;
    function ControlSize(ControlSB, AssumeSB: Boolean): Integer;
    procedure DoSetRange(Value: Integer);
    function GetScrollPos: Integer;
    function NeedsScrollBarVisible: Boolean;
    function IsIncrementStored: Boolean;
    procedure ScrollMessage(var Msg: TWMScroll);
    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);
    procedure Update(ControlSB, AssumeSB: Boolean);
  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;

  { TGraphObject }

  TMarkerType = (mtNone, mtSizeW, mtSizeE, mtSizeN, mtSizeS, mtSizeNW,
    mtSizeNE, mtSizeSW, mtSizeSE, mtMove, mtMoveStrartPt, mtMoveEndPt,
    mtSelect);

  TGraphObjectState = (osNone, osCreating, osDestroying, osReading, osWriting);

  TGraphObjectClass = class of TGraphObject;

  TGraphObject = class(TPersistent)
  private
    fID: DWORD;
    fOldID: DWORD;
    fOwner: TSimpleGraph;
    fBrush: TBrush;
    fPen: TPen;
    fText: String;
    fFont: TFont;
    fParentFont: Boolean;
    fTag: Integer;
    fVisible: Boolean;
    fSelected: Boolean;
    fDragging: Boolean;
    fState: TGraphObjectState;
    fIsLink: Boolean;
    InSyncFont: Boolean;
    procedure SetBrush(Value: TBrush);
    procedure SetPen(Value: TPen);
    procedure SetText(const Value: String);
    procedure SetFont(Value: TFont);
    procedure SetParentFont(Value: Boolean);
    procedure SetVisible(Value: Boolean);
    procedure SetSelected(Value: Boolean);
    procedure SetDragging(Value: Boolean);
    function GetZOrder: Integer;
    procedure SetZOrder(Value: Integer);
    procedure SetState(Value: TGraphObjectState);
    function GetShowing: Boolean;
    function IsFontStored: Boolean;
    procedure StyleChanged(Sender: TObject);
  protected
    constructor Create(AOwner: TSimpleGraph); reintroduce; virtual;
    procedure SyncFontToParent;
    procedure InitializeInstance; virtual;
    procedure LocateLinkedObjects(StartIndex: Integer); virtual;
    function VerifyLinkedObjects: Boolean; virtual;
    function ChangeLinkedObject(OldObject, NewObject: TGraphObject): Boolean; virtual;
    procedure Changed(DataModified: Boolean); virtual;
    procedure CalculateTextParameters(Recalc: Boolean; dX, dY: Integer); virtual;
    function MarkerRect(MarkerType: TMarkerType): TRect; virtual; abstract;
    function FindMarkerAt(X, Y: Integer): TMarkerType; virtual; abstract;
    procedure DrawMarkers(Canvas: TCanvas); virtual; abstract;
    procedure DrawText(Canvas: TCanvas); virtual; abstract;
    procedure DrawBody(Canvas: TCanvas); virtual; abstract;
    procedure Draw(Canvas: TCanvas); virtual;
    function IsVisibleOn(Canvas: TCanvas): Boolean;
    procedure SetBoundsRect(const Rect: TRect); virtual; abstract;
    function GetBoundsRect: TRect; virtual; abstract;
    class procedure DrawDraft(Canvas: TCanvas; const ARect: TRect); virtual; abstract;
    property Dragging: Boolean read fDragging write SetDragging;
    property State: TGraphObjectState read fState write SetState;
    property ID: DWORD read fID write fID;
    property OldID: DWORD read fOldID write fOldID;
  public
    destructor Destroy; override;
    function ContainsPoint(X, Y: Integer): Boolean; virtual; abstract;
    procedure Assign(Source: TPersistent); override;
    procedure BringToFront; virtual;
    procedure SendToBack; virtual;
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToStream(Stream: TStream); virtual;
    function ConvertTo(AnotherClass: TGraphObjectClass): Boolean; virtual;
    property IsLink: Boolean read fIsLink;
    property Owner: TSimpleGraph read fOwner;
    property Showing: Boolean read GetShowing;
    property ZOrder: Integer read GetZOrder write SetZOrder;
    property Selected: Boolean read fSelected write SetSelected default False;
    property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
  published
    property Text: String read fText write SetText;
    property Brush: TBrush read fBrush write SetBrush;
    property Pen: TPen read fPen write SetPen;
    property Font: TFont read fFont write SetFont stored IsFontStored;
    property ParentFont: Boolean read fParentFont write SetParentFont default True;
    property Visible: Boolean read fVisible write SetVisible default True;
    property Tag: Integer read fTag write fTag default 0;
  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;

  { TGraphLink }

  TGraphNode = class;

  TLinkKind = (lkUndirected, lkDirected, lkBidirected);

  TArrowSize = 2..10;

  TGraphLink = class(TGraphObject)
  private
    fFromNode: TGraphNode;
    fToNode: TGraphNode;
    fKind: TLinkKind;
    fStartPt: TPoint;
    fEndPt: TPoint;
    fArrowSize: TArrowSize;
    fAngle: Extended;
    fTextRegion: HRGN;
    TextCenter: TPoint;
    TextToShow: String;
    FromNodeID: DWORD;
    ToNodeID: DWORD;
    procedure SetFromNode(Value: TGraphNode);
    procedure SetToNode(Value: TGraphNode);
    procedure SetKind(Value: TLinkKind);
    procedure SetArrowSize(Value: TArrowSize);
    procedure ReadFromNode(Reader: TReader);
    procedure WriteFromNode(Writer: TWriter);
    procedure ReadToNode(Reader: TReader);
    procedure WriteToNode(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure InitializeInstance; override;
    procedure LocateLinkedObjects(StartIndex: Integer); override;
    function VerifyLinkedObjects: Boolean; override;
    function ChangeLinkedObject(OldObject, NewObject: TGraphObject): Boolean; override;
    procedure Changed(DataModified: Boolean); override;
    procedure CalculateTextParameters(Recalc: Boolean; dX, dY: Integer); override;
    procedure CalculateEndPoints; virtual;
    function GetTextRegion: HRGN; virtual;
    function MarkerRect(MarkerType: TMarkerType): TRect; override;
    function FindMarkerAt(X, Y: Integer): TMarkerType; override;
    procedure DrawMarkers(Canvas: TCanvas); override;
    procedure DrawText(Canvas: TCanvas); override;
    procedure DrawBody(Canvas: TCanvas); override;
    procedure Draw(Canvas: TCanvas); override;
    procedure SetBoundsRect(const Rect: TRect); override;
    function GetBoundsRect: TRect; override;
    class procedure DrawDraft(Canvas: TCanvas; const ARect: TRect); override;
  protected
    constructor Create(AOwner: TSimpleGraph); override;
    property StartPt: TPoint read fStartPt;
    property EndPt: TPoint read fEndPt;
    property Angle: Extended read fAngle;
    property TextRegion: HRGN read fTextRegion;
  public
    destructor Destroy; override;
    procedure Reverse; virtual;
    procedure Assign(Source: TPersistent); override;
    function ContainsPoint(X, Y: Integer): Boolean; override;
    property FromNode: TGraphNode read fFromNode write SetFromNode;
    property ToNode: TGraphNode read fToNode write SetToNode;
  published
    property Kind: TLinkKind read fKind write SetKind default lkDirected;
    property ArrowSize: TArrowSize read fArrowSize write SetArrowSize default 4;
  end;

  { TGraphNode }

  TQueryLinkResult = (qlrNone, qlrLinked, qlrLinkedIn, qlrLinkedOut, qlrLinkedInOut);

  TGraphNode = class(TGraphObject)
  private
    fLeft: Integer;
    fTop: Integer;
    fWidth: Integer;
    fHeight: Integer;
    fAlignment: TAlignment;
    fMargin: Integer;
    fBackground: TPicture;
    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 SetMargin(Value: Integer);
    procedure SetBackground(Value: TPicture);
    procedure BackgroundChanged(Sender: TObject);
  protected
    procedure InitializeInstance; override;
    procedure BoundsChanged(dX, dY, dCX, dCY: Integer); virtual;
    procedure CalculateTextParameters(Recalc: Boolean; dX, dY: Integer); override;
    function GetMaxTextRect: TRect; virtual;
    function GetTextRect: TRect; virtual;
    function GetCenter: TPoint; virtual;
    function GetRegion: HRGN; virtual; abstract;
    function CreateClipRgn(Canvas: TCanvas): HRGN;
    function MarkerRect(MarkerType: TMarkerType): TRect; override;
    function FindMarkerAt(X, Y: Integer): TMarkerType; override;
    procedure DrawMarkers(Canvas: TCanvas); override;
    procedure DrawText(Canvas: TCanvas); override;
    procedure DrawBackground(Canvas: TCanvas); virtual;
    procedure SetBoundsRect(const Rect: TRect); override;
    function GetBoundsRect: TRect; override;
    function LinkIntersect(const LinkAngle: Extended; Backward: Boolean): TPoint; virtual; abstract;
  protected
    constructor Create(AOwner: TSimpleGraph); override;
    procedure MoveMarkerBy(MarkerType: TMarkerType; const Delta: TPoint);
    property Region: HRGN read fRegion;
    property TextRect: TRect read fTextRect;
  public
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function ContainsPoint(X, Y: Integer): Boolean; override;
    procedure SetBounds(aLeft, aTop, aWidth, aHeight: Integer); virtual;
    function QueryLinkTo(Node: TGraphNode): TQueryLinkResult; virtual;
    property Center: TPoint read GetCenter;
  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 Margin: Integer read fMargin write SetMargin default 8;
    property Background: TPicture read fBackground write SetBackground;
  end;

  { TPolygonalNode }
  { NOTE: Vertices are in clockwise order, and the first vertex is at 12 O'clock }

  TPointArray = array of TPoint;

  TPolygonalNode = class(TGraphNode)
  private
    fVertices: TPointArray;
  protected
    procedure BoundsChanged(dX, dY, dCX, dCY: Integer); override;
    function GetCenter: TPoint; override;
    function GetRegion: HRGN; override;
    procedure DrawBody(Canvas: TCanvas); override;
    function LinkIntersect(const LinkAngle: Extended; Backward: Boolean): TPoint; override;
    class procedure DrawDraft(Canvas: TCanvas; const ARect: TRect); override;
    class procedure DefineVertices(const ARect: TRect; var Points: TPointArray); virtual; abstract;
    property Vertices: TPointArray read fVertices;
  public
    destructor Destroy; override;
  end;

  { TRectangularNode }

  TRectangularNode = class(TGraphNode)
  protected
    function GetRegion: HRGN; override;
    procedure DrawBody(Canvas: TCanvas); override;
    function LinkIntersect(const LinkAngle: Extended; Backward: Boolean): TPoint; override;
    class procedure DrawDraft(Canvas: TCanvas; const ARect: TRect); override;
  end;

  { TRoundRectangularNode }

  TRoundRectangularNode = class(TGraphNode)
  protected
    function GetRegion: HRGN; override;
    procedure DrawBody(Canvas: TCanvas); override;
    function LinkIntersect(const LinkAngle: Extended; Backward: Boolean): TPoint; override;
    class procedure DrawDraft(Canvas: TCanvas; const ARect: TRect); override;
  end;

  { TEllipticNode }

  TEllipticNode = class(TGraphNode)
  protected
    function GetRegion: HRGN; override;
    procedure DrawBody(Canvas: TCanvas); override;
    function LinkIntersect(const LinkAngle: Extended; Backward: Boolean): TPoint; override;