dxskinscore.pas

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

    procedure Delete(AIndex: Integer);
    procedure RemoveElement(AElement: TdxSkinElement);
    function GetElementByName(const AName: string): TdxSkinElement;

    property Count: Integer read GetCount;
    property Elements[Index: Integer]: TdxSkinElement read GetElement write SetElement;
    property Skin: TdxSkin read GetSkin;
  end;

  { TdxSkinImage }

  TdxSkinElementState = (esNormal, esHot, esPressed, esDisabled, esActive,
    esFocused, esDroppedDown, esChecked, esHotCheck, esActiveDisabled,
    esCheckPressed);

  TdxSkinElementStates = set of TdxSkinElementState;

  TdxSkinImageLayout = (ilHorizontal, ilVertical);
  TdxSkinStretchMode = (smStretch, smTile, smNoResize);
  TdxSkinElementPartBounds = array[0..2, 0..2] of TRect;
  TdxSkinElementPartVisibility = array[0..2, 0..2] of Boolean;

  TdxSkinImage = class(TPersistent)
  private
    FGradient: TdxSkinGradientMode;
    FGradientBeginColor: TColor;
    FGradientEndColor: TColor;
    FImageLayout: TdxSkinImageLayout;
    FIsDirty: Boolean;
    FMargins: TcxRect;
    FOnChange: TNotifyEvent;
    FOwner: TdxSkinElement;
    FPartSizing: TdxSkinElementPartVisibility;
    FPartsVisibility: TdxSkinElementPartVisibility;
    FSize: TSize;
    FSourceName: string;
    FStateBounds: array[TdxSkinElementState] of TRect;
    FStateCount: Integer;
    FStates: TdxSkinElementStates;
    FStretch: TdxSkinStretchMode;
    FTexture: TdxPNGImage;
    FTransparentColor: TColor;
    function GetEmpty: Boolean;
    function GetImageCount: Integer;
    function GetName: string;
    function GetPartSizing(Col, Row: Integer): Boolean;
    function GetPartVisible(Col, Row: Integer): Boolean;
    function GetSize: TSize;
    function GetSourceName: string;
    function GetStateBounds(AImageIndex: Integer; AState: TdxSkinElementState): TRect;
    function GetStateCount: Integer;
    procedure SetGradientBeginColor(AValue: TColor);
    procedure SetGradientEndColor(AValue: TColor);
    procedure SetGradientMode(AValue: TdxSkinGradientMode);
    procedure SetImageLayout(AValue: TdxSkinImageLayout);
    procedure SetMargins(AValue: TcxRect);
    procedure SetName(const AValue: string);
    procedure SetStates(AValue: TdxSkinElementStates);
    procedure SetStretch(AValue: TdxSkinStretchMode);
    procedure SetTransparentColor(AValue: TColor);
    procedure SubItemHandler(Sender: TObject);
  protected
    procedure CheckInfo;
    procedure CheckState(var AState: TdxSkinElementState);
    procedure DoChange; virtual;
    procedure DoInitializeInfo; virtual;
    procedure DrawPart(ACanvas: TdxSkinCanvas; const ADest, ASource: TRect;
      APartSizing, AIsCenterPart: Boolean); virtual;
    function GetOwner: TPersistent; override;
    procedure InitializePartsInfo(const ABounds: TRect; var AParts;
      var AVisibility; ACheckMargins: Boolean);
    procedure ReadData(AStream: TStream);
    procedure WriteData(AStream: TStream);

    property TransparentColor: TColor read FTransparentColor write SetTransparentColor;
    property IsDirty: Boolean read FIsDirty write FIsDirty;

    property PartSizing[Col, Row: Integer]: Boolean read GetPartSizing;
    property PartVisible[Col, Row: Integer]: Boolean read GetPartVisible;
  public
    constructor Create(AOwner: TdxSkinElement); virtual;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    function Compare(AImage: TdxSkinImage): Boolean; virtual; 
    procedure Draw(DC: HDC; const ARect: TRect; AImageIndex: Integer = 0;
      AState: TdxSkinElementState = esNormal); virtual;
    procedure DrawEx(ACanvas: TdxSkinCanvas; const ARect: TRect;
      AImageIndex: Integer = 0; AState: TdxSkinElementState = esNormal); virtual;
    procedure GetBitmap(AImageIndex: Integer; AState: TdxSkinElementState;
      ABitmap: TBitmap;  ABkColor: TColor = clNone);
    procedure LoadFromFile(const AFileName: string);
    procedure SaveToFile(const AFileName: string);
    procedure SetStateMapping(AStateOrder: array of TdxSkinElementState);

    property Empty: Boolean read GetEmpty;
    property ImageCount: Integer read GetImageCount;
    property Name: string read GetName write SetName;
    property Owner: TdxSkinElement read FOwner;
    property Size: TSize read GetSize;
    property SourceName: string read GetSourceName;
    property StateBounds[ImageIndex: Integer; State: TdxSkinElementState]: TRect read GetStateBounds;
    property StateCount: Integer read GetStateCount;
    property Texture: TdxPNGImage read FTexture;
  published
    property Gradient: TdxSkinGradientMode read FGradient write SetGradientMode default gmHorizontal;
    property GradientBeginColor: TColor read FGradientBeginColor write SetGradientBeginColor default clNone;
    property GradientEndColor: TColor read FGradientEndColor write SetGradientEndColor default clNone;
    property ImageLayout: TdxSkinImageLayout read FImageLayout write SetImageLayout default ilHorizontal;
    property Margins: TcxRect read FMargins write SetMargins;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property States: TdxSkinElementStates read FStates write SetStates;
    property Stretch: TdxSkinStretchMode read FStretch write SetStretch default smStretch;
  end;

  { TdxSkinElement }

  TdxSkinElement = class(TdxSkinPersistent)
  private
    FAlpha: Byte;
    FBorders: TdxSkinBorders;
    FBrush: GpBrush;
    FCanvas: TdxSkinCanvas;
    FColor: TColor;
    FContentOffset: TcxRect;
    FGlyph: TdxSkinImage;
    FImage: TdxSkinImage;
    FImageCount: Integer;
    FIsColorAssigned: Boolean;
    FMinSize: TcxSize;
    FTextColor: TColor;
    function GetGroup: TdxSkinControlGroup;
    function GetIsAlphaUsed: Boolean;
    function GetPath: string;
    function GetSize: TSize;
    procedure SetAlpha(AValue: Byte);
    procedure SetBorders(AValue: TdxSkinBorders);
    procedure SetColor(AValue: TColor);
    procedure SetContentOffset(AValue: TcxRect);
    procedure SetGlyph(AValue: TdxSkinImage);
    procedure SetImage(AValue: TdxSkinImage);
    procedure SetImageCount(AValue: Integer);
    procedure SetMinSize(AValue: TcxSize);
    procedure SetTextColor(AValue: TColor);
  protected
    function CompareProperties(AElement: TdxSkinElement): Boolean; virtual;
    function ExpandName(ABitmap: TdxSkinImage): string; virtual;
    procedure FillBackgroundByColor(ACanvas: TdxSkinCanvas; const ARect: TRect);
    procedure InternalDraw(ACanvas: TdxSkinCanvas; const ARect: TRect;
      AImageIndex: Integer = 0; AState: TdxSkinElementState = esNormal);
    procedure ReadData(AStream: TStream; AVersion: TdxSkinVersion); virtual;
    procedure WriteData(AStream: TStream; AVersion: TdxSkinVersion); virtual;
    property Brush: GpBrush read FBrush;
    property Canvas: TdxSkinCanvas read FCanvas;
    property IsColorAssigned: Boolean read FIsColorAssigned;
  public
    constructor Create(AOwner: TPersistent; const AName: string); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function Compare(AElement: TdxSkinElement): Boolean; virtual;
    procedure Draw(DC: HDC; const ARect: TRect; AImageIndex: Integer = 0;
      AState: TdxSkinElementState = esNormal); virtual;
    procedure SetStateMapping(AStateOrder: array of TdxSkinElementState);

    property Group: TdxSkinControlGroup read GetGroup;
    property IsAlphaUsed: Boolean read GetIsAlphaUsed;
    property Path: string read GetPath;
    property Size: TSize read GetSize;
  published
    property Color: TColor read FColor write SetColor default clDefault;
    property Alpha: Byte read FAlpha write SetAlpha default 255;
    property Borders: TdxSkinBorders read FBorders write SetBorders;
    property ContentOffset: TcxRect read FContentOffset write SetContentOffset;
    property Glyph: TdxSkinImage read FGlyph write SetGlyph;
    property MinSize: TcxSize read FMinSize write SetMinSize;
    property TextColor: TColor read FTextColor write SetTextColor default clDefault;
    property Image: TdxSkinImage read FImage write SetImage;
    property ImageCount: Integer read FImageCount write SetImageCount default 1;
  end;

  { TdxSkinEmptyElement }

  TdxSkinEmptyElement = class(TdxSkinElement)
  public
    procedure Draw(DC: HDC; const ARect: TRect; AImageIndex: Integer = 0;
      AState: TdxSkinElementState = esNormal); override;
  end;

  { TdxSkinPartStream }

  TdxSkinPartStream = class(TStream)
  private
    FPosEnd: Longint;
    FPosStart: Longint;
    FSource: TStream;
  protected
  {$IFDEF DELPHI7}
    function GetSize: Int64; override;
  {$ENDIF}
  public
    constructor Create(ASource: TStream); virtual;
    procedure Initialize(const APosStart, APosEnd: Longint);
    procedure InitializeEx(ASource: TStream; const APosStart, APosEnd: Longint);
    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;

    property PosEnd: Longint read FPosEnd;
    property PosStart: Longint read FPosStart;
    property Source: TStream read FSource;
  end;

  { TdxSkinElementCache }

  TdxSkinElementCache = class(TObject)
  private
    FCache: GpBitmap;
    FCacheOpaque: TcxBitmap;
    FElement: TdxSkinElement;
    FImageIndex: Integer;
    FIsAlphaBlendUsed: Boolean;
    FRect: TRect;
    FState: TdxSkinElementState;
  protected
    procedure FreeCache;
    procedure InitCache(R: TRect);
    procedure InitOpaqueCache(R: TRect);
    // Properties
    property Element: TdxSkinElement read FElement;
    property ImageIndex: Integer read FImageIndex;
    property IsAlphaBlendUsed: Boolean read FIsAlphaBlendUsed;
    property State: TdxSkinElementState read FState;
  public
    destructor Destroy; override;
    procedure CheckCacheState(AElement: TdxSkinElement; const R: TRect;
      AState: TdxSkinElementState = esNormal; AImageIndex: Integer = 0);
    procedure Draw(DC: HDC; const R: TRect);
    procedure DrawEx(DC: HDC; AElement: TdxSkinElement; const R: TRect;
      AState: TdxSkinElementState = esNormal; AImageIndex: Integer = 0);
  end;

  { TdxSkinElementCacheList }

  TdxSkinElementCacheList = class(TcxObjectList)
  private
    FCacheListLimit: Integer;
    procedure CheckListLimits;
    function FindElementCache(AElement: TdxSkinElement; const R: TRect;
      out AElementCache: TdxSkinElementCache): Boolean;
    function GetElementCache(AIndex: Integer): TdxSkinElementCache;
  public
    constructor Create;
    procedure DrawElement(DC: HDC; AElement: TdxSkinElement; const R: TRect;
      AState: TdxSkinElementState = esNormal; AImageIndex: Integer = 0);
    property CacheListLimit: Integer read FCacheListLimit write FCacheListLimit;
    property ElementCache[Index: Integer]: TdxSkinElementCache read GetElementCache;
  end;

