cxgraphics.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,593 行 · 第 1/5 页

PAS
1,593
字号
    constructor Create; override;
    constructor CreateSize(const ARect: TRect); overload;
    constructor CreateSize(AWidth, AHeight: Integer); overload;
    constructor CreateSize(const ARect: TRect; APixelFormat: TPixelFormat); overload;
    constructor CreateSize(AWidth, AHeight: Integer; APixelFormat: TPixelFormat); overload; virtual;
    destructor Destroy; override;

    procedure BeginUpdate;
    procedure EndUpdate(AForceUpdate: Boolean = True);

    procedure CopyBitmap(ABitmap: TBitmap; ACopyMode: DWORD = SRCCOPY); overload;
    procedure CopyBitmap(ABitmap: TBitmap; const ADestRect: TRect; const ASrcTopLeft: TPoint; ACopyMode: DWORD = SRCCOPY); overload;
    procedure Clear; virtual;
    procedure Rotate(ARotationAngle: TcxRotationAngle; AFlipVertically: Boolean = False);
    procedure SetSize(AWidth, AHeight: Integer); {$IFDEF DELPHI10}override;{$ELSE}virtual;{$ENDIF}

    property CompressData: Boolean read FCompressData write FCompressData;
    property ClientRect: TRect read GetClientRect;
    property cxCanvas: TcxCanvas read FcxCanvas;
  end;

  { TcxBitmap }

  TRGBColors = array of TRGBQuad;
  TcxImageDrawMode = (idmNormal, idmDisabled, idmFaded, idmGrayScale, idmDingy, idmShadowed);
  TcxBitmapTransformationMode = (btmDingy, btmDirty, btmGrayScale, btmSetOpaque, btmMakeMask, btmFade, btmDisable, btmCorrectBlend, btmHatch, btmClear, btmResetAlpha);
  TcxBitmapTransformationProc = procedure(var AColor: TRGBQuad) of object;
  TcxDrawImageProc = function (ACanvas: TCanvas; AImages: TCustomImageList; AImageIndex: Integer; AGlyph: TBitmap; ARect: TRect; ADrawMode: TcxImageDrawMode): Boolean;

  TcxColorTransitionMap = record
    RedScale: Single;
    GreenScale: Single;
    BlueScale: Single;
    SrcAlpha: Byte;
    SrcConstantAlpha: Byte;
  end;

  TcxHatchData = record
    Color1: TRGBQuad;
    Alpha1: Byte;
    Color2: TRGBQuad;
    Alpha2: Byte;
    Step: Byte;
  end;

  TcxColorList = class(TList)
  public
    function Add(AColor: TColor): Integer;
  end;

  TcxBitmap = class(TcxCustomBitmap)
  private
    FBitmapInfo: TBitmapInfo;
    FTransparentBkColor: TRGBQuad;
    FTransparentPixels: TcxColorList;

    FCurrentColorIndex: TPoint;
    FHatchData: TcxHatchData;

    function GetIsAlphaUsed: Boolean;

    procedure CorrectBlend(var AColor: TRGBQuad);
    procedure ClearColor(var AColor: TRGBQuad);
    procedure Dingy(var AColor: TRGBQuad);
    procedure Dirty(var AColor: TRGBQuad);
    procedure Disable(var AColor: TRGBQuad);
    procedure Fade(var AColor: TRGBQuad);
    procedure GrayScale(var AColor: TRGBQuad);
    procedure Hatch(var AColor: TRGBQuad);
    procedure MakeMask(var AColor: TRGBQuad);
    procedure SetOpaque(var AColor: TRGBQuad);
    procedure ResetAlpha(var AColor: TRGBQuad);

    procedure Scale(var AColor: TRGBQuad; const AColorMap: TcxColorTransitionMap);

    procedure UpdateBitmapInfo;

    function IsColorTransparent(const AColor: TRGBQuad): Boolean;
  protected
    procedure Initialize(AWidth, AHeight: Integer; APixelFormat: TPixelFormat); override;
    procedure Update; override;

    property HatchData: TcxHatchData read FHatchData write FHatchData;
    property TransparentBkColor: TRGBQuad read FTransparentBkColor write FTransparentBkColor;
    property TransparentPixels: TcxColorList read FTransparentPixels;
  public
    constructor CreateSize(AWidth, AHeight: Integer; APixelFormat: TPixelFormat); override;
    constructor CreateSize(AWidth, AHeight: Integer; ATransparentBkColor: TRGBQuad); overload;
    destructor Destroy; override;

    procedure GetBitmapColors(out AColors: TRGBColors);
    procedure SetBitmapColors(const AColors: TRGBColors);

    procedure AlphaBlend(ABitmap: TcxBitmap; const ARect: TRect; ASmoothImage: Boolean; AConstantAlpha: Byte = $FF);
    procedure Clear; override;
    procedure DrawHatch(const AHatchData: TcxHatchData); overload;
    procedure DrawHatch(AColor1, AColor2: TColor; AStep: Byte; AAlpha1: Byte = $FF; AAlpha2: Byte = $FF); overload;
    procedure DrawShadow(AMaskBitmap: TcxBitmap; AShadowSize: Integer; AShadowColor: TColor; AInflateSize: Boolean = False);
    procedure Filter(AMaskBitmap: TcxBitmap);
    procedure Invert;
    procedure MakeOpaque;
    procedure RecoverAlphaChannel(ATransparentColor: TColor);
    procedure SetSize(AWidth, AHeight: Integer); override;
    procedure Shade(AMaskBitmap: TcxBitmap);

    procedure TransformBitmap(AMode: TcxBitmapTransformationMode);

    property IsAlphaUsed: Boolean read GetIsAlphaUsed;
  end;

  TcxImageInfo = class(TPersistent)
  private
    FImage: TBitmap;
    FMask: TBitmap;
    FMaskColor: TColor;

    procedure AssignBitmap(ASourceBitmap, ADestBitmap: TBitmap);
  protected
    procedure SetImage(Value: TBitmap); virtual;
    procedure SetMask(Value: TBitmap); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    property Image: TBitmap read FImage write SetImage;
    property Mask: TBitmap read FMask write SetMask;
    property MaskColor: TColor read FMaskColor write FMaskColor;
  end;

  TcxImageList = class(TDragImageList)
  private
    FAlphaBlending: Boolean;
    FFormatVersion: Integer;
    FImages: TCollection;
    FLockCount: Integer;
    FSynchronization: Boolean;

    function GetCompressData: Boolean;
    procedure SetCompressData(Value: Boolean);

    function GetHandle: HImageList;
    procedure SetHandle(Value: HImageList);

    procedure ReadFormatVersion(AReader: TReader);
    procedure WriteFormatVersion(AWriter: TWriter);
    procedure ReadImageInfo(AReader: TReader);
    procedure WriteImageInfo(AWriter: TWriter);
    procedure ReadDesignInfo(AReader: TReader);
    procedure WriteDesignInfo(AWriter: TWriter);
    function NeedSynchronizeImageInfo: Boolean;
    procedure SynchronizeImageInfo;
    procedure SynchronizeHanle;

    procedure AddToInternalCollection(AImage, AMask: TBitmap; AMaskColor: TColor = clNone);
    procedure DormantImage(AIndex: Integer);
    function GetImageHandle(AImage: TBitmap): Integer;
    class function GetPixelFormat(AHandle: HIMAGELIST): Integer;
  protected
    function ChangeLocked: Boolean;
    procedure Change; override;
    procedure DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer;
      Style: Cardinal; Enabled: Boolean = True); override;
    procedure DoDrawEx(AIndex: Integer; ACanvas: TCanvas;
      const ARect: TRect; AStyle: Cardinal; AStretch, ASmoothResize, AEnabled: Boolean);

    procedure Initialize; override;
    procedure Finalize;
    procedure DefineProperties(Filer: TFiler); override;
    procedure Dormant;

    // for cxImageListEditor
    procedure AddImageInfo(AImageInfo: TcxImageInfo);
    procedure InternalCopyImageInfos(AImageList: TcxImageList; AStartIndex, AEndIndex: Integer);
    procedure InternalCopyImages(AImageList: TCustomImageList; AStartIndex, AEndIndex: Integer);
    procedure GetImageInfo(AIndex: Integer; AImageInfo: TcxImageInfo); overload;
  public
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    // BaseFunctions
    function Add(AImage, AMask: TBitmap): Integer;
    function AddIcon(AIcon: TIcon): Integer;
    function AddMasked(AImage: TBitmap; AMaskColor: TColor): Integer;
    procedure Move(ACurIndex, ANewIndex: Integer);
    procedure Delete(AIndex: Integer);

    // SubsidiaryFunctions
    function AddImage(AValue: TCustomImageList; AIndex: Integer): Integer;
    procedure AddImages(AImageList: TCustomImageList);
    procedure CopyImages(AImageList: TCustomImageList; AStartIndex: Integer = 0; AEndIndex: Integer = -1);
    procedure Clear;
    procedure Insert(AIndex: Integer; AImage, AMask: TBitmap);
    procedure InsertIcon(AIndex: Integer; AIcon: TIcon);
    procedure InsertMasked(AIndex: Integer; AImage: TBitmap; AMaskColor: TColor);
    procedure Replace(AIndex: Integer; AImage, AMask: TBitmap);
    procedure ReplaceIcon(AIndex: Integer; AIcon: TIcon);
    procedure ReplaceMasked(AIndex: Integer; AImage: TBitmap; AMaskColor: TColor);

    function LoadImage(AInstance: THandle; const AResourceName: string;
      AMaskColor: TColor = clDefault; AWidth: Integer = 0; AFlags: TLoadResources = []): Boolean;
    function GetResource(AResType: TResType; const AName: string;
      AWidth: Integer; ALoadFlags: TLoadResources; AMaskColor: TColor): Boolean;
    function GetInstRes(AInstance: THandle; AResType: TResType; const AName: string;
      AWidth: Integer; ALoadFlags: TLoadResources; AMaskColor: TColor): Boolean; overload;
    function GetInstRes(AInstance: THandle; AResType: TResType; AResID: DWORD;
      AWidth: Integer; ALoadFlags: TLoadResources; AMaskColor: TColor): Boolean; overload;
    function ResourceLoad(AResType: TResType; const AName: string;
      AMaskColor: TColor): Boolean;
    function ResInstLoad(AInstance: THandle; AResType: TResType;
      const AName: string; AMaskColor: TColor): Boolean;

    procedure BeginUpdate;
    procedure EndUpdate(AForceUpdate: Boolean = True);

  {$IFNDEF DELPHI6}
    procedure Draw(ACanvas: TCanvas; X, Y, AIndex: Integer;
      ADrawingStyle: TDrawingStyle; AImageType: TImageType;
      AEnabled: Boolean = True); overload;
  {$ENDIF}
    procedure Draw(ACanvas: TCanvas; const ARect: TRect; AIndex: Integer;
      AStretch: Boolean = True; ASmoothResize: Boolean = False; AEnabled: Boolean = True); overload;

    procedure GetImageInfo(AIndex: Integer; AImage, AMask: TBitmap); overload;
    procedure GetImage(AIndex: Integer; AImage: TBitmap);
    procedure GetMask(AIndex: Integer; AMask: TBitmap);

    class procedure GetImageInfo(AHandle: HIMAGELIST; AIndex: Integer; AImage, AMask: TBitmap); overload;
    property AlphaBlending: Boolean read FAlphaBlending write FAlphaBlending;
    property Handle: HImageList read GetHandle write SetHandle;
  published
    property BlendColor;
    property BkColor;
    property CompressData: Boolean read GetCompressData write SetCompressData default False;
    property DrawingStyle;
    property Height;
    property ImageType;
    property ShareImages;
    property Width;
    property OnChange;
  end;

  { TcxBrushCache }

  TcxBrushData = record
    Brush: TBrush;
    Color: TColor;
    RefCount: Integer;
  end;

  TcxBrushesData = array of TcxBrushData;

  EBrushCache = class(Exception);

  TcxBrushCache = class
  private
    FCapacity: Integer;
    FCount: Integer;
    FData: TcxBrushesData;
    FDeletedCount: Integer;
    FLockRef: Integer;
  protected
    function Add(AColor: TColor): TBrush;
    function AddItemAt(AIndex: Integer; AColor: TColor): TBrush;
    procedure CacheCheck(Value: Boolean; const AMessage: string);
    procedure Delete(AIndex: Integer);
    function IndexOf(AColor: TColor; out AIndex: Integer): Boolean;
    procedure InitItem(var AItem: TcxBrushData; AColor: TColor);
    function IsSystemBrush(ABrush: TBrush): Boolean;
    function FindNearestItem(AColor: TColor): Integer;
    procedure Move(ASrc, ADst, ACount: Integer);
    procedure Pack;
    procedure Recreate;
    procedure Release(AIndex: Integer);
  public
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure ReleaseBrush(var ABrush: TBrush);
    procedure SetBrushColor(var ABrush: TBrush; AColor: TColor);
  end;

