dxskinscore.pas

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

{********************************************************************}
{                                                                    }
{           Developer Express Visual Component Library               }
{           Express Cross Platform Library classes                   }
{                                                                    }
{           Copyright (c) 2000-2008 Developer Express Inc.           }
{           ALL RIGHTS RESERVED                                      }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSCROSSPLATFORMLIBRARY AND ALL   }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM       }
{   ONLY.                                                            }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit dxSkinsCore;

{$I cxVer.inc}

interface

uses
{$IFDEF DELPHI6}
  Types,
{$ENDIF}
  Windows, SysUtils, Classes, Graphics, Math, cxGraphics, cxGeometry, cxClasses,
  cxLookAndFeels, dxGDIPlusApi, dxGDIPlusClasses, dxSkinsStrs, ActiveX, Forms,
  dxOffice11;

type
  TdxSkinVersion = Double;

const
  dxSkinSignature = 'dxSkin';
  dxSkinStreamVersion: TdxSkinVersion = 1.02;
  ImageNameSuffix = '_Image.png';
  GlyphNameSuffix = '_Glyph.png';
  BitmapNameSuffixes: array[Boolean] of string = (GlyphNameSuffix, ImageNameSuffix);
{$IFNDEF DELPHI6}
  PathDelim = '\';
{$ENDIF}

