flexbase.pas

是一套创建矢量图形的VCL组件

/////////////////////////////////////////////////////////
//                                                     //
//    FlexGraphics library                             //
//    Copyright (c) 2002-2003, FlexGraphics software.  //
//                                                     //
//    FlexGraphics library base classes                //
//                                                     //
/////////////////////////////////////////////////////////

unit FlexBase;

{$I FlexDefs.inc}

interface

uses
  Windows, Classes, Messages, Controls, Forms, SysUtils, ExtCtrls, Graphics,
  Dialogs, Menus, Printers, ClipBrd, {$IFDEF FG_D6} Variants, {$ENDIF}
  FlexProps, FlexUtils, FlexPath;

const
  ClassNamePrefix  = 'TFlex';

  MinScale = 1;
  MaxScale = 100 * PixelScaleFactor div 2; //12800;

  // Constants in pixels
  AnchorPointSize = 5;
  SelectionMarkerSize = 6; // 5;
  SelectionInflate = 8; // 6;
  SelectionThreshold = 4;  

  MaxSinglePointsInvalidation = 20;

type
  TResizeCursor   = ( rcrNone,
                      rcrTopLeft, rcrTop, rcrTopRight, rcrLeft, rcrRight,
                      rcrBottomLeft, rcrBottom, rcrBottomRight );
  TFlexToolMode   = ( ftmSelect, ftmSelecting, ftmZoom, ftmZooming,
                      ftmMove, ftmMoving, ftmResize, ftmResizing, ftmCreating,
                      ftmPointEdit, ftmPointSelecting, ftmPointEditing,
                      ftmPan, ftmPanning );
  TFlexAlign      = ( faLeft, faHCenter, faRight,
                      faTop, faVCenter, faBottom, faCenter );
  TFlexStateItem  = ( fsCreating, fsDestroying, fsExtracting, fsResizing );
  TFlexState      = set of TFlexStateItem;

  TFlexLoadFunc   = ( lfNew, lfAdd );

  TFlexGridStyle  = ( gsLines, gsDots );

  PFlexEditPointGuide = ^TFlexEditPointGuide;
  TFlexEditPointGuide = record
   Points: TPointArray;
   PaintPoints: TPointArray;
   Types: TPointTypeArray;
   Count: integer;
   ActiveIndex: integer;
  end;

  TFlexPanel = class;
  TFlexLayer = class;
  TFlexControl = class;
  TFlexCustomScheme = class;

  TFlexNotifyEvent = procedure(Sender: TObject; Control: TFlexControl;
    Notify: TFlexNotify) of object;

  TFlexControlClass = class of TFlexControl;
  TFlexControlClasses = array of TFlexControlClass;

  PPassControlRec = ^TPassControlRec;
  TPassControlRec = record
   Control: TFlexControl;
   FirstControl: TFlexControl;
   Indexes: array of integer;
  end;

  TSchemeRefProp = class(TCustomProp)
  private
   FValue: TFlexControl;
   procedure SetValue(const Value: TFlexControl);
  protected
   function  GetDisplayValue: string; override;
   function  GetNamesControl: TFlexControl; virtual;
  public
   constructor Create(AOwner: TPropList; const AName: string);
   procedure GetEnumList(List: TStrings); override;
   procedure SetPropValue(const PropName: string; Value: Variant); override;
   function  GetPropValue(const PropName: string): Variant; override;
   property  Value: TFlexControl read FValue write SetValue;
  end;

  TFlexControl = class
  private
   FOwner: TFlexPanel;
   FParent: TFlexControl;
   FLayer: TFlexLayer;
   FState: TFlexState;
   FControls: TList;
   FProps: TPropList;
   FCheckID: LongWord;
   FNonVisual: boolean;
   FNoPaintRectCheck: boolean;
   FUpdateCounter: integer;
   FNameProp: TStrProp;
   FLeftProp: TIntProp;
   FTopProp: TIntProp;
   FWidthProp: TIntProp;
   FHeightProp: TIntProp;
   FIdProp: TLongWordProp;
   FTagProp: TIntProp;
   FVisibleProp: TBoolProp;
   FLayerProp: TStrProp;
   FHintProp: TStrListProp;
   FShowHintProp: TBoolProp;
   FReferenceProp: TSchemeRefProp;
   FUserDataProp: TUserDataProp;
   function  GetControl(Index: integer): TFlexControl;
   function  GetCount: integer;
   function  GetIsSelected: boolean;
   function  GetName: string;
   function  GetVisual: boolean;
   function  GetID: LongWord;
   function  GetHeight: integer;
   function  GetLeft: integer;
   function  GetTop: integer;
   function  GetWidth: integer;
   function  GetHint: string;
   function  GetShowHint: boolean;
   function  GetTag: integer;
   function  GetVisible: boolean;
   procedure SetParent(const Value: TFlexControl);
   procedure SetName(const Value: string);
   procedure SetLeft(Value: integer);
   procedure SetTop(Value: integer);
   procedure SetWidth(Value: integer);
   procedure SetHeight(Value: integer);
   procedure SetID(Value: LongWord);
   procedure SetLayer(Value: TFlexLayer);
   procedure SetHint(const Value: string);
   procedure SetShowHint(Value: boolean);
   procedure SetTag(Value: integer);
   procedure SetVisible(Value: boolean);
   procedure SetIsSelected(Value: boolean);
   function  GetDocRect: TRect;
   function  GetPaintRect: TRect;
   procedure GetLayerStrProp(Sender: TObject; out Value: string);
   function  GetByName(const Name: string): TFlexControl;
   function  GetParenScheme: TFlexCustomScheme;
   procedure SetOwner(Value: TFlexPanel);
   function  GetRef: TFlexCustomScheme;
   procedure SetRef(Value: TFlexCustomScheme);
   function  GetNode(NodeIndex: integer): TPoint;
   procedure SetNode(NodeIndex: integer; const Value: TPoint);
   function  GetNodeCount: integer;
   function  GetNodeType(NodeIndex: integer): TPointType;
   procedure SetNodeType(NodeIndex: integer; const Value: TPointType);
  protected
   FAnchorEnabled: boolean;
   FClipRegion: HRGN;
   FResizingRect: TRect;
   procedure CreateProperties; virtual;
   procedure ControlCreate; virtual;
   procedure ControlDestroy; virtual;
   procedure ControlTranslate(const TranslateInfo: TTranslateInfo); virtual;
   function  CreateCurveControl: TFlexControl; virtual;
   function  CanFree: boolean; virtual;
   procedure DoNotify(Notify: TFlexNotify); virtual;
   procedure Paint(Canvas: TCanvas; var PaintRect: TRect); virtual;
   procedure PaintAll(Canvas: TCanvas; PaintX, PaintY: integer); virtual;
   procedure StartResizing(const SelRect: TRect); virtual;
   procedure FinishResizing; virtual;
   procedure PropBeforeChanged(Sender: TObject; Prop: TCustomProp); virtual;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); virtual;
   procedure PropStored(Sender: TObject; Prop: TCustomProp;
     var IsStored: boolean); virtual;
   procedure PropReadOnly(Sender: TObject; Prop: TCustomProp;
     var IsReadOnly: boolean); virtual;
   function  GetAnchorPoint: TPoint; virtual;
   function  GetPoint(Index: integer): TPoint; virtual;
   procedure SetPoint(Index: integer; const Value: TPoint); virtual;
   function  GetPointType(Index: integer): TPointType; virtual;
   procedure SetPointType(Index: integer; const Value: TPointType); virtual;
   function  GetPointCount: integer; virtual;
   function  GetIsPointsClosed: boolean; virtual;
   procedure SetIsPointsClosed(Value: boolean); virtual;
   function  GetPointsInfo: PPathInfo; virtual;
   procedure SetDocRect(Value: TRect); virtual;
   function  ValidateName(CheckEmpty, CheckUnique: boolean): boolean; virtual;
   function  GetRefreshRect(RefreshX, RefreshY: integer): TRect; virtual;
   property  NonVisual: boolean read FNonVisual write FNonVisual;
   property  NoPaintRectCheck: boolean read FNoPaintRectCheck
     write FNoPaintRectCheck;
   property  NameProp: TStrProp read FNameProp;
   property  LeftProp: TIntProp read FLeftProp;
   property  TopProp: TIntProp read FTopProp;
   property  WidthProp: TIntProp read FWidthProp;
   property  HeightProp: TIntProp read FHeightProp;
   property  IdProp: TLongWordProp read FIdProp;
   property  TagProp: TIntProp read FTagProp;
   property  VisibleProp: TBoolProp read FVisibleProp;
   property  LayerProp: TStrProp read FLayerProp;
   property  HintProp: TStrListProp read FHintProp;
   property  ShowHintProp: TBoolProp read FShowHintProp;
   property  ReferenceProp: TSchemeRefProp read FReferenceProp;
   //property  UserDataProp: TUserDataProp read FUserDataProp;
  public
   constructor Create(AOwner: TFlexPanel; AParent: TFlexControl;
     ALayer: TFlexLayer); virtual;
   destructor Destroy; override;
   class function CursorInCreate: TCursor; virtual;
   class function GetToolInfo(ToolIcon: TBitmap; var Hint: string): boolean;
     virtual;
   function  BeginUpdate: boolean; virtual;
   function  EndUpdate: boolean; virtual;
   procedure Invalidate; virtual;
   function  Add(AControl: TFlexControl): integer; virtual;
   function  IndexOf(AControl: TFlexControl): integer;
   procedure Delete(Index: integer); virtual;
   procedure Remove(AControl: TFlexControl);
   procedure Extract(AControl: TFlexControl); virtual;
   procedure Clear; virtual;
   procedure ChangeOrder(CurIndex, NewIndex: integer); virtual;
   function  FindControlAtPoint(x, y: integer): TFlexControl; virtual;
   function  FindByID(ControlID: LongWord): TFlexControl;
   function  FindByName(const AName: string): TFlexControl;
   function  CreatePointsPath(DC: HDC): boolean;
   function  GetNodeIndex(Index: integer): integer; virtual;
   function  GetPointIndex(NodeIndex: integer): integer; virtual;
   function  InsertPoint(Index: integer; const Point: TPoint): integer; virtual;
   function  InsertCurvePoints(Index: integer; const Point, CtrlPointA,
     CtrlPointB: TPoint): integer; virtual;
   procedure DeletePoint(Index: integer); virtual;
   function  AddCurvePoints(const Point, CtrlPointA, CtrlPointB: TPoint): integer;
   function  AddPoint(const Point: TPoint): integer;
   function  InsertCurveNode(NodeIndex: integer; const Point,
     CtrlPointA, CtrlPointB: TPoint): integer;
   procedure DeleteNode(NodeIndex: integer);
   function  InsertNearestPoint(const Point: TPoint): integer; virtual;
   procedure EndFigure(Close: boolean = true);
   procedure SetPoints(const APoints: TPointArray);
   procedure SetPointsEx(const APoints: TPointArray;
     const ATypes: TPointTypeArray); virtual;
   procedure GetPointsEx(out APoints: TPointArray;
     out ATypes: TPointTypeArray); virtual;
   function  EditPoints(Func: TPathEditFunc; const Selected: TSelectedArray;
     Params: PPathEditParams = Nil): boolean; virtual;
   function  EditPointsCaps(const Selected: TSelectedArray): TPathEditFuncs;
     virtual;
   function  FlattenPoints(const Curvature: single): boolean; virtual;
   function  FindNearestPoint(const Point: TPoint;
     var Nearest: TNearestPoint): boolean; virtual;
   function  FindNearestPathSegment(const Point: TPoint;
     var FirstIndex, NextIndex: integer): boolean; virtual;
   function  GetTransformPoints(OfsX, OfsY, Scale: integer): TPointArray;
   function  IsPointInside(PaintX, PaintY: integer): boolean; virtual;
   function  ClientToOwner(const Point: TPoint): TPoint;
   function  OwnerToClient(const Point: TPoint): TPoint;
   procedure Translate(const TranslateInfo: TTranslateInfo); virtual;
   procedure SaveToFiler(Filer: TFlexFiler; const Indent: string); virtual;
   procedure LoadFromFiler(Filer: TFlexFiler); virtual;
   property  Owner: TFlexPanel read FOwner write SetOwner;
   property  Parent: TFlexControl read FParent write SetParent;
   property  ParentScheme: TFlexCustomScheme read GetParenScheme;
   property  State: TFlexState read FState;
   property  Layer: TFlexLayer read FLayer write SetLayer;
   property  Visual: boolean read GetVisual;
   property  UpdateCounter: integer read FUpdateCounter;
   property  DocRect: TRect read GetDocRect write SetDocRect;
   property  PaintRect: TRect read GetPaintRect;
   property  IsSelected: boolean read GetIsSelected write SetIsSelected;
   property  Count: integer read GetCount;
   property  Controls[Index: integer]: TFlexControl read GetControl; default;
   property  ByName[const Name: string]: TFlexControl read GetByName;
   property  Props: TPropList read FProps;
   property  AnchorEnabled: boolean read FAnchorEnabled;
   property  AnchorPoint: TPoint read GetAnchorPoint;
   property  PointCount: integer read GetPointCount;
   property  Points[Index: integer]: TPoint read GetPoint write SetPoint; 
   property  PointTypes[Index: integer]: TPointType read GetPointType write
     SetPointType;
   property  NodeCount: integer read GetNodeCount;
   property  Nodes[NodeIndex: integer]: TPoint read GetNode write SetNode;
   property  NodeTypes[NodeIndex: integer]: TPointType read GetNodeType
     write SetNodeType;
   property  IsPointsClosed: boolean read GetIsPointsClosed write
     SetIsPointsClosed;
   property  UserData: TUserDataProp read FUserDataProp;
   property  PointsInfo: PPathInfo read GetPointsInfo;
  published
   procedure BeforeDestruction; override;
   procedure FreeInstance; override;
   property  Name: string read GetName write SetName;
   property  ID: LongWord read GetID write SetID;
   property  Tag: integer read GetTag write SetTag;
   property  Left: integer read GetLeft write SetLeft;
   property  Top: integer read GetTop write SetTop;
   property  Width: integer read GetWidth write SetWidth;
   property  Height: integer read GetHeight write SetHeight;
   property  Visible: boolean read GetVisible write SetVisible;
   property  Hint: string read GetHint write SetHint;
   property  ShowHint: boolean read GetShowHint write SetShowHint;
   property  Reference: TFlexCustomScheme read GetRef write SetRef;
  end;

  TFlexGroup = class(TFlexControl)
  private
   FGroupResize: boolean;
  protected
   procedure ControlCreate; override;
   procedure ControlTranslate(const TranslateInfo: TTranslateInfo); override;
   function  GetRefreshRect(RefreshX, RefreshY: integer): TRect; override;
   procedure PropBeforeChanged(Sender: TObject; Prop: TCustomProp); override;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); override;
  public
   function  IsPointInside(PaintX, PaintY: integer): boolean; override;
  end;

  TFlexGrid = class(TFlexControl)
  private
   FSnap: boolean;
   FShowPixGrid: boolean;
   FStyle: TFlexGridStyle;
   FColor: TColor;
   FPixColor: TColor;
   FHSize: integer;
   FVSize: integer;
   procedure GetOwnerWidth(Sender: TObject; out Value: integer);
   procedure GetOwnerHeight(Sender: TObject; out Value: integer);
   procedure SetColor(const Value: TColor);
   procedure SetHSize(const Value: integer);
   procedure SetShowPixGrid(const Value: boolean);
   procedure SetStyle(const Value: TFlexGridStyle);
   procedure SetVSize(const Value: integer);
   procedure SetPixColor(const Value: TColor);
  protected
   procedure CreateProperties; override;
   procedure ControlCreate; override;
   procedure Paint(Canvas: TCanvas; var PaintRect: TRect); override;
  public
   property  Snap: boolean read FSnap write FSnap;
   property  ShowPixGrid: boolean read FShowPixGrid write SetShowPixGrid;
   property  Style: TFlexGridStyle read FStyle write SetStyle;
   property  Color: TColor read FColor write SetColor;
   property  PixColor: TColor read FPixColor write SetPixColor;
   property  HSize: integer read FHSize write SetHSize;
   property  VSize: integer read FVSize write SetVSize;
  end;

  TFlexLayer = class(TFlexControl)
  private
   FSelectableProp: TBoolProp;
   FMoveableProp: TBoolProp;
   FReadOnlyProp: TBoolProp;
   function  GetSelectable: boolean;
   procedure SetSelectable(Value: boolean);
   function  GetReadOnly: boolean;
   procedure SetReadOnly(Value: boolean);
   function  GetMoveable: boolean;
   procedure SetMoveable(const Value: boolean);
  protected
   FCheckName: string;
   procedure CreateProperties; override;
   procedure ControlCreate; override;
   procedure ControlDestroy; override;
   procedure PropBeforeChanged(Sender: TObject; Prop: TCustomProp); override;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); override;
   procedure PropStored(Sender: TObject; Prop: TCustomProp;
     var IsStored: boolean); override;
   property  ReadOnlyProp: TBoolProp read FReadOnlyProp;
   property  SelectableProp: TBoolProp read FSelectableProp;
   property  MoveableProp: TBoolProp read FMoveableProp;
  public
   procedure Invalidate; override;  
   property  Moveable: boolean read GetMoveable write SetMoveable;
   property  Selectable: boolean read GetSelectable write SetSelectable;
   property  ReadOnly: boolean read GetReadOnly write SetReadOnly;
  end;

  TFlexLayers = class(TFlexControl)
  private
   function  GetLayer(Index: integer): TFlexLayer;
   function  GetByName(const Name: string): TFlexLayer;
  protected
   procedure ControlCreate; override;
  public
   function  New: TFlexLayer;
   function  Add(AControl: TFlexControl): integer; override;
   procedure Delete(Index: integer); override;
   procedure ChangeOrder(CurIndex, NewIndex: integer); override;