const
  DisableMap: TcxColorTransitionMap = (RedScale: 0.0729; GreenScale: 0.7146; BlueScale: 0.2125; SrcAlpha: 105; SrcConstantAlpha: 151);
  FadeMap: TcxColorTransitionMap = (RedScale: 0.299; GreenScale: 0.587; BlueScale: 0.114; SrcAlpha: 192; SrcConstantAlpha: 64);
  GrayMap: TcxColorTransitionMap = (RedScale: 0.299; GreenScale: 0.587; BlueScale: 0.114; SrcAlpha: $FF; SrcConstantAlpha: $FF);

type
  TcxColorInfo = record
    Name: string;
    Color: TColor;
  end;

const
  cxColorsByName: array[0..168] of TcxColorInfo = (
    (Name: 'aliceblue';            Color: $00FFF8F0),
    (Name: 'antiquewhite';         Color: $00D7EBFA),
    (Name: 'aqua';                 Color: clAqua),
    (Name: 'aquamarine';           Color: $007FD4FF),
    (Name: 'azure';                Color: $00FFFFF0),
    (Name: 'beige';                Color: $00DCF5F5),
    (Name: 'bisque';               Color: $00C4E4FF),
    (Name: 'black';                Color: clBlack),
    (Name: 'blanchedalmond';       Color: $00CDFFFF),
    (Name: 'blue';                 Color: clBlue),
    (Name: 'blueviolet';           Color: $00E22B8A),
    (Name: 'brown';                Color: $002A2AA5),
    (Name: 'burlywood';            Color: $0087B8DE),
    (Name: 'cadetblue';            Color: $00A09E5F),
    (Name: 'chartreuse';           Color: $0000FF7F),
    (Name: 'chocolate';            Color: $001E69D2),
    (Name: 'coral';                Color: $00507FFF),
    (Name: 'cornflowerblue';       Color: $00ED9564),
    (Name: 'cornsilk';             Color: $00DCF8FF),
    (Name: 'crimson';              Color: $003C14DC),
    (Name: 'cyan';                 Color: $00FFFF00),
    (Name: 'darkblue';             Color: $008B0000),
    (Name: 'darkcyan';             Color: $008B8B00),
    (Name: 'darkgoldenrod';        Color: $000B86B8),

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?