flexcontrols.int

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

/////////////////////////////////////////////////////////
//                                                     //
//    FlexGraphics library                             //
//    Copyright (c) 2002-2009, FlexGraphics software.  //
//                                                     //
//    Common controls classes                          //
//                                                     //
/////////////////////////////////////////////////////////

unit FlexControls;

{$I FlexDefs.inc}

interface

uses
  Windows, Classes, Graphics, Controls, StdCtrls, SysUtils, 
  {$IFDEF FG_D6} Variants, {$ENDIF}
  FlexBase, FlexProps, FlexUtils, FlexPath, FlexHistory, FlexActions;

type
  TFlexBox = class(TFlexControl)
  private
   FAlwaysFilled: boolean;
   FBrushProp: TBrushProp;
   FPenProp: TPenProp;
   FRoundnessProp: TIntProp;
  protected
   procedure CreateProperties; override;
   procedure ControlCreate; override;
   procedure ControlTranslate(const TranslateInfo: TTranslateInfo); override;
   function  CreateCurveControl: TFlexControl; override;
   function  CreateBoxRegion(const PaintRect: TRect;
     Inflate: boolean = false): HRGN;
   procedure Paint(Canvas: TCanvas; var PaintRect: TRect); override;
   function  GetAnchorPoint: TPoint; override;
   function  GetRefreshRect(RefreshX, RefreshY: integer): TRect; override;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); override;
   procedure PropStored(Sender: TObject; Prop: TCustomProp;
     var IsStored: boolean; const PropName: string = ''); override;
   function  GetDefaultLinkPoint(Index: integer): TPoint; override;
   function  GetDefaultLinkPointCount: integer; override;
  public
   class function CursorInCreate: TCursor; override;
   function  IsPointInside(PaintX, PaintY: integer): boolean; override;
   property  BrushProp: TBrushProp read FBrushProp;
   property  PenProp: TPenProp read FPenProp;
   property  RoundnessProp: TIntProp read FRoundnessProp;
  end;

  TFlexEllipse = class(TFlexControl)
  private
   function  GetCeneter: TPoint;
  protected
   FBrushProp: TBrushProp;
   FPenProp: TPenProp;
   FBeginAngleProp: TIntProp;
   FEndAngleProp: TIntProp;
   FArcAxesProp: TStrProp;
   FPoints: TPointArray;
   FEditing: boolean;
   FPointTypes: TPointTypeArray;
   FPathInfo: TPathInfo;
   FUseAxes: boolean;
   FArcOldFormatNeedCheck: boolean;
   FArcOldFormatNeedReset: boolean;
   FArcOldFormat: boolean;
   FArcOfs: TPoint;
   FArcSize: TPoint;
   FArcResizing: boolean;
   FArcResizingBounds: TRect;
   function  CreateEllipseRegion(const PaintRect: TRect): HRGN;
   procedure CreateProperties; override;
   procedure ControlCreate; override;
   procedure ControlTranslate(const TranslateInfo: TTranslateInfo); override;
   procedure MirrorInResize(HMirror, VMirror: boolean); override;
   function  CreateCurveControl: TFlexControl; override;
   function  GetPoint(Index: integer): TPoint; override;
   function  GetPointCount: integer; override;
   function  GetPointsInfo: PPathInfo; override;
   procedure SetPoint(Index: integer; const Value: TPoint); override;
   procedure MakeArc(DC: HDC; const R: TRect; const Pt: TPointArray);
   procedure Paint(Canvas: TCanvas; var PaintRect: TRect); override;
   function  GetRefreshRect(RefreshX, RefreshY: integer): TRect; override;
   function  GetAnchorPoint: TPoint; override;
   function  GetDefaultLinkPoint(Index: integer): TPoint; override;
   function  GetDefaultLinkPointCount: integer; override;
   procedure PropStored(Sender: TObject; Prop: TCustomProp;
     var IsStored: boolean; const PropName: string = ''); override;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); override;
   procedure PropHistoryAction(Sender: TObject; Prop: TCustomProp;
     var ActionClass: THistoryActionClass); override;
   procedure DoNotify(Notify: TFlexNotify); override;
   procedure StartResizing(const SelRect: TRect); override;
   procedure SetPointsByAngles;
   procedure SetAnglesByPoints;
   function  GetIsPie: boolean;
   function  IsPropUpdatePoints(Prop: TCustomProp): boolean; virtual;
   function  GetIsNeedHistoryPointsAction: boolean;
   procedure UpdateArcBoundsByPoints; virtual;
   procedure SetUseAxes(Value: boolean); virtual;
   procedure GetArcAxes(Sender: TObject; out s: string); virtual;
   procedure SetArcAxes(const s: string); virtual;
   property  UseAxes: boolean read FUseAxes write SetUseAxes;
  public
   class function CursorInCreate: TCursor; override;
   function  IsPointInside(PaintX, PaintY: integer): boolean; override;
   function  EditPoints(Func: TPathEditFunc; const Selected: TSelectedArray;
     Params: PPathEditParams = Nil): boolean; override;
   function  EditPointsCaps(const Selected: TSelectedArray): TPathEditFuncs;
     override;
   property  Center: TPoint read GetCeneter;
   property  IsPie: boolean read GetIsPie;
   property  IsNeedHistoryPointsAction: boolean
     read GetIsNeedHistoryPointsAction;
   property  BrushProp: TBrushProp read FBrushProp;
   property  PenProp: TPenProp read FPenProp;
   property  BeginAngleProp: TIntProp read FBeginAngleProp;
   property  EndAngleProp: TIntProp read FEndAngleProp;
  end;

  TFlexArc = class(TFlexEllipse);

  TFlexPicture = class(TFlexControl)
  private
   FAutoSizeProp: TBoolProp;
   FPictureProp: TPictureProp;
   FFrameIndexProp: TIntProp;
  protected
   procedure CreateProperties; override;
   procedure ControlCreate; override;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); override;
   procedure PropStored(Sender: TObject; Prop: TCustomProp;
     var IsStored: boolean; const PropName: string = ''); override;
   procedure Paint(Canvas: TCanvas; var PaintRect: TRect); override;
   procedure PaintAll(Canvas: TCanvas; PaintX, PaintY: integer); override;
   function  GetDefaultLinkPoint(Index: integer): TPoint; override;
   function  GetDefaultLinkPointCount: integer; override;
  public
   class function CursorInCreate: TCursor; override;
   function  IsPointInside(PaintX, PaintY: integer): boolean; override;
   property  PictureProp: TPictureProp read FPictureProp;
   property  FrameIndexProp: TIntProp read FFrameIndexProp;
   property  AutoSizeProp: TBoolProp read FAutoSizeProp;
  end;

  TFlexCurve = class(TFlexControl)
  private
   FBrushProp: TBrushProp;
   FPenProp: TPenProp;
   FBeginCapProp: TLineCapProp;
   FEndCapProp: TLineCapProp;
   FPointsProp: TDataProp;
   FPathPointsProp: TDataProp; // Points in new format (coords + types)
   FIsSolidProp: TBoolProp;
  protected
   FPoints: TPointArray;
   FZeroPoints: boolean;
   FPointTypes: TPointTypeArray;
   FChanging: boolean;
   FCurveInfo: TPathInfo;
   FCurveInfoChanged: boolean;
   FResizePoints: TPointArray;
   procedure CreateProperties; override;
   procedure ControlCreate; override;
   procedure ControlDestroy; override;
   procedure ControlTranslate(const TranslateInfo: TTranslateInfo); override;
   procedure CreateInDesign(var Info: TFlexCreateInDesignInfo); override;
   procedure MirrorInResize(HMirror, VMirror: boolean); override;
   function  MovePathPoints(PointIndex: integer; var Delta: TPoint;
    Selected: TSelectedArray; Smooth: boolean = false;
    Symmetric: boolean = false): boolean; override;
   function  MovePathSegment(FirstIndex, NextIndex: integer;
     var Delta: TPoint; const SegmentCurvePos: double): boolean; override;
   function  RecordPointsAction: TPointsHistoryAction; virtual;
   function  GetPoint(Index: integer): TPoint; override;
   function  GetPointCount: integer; override;
   procedure SetPoint(Index: integer; const Value: TPoint); override;
   function  GetPointType(Index: integer): TPointType; override;
   procedure SetPointType(Index: integer; const Value: TPointType); override;
   procedure PointsChanged; virtual;
   function  GetAnchorPoint: TPoint; override;
   procedure StartResizing(const SelRect: TRect); override;
   procedure FinishResizing; override;
   procedure Paint(Canvas: TCanvas; var PaintRect: TRect); override;
   procedure DoNotify(Notify: TFlexNotify); override;
   procedure PropChanged(Sender: TObject; Prop: TCustomProp); override;
   procedure PropStored(Sender: TObject; Prop: TCustomProp;
     var IsStored: boolean; const PropName: string = ''); override;
   procedure GetPointsData(Sender: TObject; var Value: Variant);
   procedure SetPointsData(Sender: TObject; var Value: Variant);
   procedure GetPathPointsData(Sender: TObject; var Value: Variant);
   procedure SetPathPointsData(Sender: TObject; var Value: Variant);
   function  GetIsPointsClosed: boolean; override;
   procedure SetIsPointsClosed(Value: boolean); override;
   //procedure SetDocRect(Value: TRect); override;
   function  GetRefreshRect(RefreshX, RefreshY: integer): TRect; override;
   function  InternalInsertPoints(Index, Count: integer): integer;
   procedure InternalDeletePoints(Index, Count: integer);
   function  GetPointsInfo: PPathInfo; override;
   function  GetDefaultLinkPoint(Index: integer): TPoint; override;
   function  GetDefaultLinkPointCount: integer; override;
  public
   function  EndUpdate: boolean; override;
   class function CursorInCreate: TCursor; override;
   function  IsPointInside(PaintX, PaintY: integer): boolean; override;
   function  InsertPoint(Index: integer; const Point: TPoint): integer; override;
   function  InsertNearestPoint(const Point: TPoint): integer; override;
   function  InsertCurvePoints(Index: integer; const Point,
     CtrlPointA, CtrlPointB: TPoint): integer; override;
   procedure DeletePoint(Index: integer); override;
   procedure SetPointsEx(const APoints: TPointArray;
     const ATypes: TPointTypeArray); override;
   procedure GetPointsEx(out APoints: TPointArray;
     out ATypes: TPointTypeArray); override;
   function  FlattenPoints(const Curvature: single): boolean; override;
   function  FindNearestPoint(const Point: TPoint;
     var Nearest: TNearestPoint): boolean; override;
   function  FindNearestPathSegment(const Point: TPoint; var FirstIndex,
     NextIndex: integer; Nearest: PNearestPoint = Nil;
     ForInsert: boolean = true; ForSelect: boolean = false): boolean; override;
   function  EditPoints(Func: TPathEditFunc; const Selected: TSelectedArray;
     Params: PPathEditParams = Nil): boolean; override;
   function  EditPointsCaps(const Selected: TSelectedArray): TPathEditFuncs;
     override;
   property  BrushProp: TBrushProp read FBrushProp;
   property  PenProp: TPenProp read FPenProp;
   property  BeginCapProp: TLineCapProp read FBeginCapProp;
   property  EndCapProp: TLineCapProp read FEndCapProp;
   property  IsSolidProp: TBoolProp read FIsSolidProp;
  end;

  TTextCharWidth = array[0..255] of integer;
  TTextCharABCs = array[0..255] of TABC;

  PTextWordInfo = ^TTextWordInfo;
  TTextWordInfo = record
   WordBegin, WordEnd: integer;
   Size: integer;
  end;

  PTextLine = ^TTextLine;
  TTextLine = record
   Text: PChar;
   Length: integer;
   Pos: integer;
  end;

  TTextWordInfoArray = array of TTextWordInfo;

  TTextFormator = class
  private
   FLogFont: TLogFont;
   FLogFontValid: boolean;
   FCharWidth: TTextCharWidth;
   FCharABC: TTextCharABCs;
   FEMSquare: integer;
   FPixelSize: double;
   FHeight: integer;
   FLineSpace: integer;
   // Current line