function dxSkinRegisteredPropertyTypes: TList;

procedure dxSkinInvalidOperation(const AMessage: string);
procedure dxSkinCheck(ACondition: Boolean; const AMessage: string);
procedure dxSkinCheckVersion(AVersion: Double);
function dxSkinCheckSignature(AStream: TStream; out AVersion: TdxSkinVersion): Boolean;
function dxSkinCheckSkinElement(AElement: TdxSkinElement): TdxSkinElement;
procedure dxSkinWriteSignature(AStream: TStream);

implementation

const
  dxSkinElementCacheListLimit = 8;
  
  PartSizing: array[0..2, 0..2] of Boolean =
   ((False, True, False),
    (True, True, True),
    (False, True, False));

var
  dxSkinEmptyElement: TdxSkinElement;
  PartStream: TdxSkinPartStream;
  RegisteredPropertyTypes: TList;

type
  TdxSkinARGBQuad = packed record
    rgbRed: Byte;
    rgbGreen: Byte;
    rgbBlue: Byte;
    Alpha: Byte;
  end;

  TRect2Int = array[TcxBorder] of Integer;

function ColorToARGB(AColor: TColor; Alpha: Byte = 255): Integer;
begin
  with TRGBQUAD(ColorToRgb(AColor)) do
  begin
    TdxSkinARGBQuad(Result).Alpha := Alpha;
    TdxSkinARGBQuad(Result).rgbRed := rgbRed;
    TdxSkinARGBQuad(Result).rgbGreen := rgbGreen;
    TdxSkinARGBQuad(Result).rgbBlue := rgbBlue;
  end;