type
  TdxSkin = class;
  TdxSkinClass = class of TdxSkin;
  TdxSkinCustomPersistentObject = class;
  TdxSkinCustomPersistentObjectClass = class of TdxSkinCustomPersistentObject;
  TdxSkinPersistentClass = class of TdxSkinPersistent;
  TdxSkinControlGroupClass = class of TdxSkinControlGroup;
  TdxSkinElementClass = class of TdxSkinElement;
  TdxSkinColor = class;
  TdxSkinProperty = class;
  TdxSkinPropertyClass = class of TdxSkinProperty;
  TdxSkinControlGroup = class;
  TdxSkinImage = class;
  TdxSkinElement = class;

  EdxSkin = class(Exception);

  IdxSkinChangeListener = interface
  ['{28681774-0475-43AE-8704-1C904D294742}']
    procedure SkinChanged(Sender: TdxSkin);
  end;

  IdxSkinInfo = interface
  ['{97D85495-E631-413C-8DBC-BE7B784A9EA0}']
    function GetSkin: TdxSkin;
  end;

  { TdxSkinCustomPersistentObject }

  TdxSkinCustomPersistentObject = class(TPersistent)
  private
    FName: string;
    FOwner: TPersistent;
    FTag: Integer; 
    FOnChange: TNotifyEvent;
  protected
    procedure DoChange; virtual;
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent; const AName: string); virtual;
    function Clone: TdxSkinCustomPersistentObject; virtual;
    
    property Tag: Integer read FTag write FTag;
  published
    property Name: string read FName write FName;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  { TdxSkinPersistent }

  TdxSkinPersistent = class(TdxSkinCustomPersistentObject)
  private
    FLockCount: Integer;
    FModified: Boolean;
    FProperties: TcxObjectList;
    FSorted: Boolean;
    function GetPropertyCount: Integer;
    function GetProperty(Index: Integer): TdxSkinProperty;
    procedure SetSorted(AValue: Boolean);
  protected
    procedure AddSubItem(AInstance: TdxSkinCustomPersistentObject; AList: TcxObjectList);
    procedure Changed; virtual;
    procedure DoSort; virtual;
    procedure SubItemHandler(Sender: TObject); virtual;
    procedure ReadProperties(AStream: TStream);
    procedure WriteProperties(AStream: TStream);

    property LockCount: Integer read FLockCount write FLockCount;
    property Sorted: Boolean read FSorted write SetSorted;
  public
    constructor Create(AOwner: TPersistent; const AName: string); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function AddProperty(const AName: string;
      APropertyClass: TdxSkinPropertyClass): TdxSkinProperty;
    procedure BeginUpdate;
    procedure CancelUpdate;
    procedure DeleteProperty(const AProperty: TdxSkinProperty); virtual;
    procedure EndUpdate;
    function GetPropertyByName(const AName: string): TdxSkinProperty;
    procedure Sort;

    property Modified: Boolean read FModified write FModified;
    property PropertyCount: Integer read GetPropertyCount;
    property Properties[Index: Integer]: TdxSkinProperty read GetProperty;
  end;

  { TdxSkin }

  TdxSkin = class(TdxSkinPersistent)
  private
    FColors: TcxObjectList;
    FGroups: TcxObjectList;
    FListeners: TInterfaceList;
    FName: string;
    FOnChange: TNotifyEvent;
    FVersion: TdxSkinVersion;
    function GetColor(Index: Integer): TdxSkinColor;
    function GetColorCount: Integer;
    function GetGroup(Index: Integer): TdxSkinControlGroup;
    function GetGroupCount: Integer;
    procedure SetName(const Value: string);
  protected
    procedure DoChange; override;
    procedure DoSort; override;
    procedure LoadFromResource(hInst: THandle); virtual;
    procedure NotifyListeners;

    property Listeners: TInterfaceList read FListeners;
  public
    constructor Create(const AName: string; ALoadOnCreate: Boolean; hInst: THandle); reintroduce; virtual;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override; 
    function AddColor(const AName: string; const AColor: TColor): TdxSkinColor;
    function AddGroup(const AName: string = ''): TdxSkinControlGroup;
    procedure AddListener(AListener: IdxSkinChangeListener);
    procedure Clear;
    procedure ClearModified;
    function Clone(const AName: string): TdxSkin; reintroduce; virtual;
    procedure DeleteProperty(const AProperty: TdxSkinProperty); override;
    function GetColorByName(const AName: string): TdxSkinColor;
    function GetGroupByName(const AName: string): TdxSkinControlGroup;
    procedure LoadFromStream(AStream: TStream); virtual;
    procedure LoadFromFile(const AFileName: string);
    procedure RemoveListener(AListener: IdxSkinChangeListener);
    procedure SaveToFile(const AFileName: string);
    procedure SaveToStream(AStream: TStream); virtual;

    property ColorCount: Integer read GetColorCount;
    property Colors[Index: Integer]: TdxSkinColor read GetColor;
    property GroupCount: Integer read GetGroupCount;
    property Groups[Index: Integer]: TdxSkinControlGroup read GetGroup;
  published
    property Name: string read FName write SetName;
    property Version: TdxSkinVersion read FVersion;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  { TdxSkinProperty }

  TdxSkinProperty = class(TdxSkinCustomPersistentObject)
  protected
    procedure ReadData(Stream: TStream); virtual;
    procedure ReadFromStream(Stream: TStream); virtual;
    procedure WriteData(Stream: TStream); virtual;
    procedure WriteToStream(Stream: TStream); virtual;
  public
    class procedure Register;
    class procedure Unregister;
    class function Description: string; virtual;
    function Compare(AProperty: TdxSkinProperty): Boolean; virtual;
  end;

  TdxSkinGradientMode = (gmHorizontal, gmVertical, gmForwardDiagonal,
    gmBackwardDiagonal);

  { TdxSkinCanvas }

  TdxSkinCanvas = class(TObject)
  private
    FBuffer: TcxBitmap;
    FGraphics: GpGraphics;
    FRect: TRect;
    FSourceDC: HDC;
    function GetInterpolationMode: Integer;
    procedure SetInterpolationMode(AValue: Integer);
    procedure FillRectByDiagonalGradient(const R: TRect; AColor1, AColor2: TColor;
      AForward: Boolean);
  public
    function IsRectVisible(DC: HDC; const R: TRect): Boolean;
    procedure BeginPaint(DC: HDC; const R: TRect);
    procedure BeginPaintEx(Graphics: GpGraphics; const R: TRect);
    procedure DrawImage(AImage: TdxPNGImage; const ADest, ASource: TRect);
    procedure EndPaint; overload;
    procedure FillRectByColor(const R: TRect; AColor: TColor);
    procedure FillRectByGradient(const R: TRect; AColor1, AColor2: TColor;
      AMode: TdxSkinGradientMode);
    procedure StretchDrawImage(AImage: TdxPNGImage; const ADest, ASource: TRect);
    procedure TileImage(AImage: TdxPNGImage; const ADest, ASource: TRect);
    // Properties
    property Graphics: GpGraphics read FGraphics;
    property InterpolationMode: Integer read GetInterpolationMode write SetInterpolationMode;
  end;

  { TdxSkinIntegerProperty }

  TdxSkinIntegerProperty = class(TdxSkinProperty)
  private
    FValue: Integer;
    procedure SetValue(AValue: Integer);
  protected
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
  public
    procedure Assign(Source: TPersistent); override;
    function Compare(AProperty: TdxSkinProperty): Boolean; override;
  published
    property Value: Integer read FValue write SetValue default 0;
  end;

  { TdxSkinBooleanProperty }

  TdxSkinBooleanProperty = class(TdxSkinProperty)
  private
    FValue: Boolean;
    procedure SetValue(AValue: Boolean);
  protected
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
  public
    procedure Assign(Source: TPersistent); override;
    function Compare(AProperty: TdxSkinProperty): Boolean; override;
  published
    property Value: Boolean read FValue write SetValue default False;
  end;

  { TdxSkinColor }

  TdxSkinColor = class(TdxSkinProperty)
  private
    FValue: TColor;
    procedure SetValue(AValue: TColor);
  protected
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
  public
    constructor Create(AOwner: TPersistent; const AName: string); override;
    procedure Assign(Source: TPersistent); override;
    function Compare(AProperty: TdxSkinProperty): Boolean; override;
  published
    property Value: TColor read FValue write SetValue default clDefault;
  end;

  { TdxSkinRectProperty }

  TdxSkinRectProperty = class(TdxSkinProperty)
  private
    FValue: TcxRect;
    function GetValueByIndex(Index: Integer): Integer;
    procedure SetValue(Value: TcxRect);
    procedure SetValueByIndex(Index, Value: Integer);
    procedure InternalHandler(Sender: TObject);
  protected
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
  public
    constructor Create(AOwner: TPersistent; const AName: string); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function Compare(AProperty: TdxSkinProperty): Boolean; override;

    property Value: TcxRect read FValue write SetValue;
  published
    property Left: Integer index 0 read GetValueByIndex write SetValueByIndex default 0;
    property Top: Integer index 1 read GetValueByIndex write SetValueByIndex default 0;
    property Right: Integer index 2 read GetValueByIndex write SetValueByIndex default 0;
    property Bottom: Integer index 3 read GetValueByIndex write SetValueByIndex default 0;
  end;

  { TdxSkinSizeProperty }

  TdxSkinSizeProperty = class(TdxSkinProperty)
  private
    FValue: TSize;
    procedure SetValue(const Value: TSize);
  protected
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
  public
    procedure Assign(Source: TPersistent); override;
    function Compare(AProperty: TdxSkinProperty): Boolean; override;
    function GetValueByIndex(Index: Integer): Integer;
    procedure SetValueByIndex(Index, Value: Integer);

    property Value: TSize read FValue write SetValue;
  published
    property cx: Integer index 0 read GetValueByIndex write SetValueByIndex default 0;
    property cy: Integer index 1 read GetValueByIndex write SetValueByIndex default 0;
  end;

  { TdxSkinBorder }

  TdxSkinBorder = class(TdxSkinProperty)
  private
    FColor: TColor;
    FKind: TcxBorder;
    FThin: Integer;
    procedure SetColor(AValue: TColor);
    procedure SetThin(AValue: Integer);
  protected
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
  public
    constructor Create(AOwner: TPersistent; const AName: string); override;
    procedure Assign(Source: TPersistent); override;
    function Compare(AProperty: TdxSkinProperty): Boolean; override;
    procedure Draw(DC: HDC; const ABounds: TRect); virtual;
    procedure DrawEx(ACanvas: TdxSkinCanvas; const ABounds: TRect); virtual;

    property Kind: TcxBorder read FKind;
  published
    property Color: TColor read FColor write SetColor default clNone;
    property Thin: Integer read FThin write SetThin default 1;
  end;

  { TdxSkinBorders }

  TdxSkinBorders = class(TdxSkinProperty)
  private
    FBorders: array[TcxBorder] of TdxSkinBorder;
    function GetBorder(ABorder: TcxBorder): TdxSkinBorder;
    function GetBorderByIndex(Index: Integer): TdxSkinBorder;
    procedure SetBorderByIndex(Index: Integer; AValue: TdxSkinBorder);
  protected
    procedure CreateBorders;
    procedure DeleteBorders;
    procedure SubItemHandler(Sender: TObject); virtual;
  public
    constructor Create(AOwner: TPersistent; const AName: string); override;
    destructor Destroy; override;
    procedure Assign(ASource: TPersistent); override;
    function Compare(AProperty: TdxSkinProperty): Boolean; override;

    property Items[AKind: TcxBorder]: TdxSkinBorder read GetBorder; default;
  published
    property Left: TdxSkinBorder index 0 read GetBorderByIndex write SetBorderByIndex;
    property Top: TdxSkinBorder index 1 read GetBorderByIndex write SetBorderByIndex;
    property Right: TdxSkinBorder index 2 read GetBorderByIndex write SetBorderByIndex;
    property Bottom: TdxSkinBorder index 3 read GetBorderByIndex write SetBorderByIndex;
  end;

  { TdxSkinStringProperty }

  TdxSkinStringProperty = class(TdxSkinProperty)
  private
    FValue: string;
    procedure SetValue(const AValue: string);
  protected
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
  public
    procedure Assign(Source: TPersistent); override;
    function Compare(AProperty: TdxSkinProperty): Boolean; override;
  published
    property Value: string read FValue write SetValue;
  end;

  { TdxSkinControlGroup }

  TdxSkinControlGroup = class(TdxSkinPersistent)
  private
    FElements: TcxObjectList;
    function GetCount: Integer;
    function GetElement(AIndex: Integer): TdxSkinElement;
    function GetSkin: TdxSkin;
    procedure SetElement(AIndex: Integer; AElement: TdxSkinElement);
  protected
    procedure DoSort; override; 
    procedure ReadData(AStream: TStream; const AVersion: TdxSkinVersion); virtual;
    procedure WriteData(AStream: TStream); virtual;
  public
    constructor Create(AOwner: TPersistent; const AName: string); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function AddElement(const AName: string): TdxSkinElement;
    function AddElementEx(const AName: string; AElementClass: TdxSkinElementClass): TdxSkinElement;
    procedure Clear;
    procedure ClearModified;