flexprops.int

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

   FBuffered: boolean;
   FPictureBuffer: TMemoryStream;
   FLinkName: string;
   FUsePaintBuffer: boolean;
   FDrawing: boolean;
   FOnPaintFastBuffer: TPicturePaintBufferEvent;
   function  GetIsLoaded: boolean;
   function  GetImgRect(Index: integer): TRect;
   function  GetCellSizeRect: TRect;
   function  GetGraphic: TGraphic;
   procedure PictureChange(Sender: TObject);
   procedure SetGraphic(const Value: TGraphic);
   procedure SetColumns(const Value: integer);
   procedure SetRows(const Value: integer);
   procedure SetMaskColor(const Value: TColor);
   procedure SetMasked(const Value: boolean);
   procedure SetBuffered(const Value: boolean);
   procedure SetFastBuffer(const Value: boolean);
   procedure SetLinkName(const Value: string);
   function  StoreGraphic: Boolean;
   function  StoreLinkName: Boolean;
  protected
   FPaintBuffer: TAlphaBuffer;
   procedure SetPropValue(const PropName: string; Value: Variant); override;
   function  GetPropValue(const PropName: string): Variant; override;
   function  GetPropType(const PropName: string): TPropType; override;
   function  GetDisplayValue: string; override;
   function  GetIsRaster: boolean; virtual;
   function  GetFrameBitmap(Graphic: TGraphic; FrameIndex: integer): TBitmap;
     virtual;
   procedure RefreshPaintBuffer;
   procedure PaintBufferStore(Sender: TObject; Canvas: TCanvas;
     Graphic: TGraphic); virtual;
  public
   constructor Create(AOwner: TPropList; const AName: string);
   destructor Destroy; override;
   procedure Draw(Canvas: TCanvas; var R: TRect; FrameIndex: integer;
     ClipTransparent: boolean = false; DestBuffer: TAlphaBuffer = Nil);
   procedure Clear(RemoveLink: boolean = false);
   function  UpdateImageLink: boolean;
   function  CreatePictureFromBuffer: TPicture;
   procedure LoadFromStream(Stream: TStream);
   procedure SaveToStream(Stream: TStream);
   procedure LoadFromFile(const FileName: string);
   procedure SaveToFile(const FileName: string);
   property  Buffered: boolean read FBuffered write SetBuffered;
   property  GraphicClass: TGraphicClass read FGraphicClass;
   property  Width: integer read FWidth;
   property  Height: integer read FHeight;
   property  IsLoaded: boolean read GetIsLoaded;
   property  IsRaster: boolean read GetIsRaster;
   property  ImgRect[Index: integer]: TRect read GetImgRect;
   property  CellSizeRect: TRect read GetCellSizeRect;
   property  OnPaintFastBuffer: TPicturePaintBufferEvent read FOnPaintFastBuffer
     write FOnPaintFastBuffer;
  published
   property  Graphic: TGraphic read GetGraphic write SetGraphic
     stored StoreGraphic;
   property  Columns: integer read FColumns write SetColumns default 1;
   property  Rows: integer read FRows write SetRows default 1;
   property  Masked: boolean read FMasked write SetMasked default False;
   property  MaskColor: TColor read FMaskColor write SetMaskColor
     default clBlack;
   property  LinkName: string read FLinkName write SetLinkName
     stored StoreLinkName;
   property  FastBuffer: boolean read FUsePaintBuffer write SetFastBuffer
     default False;
  end;

  TBackgroundPictureOption = (
    bpOffsetLeft,
    bpOffsetTop,
    bpNewWidth,
    bpNewHeight,
    bpStretchHoriz,
    bpStretchVert,
    bpScaledSize,
    bpCenterHoriz,
    bpCenterVert,
    bpAlignRight,
    bpAlignBottom
  );
  TBackgroundPictureOptions = set of TBackgroundPictureOption;

  TBackgroundOptionsProp = class(TCustomProp)
  private
   FBrushEnabled: boolean;
   FPictureEnabled: boolean;
   FPictureOptions: TBackgroundPictureOptions;
   FTop: Integer;
   FLeft: Integer;
   FWidth: Integer;
   FHeight: Integer;
   function  GetCenter: Boolean;
   function  GetStretch: Boolean;
   procedure SetBrushEnabled(const Value: boolean);
   procedure SetPictureEnabled(const Value: boolean);
   procedure SetPictureOptions(const Value: TBackgroundPictureOptions);
   procedure SetTop(Value: Integer);
   procedure SetLeft(Value: Integer);
   procedure SetWidth(Value: Integer);
   procedure SetHeight(Value: Integer);
   procedure SetStretch(Value: Boolean);
   procedure SetCenter(Value: Boolean);
  protected
   function  GetDisplayValue: string; override;
  public
   constructor Create(AOwner: TPropList; const AName: string);
   function  GetPicturePaintRect(Picture: TPictureProp;
     const BackgroundRect: TRect; Scale: integer): TRect;
   procedure Draw(Canvas: TCanvas; var R: TRect; Picture: TPictureProp;
     Brush: TBrushProp; Scale: integer; const PanelRefreshRect: TRect; 
     ClipTransparent: boolean = false);
   property  Stretch: Boolean read GetStretch write SetStretch default True;
   property  Center: Boolean read GetCenter write SetCenter default False;
  published
   property  PictureEnabled: boolean read FPictureEnabled
     write SetPictureEnabled default True;
   property  BrushEnabled: boolean read FBrushEnabled write SetBrushEnabled
     default True;
   property  PictureOptions: TBackgroundPictureOptions read FPictureOptions
     write SetPictureOptions default [bpStretchHoriz,bpStretchVert,bpScaledSize];
   property  Top: Integer read FTop write SetTop default 0;
   property  Left: Integer read FLeft write SetLeft default 0;
   property  Width: Integer read FWidth write SetWidth default 0;
   property  Height: Integer read FHeight write SetHeight default 0;
  end;

  PPropRefItem = ^TPropRefItem;
  TPropRefItem = record
   Prop: TCustomProp;
   PropName: ShortString;
   Data: PVariant;
  end;

  TGetIDAlias = function(OldID: integer): integer of object;

  TPropRefList = class
  private
   FList: TList;
   FIdExist: TIdPool;
   FIdRecode: TList;
   function  GetCount: integer;
   function  GetPropRefItem(Index: integer): PPropRefItem;
   function  IndexOfRecode(OldID: integer): integer;
  public
   constructor Create;
   destructor Destroy; override;
   function  AddRef(AProp: TCustomProp; const APropName: ShortString;
     AData: PVariant): integer;
   function  AddIDAlias(OldID, NewID: integer): boolean;
   function  GetIDAlias(OldID: integer): integer;
   procedure DeleteRef(Index: integer);
   procedure ResolveRef(Index: integer);
   procedure ResolveAllRefs;
   procedure Clear;
   property  Count: integer read GetCount;
   property  Refs[Index: integer]: PPropRefItem read GetPropRefItem;
  end;

  TPropListDataMode = ( plmNone, plmLoading, plmSaving );

  TPropList = class
  private
   FOwner: TObject;
   FRefList: TPropRefList;
   FPropList: TStringList;
   FNotifyLink: TNotifyLink;
   FHistory: THistory;
   FHistoryIgnoreReadOnly: boolean;
   FHistoryStateForList: THistoryState;
   FPropValueLoading: boolean;
   FOnPropChanged: TPropChangedEvent;
   FOnPropBeforeChanged: TPropChangedEvent;
   FOnPropStored: TPropStoredEvent;
   FOnPropReadOnly: TPropReadOnlyEvent;
   FOnPropHistoryAction: TPropHistoryActionEvent;
   function  GetPropByIndex(Index: integer): TCustomProp;
   function  GetPropsCount: integer;
   function  GetPropByName(const Name: string): TCustomProp;
   function  GetPropName(Index: integer): string;
   function  GetVisibleCount: integer;
   function  GetVisibleProp(Index: integer): TCustomProp;
   function  GetVisiblePropName(Index: integer): string;
   function  GetResolving: boolean;
   function  GetNotifyLink: TNotifyLink;
  protected
   FResolveCount: integer;
   FDataMode: TPropListDataMode;
   FDataModeCount: integer;
   procedure DoBeforeChanged(Prop: TCustomProp);
   procedure DoChanged(Prop: TCustomProp);
   function  DoPropIsStored(Prop: TCustomProp;
     const PropName: string = ''): boolean;
   function  IsNameValid(const AName: string): boolean;
   function  GetComplexPropInstance(Prop: TCustomProp;
     const PropName: string): TCustomProp;
   procedure SavePropValue(Filer: TFlexFiler; const Indent: string;
     Prop: TCustomProp; const PropName: string; IsComplex: boolean);
   procedure SaveComplexProp(Filer: TFlexFiler; Prop: TCustomProp;
     const PropName, Indent: string; ForceSave: boolean = false);
   function  LoadPropValue(Filer: TFlexFiler; ComplexProp: TCustomProp;
     const First: string): TCustomProp;
   function  LoadComplexProp(Filer: TFlexFiler; const First: string;
      Prop: TCustomProp): boolean;
   property  PropValueLoading: boolean read FPropValueLoading;
  public
   constructor Create(AOwner: TObject{TFlexControl});
   destructor Destroy; override;
   function  Assign(PropList: TPropList): Boolean; 
   procedure BeginResolve(ARefList: TPropRefList);
   procedure EndResolve;
   procedure Clear;
   procedure BeginLoading;
   procedure BeginSaving;
   procedure EndLoadSave;
   function  Add(Prop: TCustomProp; const AName: string): integer;
   function  AddLoadedIDAlias(LoadedID, NewID: integer): boolean;
   function  IndexOf(Prop: TCustomProp): integer;
   function  IsReadOnly(Prop: TCustomProp): boolean;
   function  VisibleIndexOf(Prop: TCustomProp): integer;
   function  GetRealIndex(VisibleIndex: integer): integer;
   function  GetVisibleIndex(RealIndex: integer): integer;
   procedure Delete(Index: integer);
   function  SaveProperty(Filer: TFlexFiler; Prop: TCustomProp;
     const Indent: string; PropName: string = '';
     ForceSave: boolean = false): boolean;
   function  LoadProperty(Filer: TFlexFiler; const First: string;
     WithoutBeginLoading: boolean = false): TCustomProp;
   function  SaveToFiler(Filer: TFlexFiler; const Indent: string;
     ForceSave: boolean = false): boolean;
   procedure LoadFromFiler(Filer: TFlexFiler; const First: string;
     RefList: TPropRefList);
   property  Owner: TObject read FOwner;
   property  DataMode: TPropListDataMode read FDataMode;
   property  Count: integer read GetPropsCount;
   property  Props[const Name: string]: TCustomProp read GetPropByName; default;
   property  PropNames[Index: integer]: string read GetPropName;
   property  ByIndex[Index: integer]: TCustomProp read GetPropByIndex;
   property  VisibleCount: integer read GetVisibleCount;
   property  VisibleProps[Index: integer]: TCustomProp read GetVisibleProp;
   property  VisiblePropNames[Index: integer]: string read GetVisiblePropName;
   property  Resolving: boolean read GetResolving;
   property  RefList: TPropRefList read FRefList write FRefList;
   property  NotifyLink: TNotifyLink read GetNotifyLink write FNotifyLink;
   property  History: THistory read FHistory write FHistory;
   property  HistoryIgnoreReadOnly: boolean read FHistoryIgnoreReadOnly
     write FHistoryIgnoreReadOnly;
   property  HistoryStateForList: THistoryState read FHistoryStateForList
     write FHistoryStateForList;
   property  OnPropChanged: TPropChangedEvent read FOnPropChanged
     write FOnPropChanged;
   property  OnPropBeforeChanged: TPropChangedEvent read FOnPropBeforeChanged
     write FOnPropBeforeChanged;
   property  OnPropStored: TPropStoredEvent read FOnPropStored
     write FOnPropStored;
   property  OnPropReadOnly: TPropReadOnlyEvent read FOnPropReadOnly
     write FOnPropReadOnly;
   property  OnPropHistoryAction: TPropHistoryActionEvent
     read FOnPropHistoryAction write FOnPropHistoryAction;
  end;

var
  ResolvePictureLink: TPictureLinkResolve;
  ResolveBitmapLink: TBitmapLinkResolve;

  GeometricPenChecked: boolean;
  GeometricPenEnabled: boolean;

procedure RegisterDefaultPropEditForm(PropClass: TCustomPropClass;
  EditFormClass: TEditFormClass);

implementation