end;

function ReadStringFromStream(AStream: TStream): string;
var
  L: Integer;
begin
  AStream.Read(L, SizeOf(L));
  SetLength(Result, L);
  if L > 0 then
    AStream.ReadBuffer(Result[1], L);
end;

function ReadInteger(AStream: TStream): Integer;
begin
  AStream.Read(Result, SizeOf(Result));
end;

procedure WriteStringToStream(AStream: TStream; const AValue: string);
var
  L: Integer;
begin
  L := Length(AValue);
  AStream.Write(L, SizeOf(L));
  if L > 0 then
    AStream.WriteBuffer(AValue[1], L);
end;

procedure WriteInteger(AStream: TStream; const AValue: Integer);
begin
  AStream.Write(AValue, SizeOf(AValue));
end;

function dxSkinRegisteredPropertyTypes: TList;
begin
  Result := RegisteredPropertyTypes; 
end;

procedure dxSkinInvalidOperation(const AMessage: string);
begin
  raise EdxSkin.Create(AMessage);
end;

procedure dxSkinCheck(ACondition: Boolean; const AMessage: string);
begin
  if not ACondition then
     dxSkinInvalidOperation(AMessage);
end;

procedure dxSkinCheckVersion(AVersion: Double);
begin
  if AVersion < 1 then
    raise EdxSkin.Create(sdxOldFormat);
