flexprops.int

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

   function  GetValueByIndex(Index: integer): string;
   procedure SetValue(const Name, Value: string);
   procedure SetValueByIndex(Index: integer; const Value: string);
   procedure SetName(Index: integer; const Value: string);
  protected
   function  GetDisplayValue: string; override;
   procedure SetPropValue(const PropName: string; Value: Variant); override;
   function  GetPropValue(const PropName: string): Variant; override;
  public
   constructor Create(AOwner: TPropList; const AName: string);
   destructor Destroy; override;
   procedure Assign(Source: TStrings);
   procedure AssignTo(Dest: TStrings);
   procedure Clear;
   function  Add(const s: string): integer;
   function  Insert(Index: Integer; const S: string): boolean;
   procedure Delete(Index: integer);
   procedure RemoveByName(const Name: string);
   function  IndexOf(const s: string): integer;
   function  IndexOfName(const s: string): integer;
   property  LinesCount: integer read GetLinesCount;
   property  Lines[Index: integer]: string read GetLine write SetLine; default;
   property  Names[Index: integer]: string read GetName write SetName;
   property  Values[const Name: string]: string read GetValue write SetValue;
   property  ValuesByIndex[Index: integer]: string read GetValueByIndex
     write SetValueByIndex;
   property  Text: TCaption read GetText write SetText;
  end;

  TUserDataProp = class(TStrListProp);

  TPropDataEvent = procedure(Sender: TObject; var Value: Variant) of object;

  TDataProp = class(TCustomProp)
  private
   FOnGetPropData: TPropDataEvent;
   FOnSetPropData: TPropDataEvent;
  protected
   function  GetDisplayValue: string; override;
   procedure SetPropValue(const PropName: string; Value: Variant); override;
   function  GetPropValue(const PropName: string): Variant; override;
  public
   constructor Create(AOwner: TPropList; const AName: string);
   property  OnGetPropData: TPropDataEvent read FOnGetPropData
     write FOnGetPropData;
   property  OnSetPropData: TPropDataEvent read FOnSetPropData
     write FOnSetPropData;
  end;

  TBrushMethod = ( bmHatch, bmGradient, bmBitmap );

  TBrushProp = class(TCustomProp)
  private
   FBrush: TBrush;
   FMethod: TBrushMethod;
   FGradStyle: TGradientStyle;
   FGradBeginColor: TColor;
   FGradEndColor: TColor;
   FBitmap: TBitmap;
   FCache: TTiledBitmapCache;
   FBitmapLinkName: string;
   FBitmapMasked: boolean;
   FBitmapMaskColor: TColor;
   FBitmapCache: boolean;
   FBitmapDisplay: TBitmapDisplay;
   function  GetColor: TColor;
   function  GetStyle: TBrushStyle;
   procedure SetColor(const Value: TColor);
   procedure SetStyle(const Value: TBrushStyle);
   procedure SetGradBeginColor(const Value: TColor);
   procedure SetGradEndColor(const Value: TColor);
   procedure SetGradStyle(const Value: TGradientStyle);
   function  GetIsPaintAlternate: boolean;
   procedure SetBitmap(const Value: TBitmap);
   procedure SetBitmapMaskColor(const Value: TColor);
   procedure SetBitmapMasked(const Value: boolean);
   procedure SetBitmapCache(const Value: boolean);
   procedure SetBitmapDisplay(const Value: TBitmapDisplay);
   procedure SetBitmapLinkName(const Value: string);
   procedure SetMethod(const Value: TBrushMethod);
   function  GetIsClear: boolean;
   function  StoreBitmap: Boolean;
   function  StoreBitmapLinkName: Boolean;
  protected
   function  GetPropType(const PropName: string): TPropType; override;
   function  GetPropValue(const PropName: string): Variant; override;
   procedure SetPropValue(const PropName: string; Value: Variant); override;
   function  GetDisplayValue: string; override;
   procedure BitmapChange(Sender: TObject); virtual;
   procedure ResetCache;
  public
   constructor Create(AOwner: TPropList; const AName: string);
   destructor Destroy; override;
   procedure InitBitmap(Width: integer = 0; Height: integer = 0);
   procedure FreeBitmap;
   function  UpdateBitmapLink: boolean;
   procedure Setup(Canvas: TCanvas; Scale: integer = 100); override;
   procedure Translate(const TranslateInfo: TTranslateInfo); virtual;
   procedure PaintAlternate(Canvas: TCanvas; var PaintRect: TRect;
     const RefreshRect: TRect; Scale: integer = 100;
     ClipTransparent: boolean = false);
   property  IsPaintAlternate: boolean read GetIsPaintAlternate;
   property  IsClear: boolean read GetIsClear;
  published
   property  Method: TBrushMethod read FMethod write SetMethod
     default bmHatch;
   property  Color: TColor read GetColor write SetColor default clNone;
   property  Style: TBrushStyle read GetStyle write SetStyle default bsSolid;
   property  Bitmap: TBitmap read FBitmap write SetBitmap stored StoreBitmap;
   property  BitmapLinkName: string read FBitmapLinkName
     write SetBitmapLinkName stored StoreBitmapLinkName;
   property  BitmapMasked: boolean read FBitmapMasked write SetBitmapMasked
     default False;
   property  BitmapMaskColor: TColor read FBitmapMaskColor
     write SetBitmapMaskColor default clBlack;
   property  BitmapCache: boolean read FBitmapCache write SetBitmapCache
     default False;
   property  BitmapDisplay: TBitmapDisplay read FBitmapDisplay
     write SetBitmapDisplay default bdTile;
   property  GradStyle: TGradientStyle read FGradStyle write SetGradStyle
     default gsHorizontal;
   property  GradBeginColor: TColor read FGradBeginColor write SetGradBeginColor
     default clBlack;
   property  GradEndColor: TColor read FGradEndColor write SetGradEndColor
     default clBlack;
  end;

  TLineCapProp = class(TCustomProp)
  private
   FCapStyle: integer;
   FFixedSize: boolean;
   FSize: integer;
   FFixedOutlineColor: boolean;
   FOutlineColor: TColor;
   FFixedFillColor: boolean;
   FFillColor: TColor;
   procedure SetCapStyle(const Value: integer);
   procedure SetFillColor(const Value: TColor);
   procedure SetFixedFillColor(const Value: boolean);
   procedure SetFixedOutlineColor(const Value: boolean);
   procedure SetFixedSize(const Value: boolean);
   procedure SetOutlineColor(const Value: TColor);
   procedure SetSize(const Value: integer);
  protected
   function  GetDisplayValue: string; override;
  public
   constructor Create(AOwner: TPropList; const AName: string);
   destructor Destroy; override;
   function   GetActiveSize(PenWidth: integer;
     PixelSize: integer = PixelScaleFactor): integer;
  published
   property  CapStyle: integer read FCapStyle write SetCapStyle
     default psNoCap;
   property  FixedSize: boolean read FFixedSize write SetFixedSize
     default False;
   property  Size: integer read FSize write SetSize default DefaultLineCapSize;
   property  FixedOutlineColor: boolean read FFixedOutlineColor
     write SetFixedOutlineColor default False;
   property  OutlineColor: TColor read FOutlineColor write SetOutlineColor
     default clBlack;
   property  FixedFillColor: boolean read FFixedFillColor
     write SetFixedFillColor default False;
   property  FillColor: TColor read FFillColor write SetFillColor
     default clWhite;
  end;

  TPenEndCap = (
   pecFlat,
   pecSquare,
   pecRound
  );

  TPenJoin = (
   pjBevel,
   pjMiter,
   pjRound
  );

  TPenProp = class(TCustomProp)
  private
   function  GetActiveWidth: integer;
   procedure SetColor(const Value: TColor);
   procedure SetStyle(const Value: TPenStyle);
   procedure SetWidth(const Value: integer);
   procedure SetMode(const Value: TPenMode);
   procedure SetEndCap(const Value: TPenEndCap);
   procedure SetJoin(const Value: TPenJoin);
   procedure SetSolidAsInside(const Value: boolean);
  protected
   FStyle: TPenStyle;
   FColor: TColor;
   FMode: TPenMode;
   FWidth: integer;
   FEndCap: TPenEndCap;
   FJoin: TPenJoin;
   FSolidAsInside: boolean;
   function  GetDisplayValue: string; override;
  public
   constructor Create(AOwner: TPropList; const AName: string);
   procedure Setup(Canvas: TCanvas; Scale: integer = 100); override;
   procedure GetPaintData(var AWidth: integer; var AStyle: TPenStyle;
     var IsGeometricPen: boolean; Scale: integer = 100);
   property  ActiveWidth: integer read GetActiveWidth;
  published
   property  Color: TColor read FColor write SetColor default clBlack;
   property  Style: TPenStyle read FStyle write SetStyle default psSolid;
   property  Mode: TPenMode read FMode write SetMode default pmCopy;
   property  Width: integer read FWidth write SetWidth
     default PixelScaleFactor;
   property  EndCap: TPenEndCap read FEndCap write SetEndCap default pecRound;
   property  Join: TPenJoin read FJoin write SetJoin default pjRound;
   property  SolidAsInside: boolean read FSolidAsInside write SetSolidAsInside
     default True;
  end;

  TFontProp = class(TCustomProp)
  private
   FFont: TFont;
   FFontHeight: integer;
   function  GetCharset: TFontCharset;
   function  GetHandle: HFont;
   function  GetSize: Integer;
   function  GetName: TFontName;
   function  GetPitch: TFontPitch;
   function  GetStyle: TFontStyles;
   function  GetColor: TColor;
   function  GetPixelsPerInch: Integer;
   procedure SetCharset(const Value: TFontCharset);
   procedure SetColor(const Value: TColor);
   procedure SetHandle(const Value: HFont);
   procedure SetHeight(const Value: Integer);
   procedure SetName(const Value: TFontName);
   procedure SetPitch(const Value: TFontPitch);
   procedure SetSize(const Value: Integer);
   procedure SetStyle(const Value: TFontStyles);
   procedure SetPixelsPerInch(const Value: Integer);
  protected
   function  GetDisplayValue: string; override;
  public
   constructor Create(AOwner: TPropList; const AName: string);
   destructor Destroy; override;
   procedure Setup(Canvas: TCanvas; Scale: integer = 100); override;
   function  Edit: boolean; override;
   procedure GetFont(var AFont: TFont);
   procedure SetFont(const AFont: TFont);
   property  Handle: HFont read GetHandle write SetHandle;
  published
   property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch
     stored False;
   property Charset: TFontCharset read GetCharset write SetCharset
     default DEFAULT_CHARSET;
   property Color: TColor read GetColor write SetColor
     default clBlack;
   property Height: Integer read FFontHeight write SetHeight stored False;
   property Name: TFontName read GetName write SetName;
   property Pitch: TFontPitch read GetPitch write SetPitch
     default fpDefault;
   property Size: Integer read GetSize write SetSize;
   property Style: TFontStyles read GetStyle write SetStyle default [];
  end;

  TPicturePaintBufferEvent = procedure(Sender: TObject; Buffer: TAlphaBuffer;
    Canvas: TCanvas; Graphic: TGraphic; var DrawDefault: boolean) of object;

  TPictureProp = class(TCustomProp)
  private
   FPicture: TPicture;
   FGraphicClass: TGraphicClass;
   FEmpty: boolean;
   FWidth: integer;
   FHeight: integer;
   FColumns: integer;
   FRows: integer;
   FMasked: boolean;
   FMaskColor: TColor;