flexbase.pas

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

   property  Controls[Index: integer]: TFlexLayer read GetLayer; default;
   property  ByName[const Name: string]: TFlexLayer read GetByName;
  end;

  TPaintOrder = record
   LayerRefs:   array of record
                 First: integer;
                 Last: integer;
                end;
   ControlRefs: array of record
                 Next: integer;
                 Prev: integer;
                 Control: TFlexControl;
                end;
  end;

  TFlexCustomScheme = class(TFlexControl)
  private
   function  GetDefault: boolean;
   procedure SetDefault(const Value: boolean);
   procedure GetOwnerWidth(Sender: TObject; out Value: integer);
   procedure GetOwnerHeight(Sender: TObject; out Value: integer);
  protected
   FDefaultProp: TBoolProp;
   procedure CreateProperties; override;
   procedure ControlCreate; override;
   procedure ControlDestroy; override;
   function  CreatePaintOrder(var PaintOrder: TPaintOrder): boolean;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); override;
   procedure PropStored(Sender: TObject; Prop: TCustomProp;
     var IsStored: boolean); override;
   procedure PaintAll(Canvas: TCanvas; PaintX, PaintY: integer); override;
   property  Default: boolean read GetDefault write SetDefault;
  public
   function  FindControlAtPoint(x, y: integer): TFlexControl; override;
  end;

  TFlexScheme = class(TFlexCustomScheme)
  private
   FBrushProp: TBrushProp;
   FPictureProp: TPictureProp;
  protected
   FCheckName: string;
   procedure ControlCreate; override;
   procedure CreateProperties; override;
   procedure Paint(Canvas: TCanvas; var PaintRect: TRect); override;
   procedure PropBeforeChanged(Sender: TObject; Prop: TCustomProp); override;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); override;
   function  GetRefreshRect(RefreshX, RefreshY: integer): TRect; override;
  public
   property  BrushProp: TBrushProp read FBrushProp;
   property  PictureProp: TPictureProp read FPictureProp;
   property  Default;
  end;

  TFlexSchemes = class(TFlexControl)
  private
   function  GetScheme(Index: integer): TFlexCustomScheme;
   function  GetByName(const Name: string): TFlexCustomScheme;
  protected
   procedure ControlCreate; override;
   procedure CreateProperties; override;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); override;
  public
   function  Add(AControl: TFlexControl): integer; override;
   procedure Delete(Index: integer); override;
   procedure ChangeOrder(CurIndex, NewIndex: integer); override;
   property  Controls[Index: integer]: TFlexCustomScheme read GetScheme; default;
   property  ByName[const Name: string]: TFlexCustomScheme read GetByName;
  end;

  TFlexDragObject = class(TDragObject)
  private
   FDragGroup: TFlexGroup;
   FMouseDragDelta: TPoint;
   FDefaultFlex: TFlexPanel;
  protected
   procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean);
     override;
  public
   destructor Destroy; override;
   procedure UpdateLink(Flex: TFlexPanel; MouseX, MouseY: integer);
   procedure Unlink;
   property  DragGroup: TFlexGroup read FDragGroup write FDragGroup;
   property  MouseDragDelta: TPoint read FMouseDragDelta write FMouseDragDelta;
   property  DefaultFlex: TFlexPanel read FDefaultFlex write FDefaultFlex;
  end;

  TFlexPaintEvent = procedure(ACanvas: TCanvas; AControl: TFlexControl;
     ChildrenOnly, SelectedOnly: boolean) of object;

  TFlexPanel = class(TScrollingWinControl)
  private
   FBorderStyle: TBorderStyle;
   FCanvas: TCanvas;
   FDocWidth: integer;
   FDocHeight: integer;
   FDocFrameColor: TColor;
   FDocShadowColor: TColor;
   FDocSpaceBrush: TBrush;
   FDocSpaceFill: boolean;
   FDocClipping: boolean;
   FSchemeBkStretch: boolean;
   FShowDocFrame: boolean;
   FGridControl: TFlexGrid;
   FToolMode: TFlexToolMode;
   FDefaultToolMode: TFlexToolMode;
   FAutoDragEnabled: boolean;
   FLayers: TFlexLayers;
   FActiveLayer: TFlexLayer;
   FSchemes: TFlexSchemes;
   FActiveScheme: TFlexCustomScheme;
   FSelList: TList;
   FInDesign: boolean;
   FViewing: boolean;
   FModified: boolean;
   FIdPool: TIdPool;
   FIdChangeControl: TFlexControl;
   FMouseAnchor: TPoint;
   FMoveStart: TPoint;
   FResizeRect: TRect;
   FMarqueeRect: TRect;
   FCreatingControlClass: TFlexControlClass;
   FShowEditPointGuide: boolean;
   FEditPointGuide: TFlexEditPointGuide;
   FEditPointControl: TFlexControl;
   FEditPointSelected: TSelectedArray;
   FEditPointSelCount: integer;
   FUseOriginalBezier: boolean;
   FWMPaintProcessing: boolean;
   FOnPropBeforeChanged: TPropChangedEvent;
   FOnPropChanged: TPropChangedEvent;
   FOnPaintScheme: TFlexPaintEvent;
   FOnPaintOver: TFlexPaintEvent;
   FOnNotify: TFlexNotifyEvent;
   FOnBeginSelectionUpdate: TNotifyEvent;
   FOnEndSelectionUpdate: TNotifyEvent;
   FOnProgress: TFlexProgressEvent;
   FOnToolMode: TNotifyEvent;
   procedure SetBorderStyle(Value: TBorderStyle);
   procedure SetInDesign(const Value: boolean);
   procedure SetActiveLayer(const Value: TFlexLayer);
   procedure SetActiveScheme(const Value: TFlexCustomScheme);
   function  GetSelected(Index: integer): TFlexControl;
   function  GetSelectedCount: integer;
   procedure SetToolMode(const Value: TFlexToolMode);
   procedure SetCreatingControlClass(const Value: TFlexControlClass);
   procedure SetDocHeight(const Value: integer);
   procedure SetDocWidth(const Value: integer);
   procedure SetDocFrameColor(const Value: TColor);
   procedure SetDocShadowColor(const Value: TColor);
   procedure SetDocSpaceFill(const Value: boolean);
   function  GetDocFrameVisible: boolean;
   procedure SetDocClipping(const Value: boolean);
   procedure SetShowDocFrame(const Value: boolean);
   procedure SetScale(Value: integer);
   function  GetShowGrid: boolean;
   procedure SetShowGrid(const Value: boolean);
   function  GetShowPixGrid: boolean;
   procedure SetShowPixGrid(const Value: boolean);
   function  GetGridHorizSize: integer;
   function  GetGridVertSize: integer;
   procedure SetGridHorizSize(const Value: integer);
   procedure SetGridVertSize(const Value: integer);
   function  GetGridStyle: TFlexGridStyle;
   procedure SetGridStyle(const Value: TFlexGridStyle);
   function  GetSnapToGrid: boolean;
   procedure SetSnapToGrid(const Value: boolean);
   function  GetGridColor: TColor;
   procedure SetGridColor(const Value: TColor);
   procedure SetMarqueeRect(const Value: TRect);
   procedure SetEditPointControl(Value: TFlexControl);
   function  GetDefaultScheme: TFlexCustomScheme;
   function  GetGridPixColor: TColor;
   procedure SetGridPixColor(const Value: TColor);
   procedure DocSpaceBrushChanged(Sender: TObject);
   procedure SetSchemeBkStretch(const Value: boolean);
   function  GetPaintRect: TRect;
   procedure FilerProgress(Sender: TObject; Progress: integer;
     Process: TFlexFilerProcess);
   function  GetControlCount(Control: TFlexControl): integer;
   function  GetEditPointSelected(Index: integer): boolean;
   procedure SetEditPointSelected(Index: integer; Value: boolean);
   function  GetEditPointsCaps: TPathEditFuncs;
   procedure UpdateMouseData;
   function  IsEditCloseFigure: boolean;
   function  CloseFigureByPoint(Index: integer): boolean;
   procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
   procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
   procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
   procedure WMSize(var Message: TWMSize); message WM_SIZE;
   procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
   procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
   procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;
   procedure WMNCCalcSize(var Message: TMessage); message WM_NCCALCSIZE;
    procedure SetShowEditPointGuide(const Value: boolean);
  protected
   FOrigin: TPoint;
   FFilerProcess: TFlexFilerProcess;
   FPaintWidth: integer;
   FPaintHeight: integer;
   FPaintForExport: boolean;
   FPaintSchemeBackground: boolean;
   FInPaintOrigin: TPoint;
   FInPaintScale: integer;
   FScale: integer; { in percents MinScale..MaxScale}
   FZoomingIn: boolean;
   FZoomMouseStart: TPoint;
   FIsPointAlter: boolean;
   FIsOverPoint: boolean;
   FMouseControl: TFlexControl;
   FMouseSubControl: TFlexControl;
   FHintControl: TFlexControl;
   FEditPointIndex: integer;
   FIsLoading: boolean;
   FLoadFunc: TFlexLoadFunc;
   FLastMousePos: TPoint;
   FLastKeyShift: TShiftState;
   FSelRect: TRect;
   FSelUpdateCounter: integer;
   FSelNeedUpdate: boolean;
   FResizeCursor: TResizeCursor;
   FPointsRgn: HRGN;
   FPointsRgnExact: boolean;
   FDragObject: TFlexDragObject;
   FRefPropsList: TPropRefList;
   procedure CreateParams(var Params: TCreateParams); override;
   function  CreateFlexFiler(AStream: TStream;
     Process: TFlexFilerProcess): TFlexFiler;
   procedure DoNotify(Control: TFlexControl; Notify: TFlexNotify);
   function  IsInternalControl(Control: TFlexControl): boolean;
   procedure UpdateCursor; virtual;
   procedure UpdateOrigin;
   procedure UpdateScrollBars;
   procedure Paint(ACanvas: TCanvas; AControl: TFlexControl;
     ChildrenOnly, SelectedOnly: boolean); virtual;
   procedure PaintPoints(ACanvas: TCanvas); virtual;
   function  GetAnchorRect(AControl: TFlexControl): TRect;
   function  GetEditPointRect(Index: integer): TRect;
   function  DoPointEdit(Control: TFlexControl;
     Index, DocX, DocY: integer): boolean;
   function  IsEditPointsVisible: boolean;
   procedure UpdatePoints;
   function  UpdatePointGuide(Region: HRGN = 0): boolean;
   function  UpdatePointTangents(Region: HRGN = 0): boolean;
   procedure UpdateEditPointIndex;
   procedure FindControlPoints(PointIndex: integer; out PrevNode,
     NextNode: integer);
   procedure PaintSelection(ACanvas: TCanvas); virtual;
   procedure PaintMarquee(ACanvas: TCanvas); virtual;
   procedure DoStartDrag(var DragObject: TDragObject); override;
   procedure DragOver(Source: TObject; X, Y: Integer;
     State: TDragState; var Accept: Boolean); override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
     X, Y: Integer); override;
   procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     override;
   procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
   procedure UpdateToolMode(Shift: TShiftState; X, Y: Integer);
   procedure KeyDown(var Key: Word; Shift: TShiftState); override;
   procedure KeyUp(var Key: Word; Shift: TShiftState); override;
   function  ValidateID(Control: TFlexControl; LastID: LongWord): boolean;
   procedure PropBeforeChanged(Sender: TObject; Prop: TCustomProp); virtual;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); virtual;
   function  CreateSelMarkersRgn: HRGN; virtual;
   function  GetSelResizeCursor(PaintX,
     PaintY: integer): TResizeCursor; virtual;
   procedure UpdateSelection(Control: TFlexControl);
   property  Canvas: TCanvas read FCanvas;
   property  MarqueeRect: TRect read FMarqueeRect write SetMarqueeRect;
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure Assign(Source: TPersistent); override;
   procedure Click; override;
   procedure AutoSize;
   procedure PaintTo(ACanvas: TCanvas; const APaintRect: TRect;
    const AOrigin: TPoint; AScale: integer; AControl: TFlexControl;
    Clipping, ChildrenOnly, SelectedOnly, ForExport: boolean;
    AUseOriginalBezier: boolean = false);
   procedure InvalidateDocRect(const DocRect: TRect);
   procedure EmptyDocument;
   procedure NewDocument;
   function  FindControl(const AName: string;
     From: TFlexControl = Nil): TFlexControl;
   function  FindControlByID(ControlID: LongWord;
     From: TFlexControl = Nil): TFlexControl;
   function  FindControlAtPoint(x, y: integer): TFlexControl;
   function  GetDefaultNewName(Control: TFlexControl;
     RootControl: TFlexControl = Nil;
     GenerateNumb: boolean = {$IFNDEF SPEEDUP} true {$ELSE} false {$ENDIF}): string;
   procedure GenerateID(Control: TFlexControl); 
   function  StartDrag(AControl: TFlexControl;
     ChildrenOnly, SelectedOnly: boolean; const MousePos, AOrigin: TPoint;
     AScale: integer; const DragName: string = ''): TFlexDragObject;
   function  CreateDragObject(AControl: TFlexControl;
     ChildrenOnly, SelectedOnly: boolean; DragName: string = ''): TFlexDragObject;
   procedure DragDrop(Source: TObject; X, Y: Integer); override;
   function  LoadFromStream(Stream: TStream): boolean;
   function  LoadFromFile(const Filename: string): boolean;
   function  LoadFromFiler(Filer: TFlexFiler;
     LoadFunc: TFlexLoadFunc): boolean;
   function  LoadFlexControl(Filer: TFlexFiler; AParent: TFlexControl;
     const First: string): TFlexControl;
   function  SaveToFile(const Filename: string): boolean;
   function  SaveToStream(Stream: TStream): boolean;
   function  SaveToFiler(Filer: TFlexFiler; SelectedOnly: boolean = false;
     AControl: TFlexControl = Nil; ChildrenOnly: boolean = false): boolean;
   procedure Print(APrinter: TPrinter; PrintBackground, SelectedOnly: boolean);
   procedure TransformRect(var R: TRect);
   procedure TransformPoint(var px, py: integer); overload;
   procedure TransformPoint(var P: TPoint); overload;
   procedure UnTransformPoint(var px, py: integer);
   procedure BeginSelectionUpdate;
   procedure EndSelectionUpdate;
   function  IsSelected(AControl: TFlexControl): boolean;
   procedure Select(AControl: TFlexControl);
   procedure Unselect(AControl: TFlexControl);
   procedure UnselectAll;
   procedure CopyToClipboard;
   procedure CutToClipboard;
   procedure PasteFromClipboard;
   procedure DeleteSelected;
   procedure BackOne;
   procedure ForwardOne;
   procedure ToBack;
   procedure ToFront;
   procedure Group;
   procedure Ungroup;
   procedure Zoom(AScale: integer; ZoomRect: PRect);
   procedure Rotate(ADegree: integer; AMirror: boolean);
   procedure Translate(var TranslateInfo: TTranslateInfo);
   procedure MoveSelected(ShiftX, ShiftY: integer);
   procedure ResizeSelected(DeltaX, DeltaY: integer;
     Proportional: boolean = false; UseGrid: boolean = true;
     ResizeCursor: TResizeCursor = rcrBottomRight);
   procedure Duplicate(ShiftX, ShiftY: integer);
   procedure AlignSelected(Align: TFlexAlign);
   function  EditPoints(Func: TPathEditFunc;
     Params: PPathEditParams = Nil): boolean;
   function  BreakApartSelected: boolean;
   function  CombineSelected: boolean;
   function  FlattenSelected(const Curvature: single): boolean;
   function  ConvertSelectedToCurves: boolean;
   procedure SelectPoint(Index: integer);
   procedure UnselectPoint(Index: integer);
   procedure UnselectAllPoints;
   procedure DeleteSelectedPoints;
   property  ToolMode: TFlexToolMode read FToolMode write SetToolMode;
   property  Origin: TPoint read FOrigin;
   property  Layers: TFlexLayers read FLayers;
   property  ActiveLayer: TFlexLayer read FActiveLayer write SetActiveLayer;
   property  Schemes: TFlexSchemes read FSchemes;
   property  ActiveScheme: TFlexCustomScheme read FActiveScheme
     write SetActiveScheme;
   property  DefaultScheme: TFlexCustomScheme read GetDefaultScheme;
   property  SelectedCount: integer read GetSelectedCount;
   property  Selected[Index: integer]: TFlexControl read GetSelected;
   property  SelectedRange: TRect read FSelRect;
   property  SelectionUpdateCounter: integer read FSelUpdateCounter;
   property  InDesign: boolean read FInDesign write SetInDesign;
   property  Modified: boolean read FModified write FModified;
   property  IsLoading: boolean read FIsLoading;
   property  PaintWidth: integer read FPaintWidth;
   property  PaintHeight: integer read FPaintHeight;
   property  PaintRect: TRect read GetPaintRect;
   property  PaintForExport: boolean read FPaintForExport;
   property  PaintSchemeBackground: boolean read FPaintSchemeBackground;
   property  DocFrameVisible: boolean read GetDocFrameVisible;
   property  PropRefList: TPropRefList read FRefPropsList;
   property  CreatingControlClass: TFlexControlClass
     read FCreatingControlClass write SetCreatingControlClass;
   property  MouseControl: TFlexControl read FMouseControl;
   property  MouseSubControl: TFlexControl read FMouseSubControl;
   property  EditPointControl: TFlexControl read FEditPointControl
     write SetEditPointControl;
   property  EditPointsCaps: TPathEditFuncs read GetEditPointsCaps;
   property  EditPointSelected[Index: integer]: boolean
     read GetEditPointSelected write SetEditPointSelected;
   property  EditPointSelectedTotal: integer read FEditPointSelCount;
   property  UseOriginalBezier: boolean read FUseOriginalBezier;  
  published
   property  AutoDragEnabled: boolean read FAutoDragEnabled write FAutoDragEnabled;
   property  Scale: integer read FScale write SetScale;
   //property  Viewing: boolean read FViewing write FViewing;
   property  DocWidth: integer read FDocWidth write SetDocWidth;
   property  DocHeight: integer read FDocHeight write SetDocHeight;
   property  DocFrameColor: TColor read FDocFrameColor write SetDocFrameColor;
   property  DocShadowColor: TColor read FDocShadowColor write SetDocShadowColor;
   property  DocSpaceBrush: TBrush read FDocSpaceBrush;
   property  DocSpaceFill: boolean read FDocSpaceFill write SetDocSpaceFill;