end;

function dxSkinCheckSignature(AStream: TStream; out AVersion: TdxSkinVersion): Boolean;
var
  ASignature: array[0..Length(dxSkinSignature) - 1] of Char;
begin
  AStream.Position := AStream.Position + SizeOf(Integer);
  Result := AStream.Read(ASignature, Length(dxSkinSignature)) = Length(dxSkinSignature);
  Result := Result and (ASignature = dxSkinSignature);
  if Result then
    AStream.ReadBuffer(AVersion, SizeOf(AVersion));
end;

function dxSkinCheckSkinElement(AElement: TdxSkinElement): TdxSkinElement;
begin
  Result := AElement;
  if Result = nil then
    Result := dxSkinEmptyElement;
end;

procedure dxSkinWriteSignature(AStream: TStream);
begin
  WriteStringToStream(AStream, dxSkinSignature);
  AStream.Write(dxSkinStreamVersion, SizeOf(dxSkinStreamVersion));
end;

function dxCompareByName(AItem1, AItem2: TdxSkinCustomPersistentObject): Integer;
begin
  Result := AnsiCompareStr(AItem1.Name, AItem2.Name);
end;

function FindItemByName(AItemsList: TcxObjectList; const AName: string): TObject;
var
  L, H, AIndex, C: Integer;
begin
  Result := nil;
  L := 0;
  H := AItemsList.Count - 1;
  while L <= H do
  begin
    AIndex := (L + H) div 2;
    C := AnsiCompareStr(TdxSkinCustomPersistentObject(AItemsList[AIndex]).Name, AName);
    if C < 0 then
      L := AIndex + 1
    else
    begin
      H := AIndex - 1;
      if C = 0 then
      begin
        Result := TdxSkinCustomPersistentObject(AItemsList[AIndex]);
        Break;
      end
    end;
  end;
end;

{ TdxSkinPersistent }

constructor TdxSkinPersistent.Create(
  AOwner: TPersistent; const AName: string);
begin
  inherited Create(AOwner, AName);
  FProperties := TcxObjectList.Create;
end;

destructor TdxSkinPersistent.Destroy;
begin
  FProperties.Free;
  inherited Destroy; 
end;

procedure TdxSkinPersistent.Assign(Source: TPersistent);
var
  I: Integer;
begin
  BeginUpdate;
  try
    if Source is TdxSkinPersistent then