bsskindata.pas

delphi 皮肤控件

  TbsSkinColors = class(TObject)
  protected
    FcBtnFace: TColor;
    FcBtnText: TColor;
    FcWindow: TColor;
    FcWindowText: TColor;
    FcHighLight: TColor;
    FcHighLightText: TColor;
    FcBtnHighLight: TColor;
    FcBtnShadow: TColor;
  public
    //
    constructor Create;
    procedure LoadFromFile(IniFile: TCustomIniFile);
    procedure SaveToFile(IniFile: TCustomIniFile);
    procedure SetColorsToDefault;
    //
    property cBtnFace: TColor read FcBtnFace write FcBtnFace; 
    property cBtnText: TColor read FcBtnText write FcBtnText;
    property cBtnHighLight: TColor read FcBtnHighLight write FcBtnHighLight;
    property cBtnShadow: TColor read FcBtnShadow write FcBtnShadow;
    property cHighLight: TColor read FcHighLight write FcHighLight;
    property cHighLightText: TColor read FcHighLightText write FcHighLightText;
    property cWindow: TColor read FcWindow write FcWindow;
    property cWindowText: TColor read FcWindowText write FcWindowText;
  end;

  TbsCompressedSkinList = class;

  TbsSkinData = class(TComponent)
  protected
    FCompressedSkinList: TbsCompressedSkinList;
    FCompressedSkinIndex: Integer;
    FSkinnableForm: Boolean;
    FEnableSkinEffects: Boolean;
    FCompressedStoredSkin: TbsCompressedStoredSkin;
    FResourceStrData: TbsResourceStrData;
    FSkinColors: TbsSkinColors;

    procedure SetSkinnableForm(Value: Boolean);
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure SetCompressedStoredSkin(Value: TbsCompressedStoredSkin);
    procedure SetResourceStrData(Value: TbsResourceStrData);
    procedure WriteFormInfo(F: TCustomIniFile);
    procedure ReadFormInfo(F: TCustomIniFile);
    procedure WriteObjects(F: TCustomIniFile);
    procedure ReadObjects(F: TCustomIniFile);
    procedure WriteCtrls(F: TCustomIniFile);
    procedure ReadCtrls(F: TCustomIniFile);
    procedure WriteActivePictures(F: TCustomIniFile);
    procedure ReadActivePictures(F: TCustomIniFile; Path: String);
    procedure GetObjectTypeName(S: String; var AName, AType: String);
    procedure SaveToCustomIniFile(F: TCustomIniFile);
    procedure SetCompressedSkinIndex(Value: Integer);
    procedure SetCompressedSkinList(Value: TbsCompressedSkinList);
    //
  public
    //
    ButtonsRect, CaptionRect: TRect;
    ButtonsOffset: Integer;
    CapButtonsInLeft: Boolean;
    //
    AutoRenderingInActiveImage: Boolean;
    InActiveEffect: TbsInActiveEffect;
    PopupWindow: TbsDataSkinPopupWindow;
    HintWindow: TbsDataSkinHintWindow;
    Empty: Boolean;
    FPicture, FInActivePicture, FMask: TBitMap;
    FActivePictures: TList;
    FPictureName, FInActivePictureName, FMaskName: String;
    FActivePicturesNames: TStrings;
    ObjectList: TList;
    CtrlList: TList;
    LTPoint, RTPoint, LBPoint, RBPoint: TPoint;
    BGPictureIndex: Integer;
    MDIBGPictureIndex: Integer;
    MainMenuPopupUp: Boolean;
    MaskRectArea: TRect;
    HitTestLTPoint,
    HitTestRTPoint,
    HitTestLBPoint,
    HitTestRBPoint: TPoint;
    ClRect: TRect;
    BorderW: Integer;
    FormMinWidth: Integer;
    MDITabsTransparent: Boolean;
    MainMenuBarTransparent: Boolean;

    TopStretch, LeftStretch,
    RightStretch, BottomStretch: Boolean;
    StretchEffect: Boolean;
    StretchType: TbsStretchType;
    MDIBGStretchEffect: Boolean;
    MDIBGStretchType: TbsStretchType;

    SkinName: String;
    SkinAuthor: String;
    AuthorURL: String;
    AuthorEmail: String;
    SkinComments: String;

    ChangeSkinDataProcess: Boolean;

    procedure AddBitMap(FileName: String);
    procedure DeleteBitMap(Index: Integer);

    procedure SendSkinDataMessage(M: LongInt);

    function GetIndex(AIDName: String): Integer;
    function GetControlIndex(AIDName: String): Integer;
    procedure ClearObjects;
    procedure ClearAll;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure LoadFromFile(FileName: String);
    procedure SaveToFile(FileName: String);
    procedure LoadFromCompressedFile(FileName: String);
    procedure SaveToCompressedFile(FileName: String);
    procedure StoreToDisk(AFileName: String);

    procedure LoadCompressedStoredSkin(AStoredSkin: TbsCompressedStoredSkin);

    procedure ClearSkin;
    property SkinColors: TbsSkinColors read FSkinColors;
  published
    property SkinnableForm: Boolean read FSkinnableForm write SetSkinnableForm;
    property EnableSkinEffects: Boolean read
      FEnableSkinEffects write FEnableSkinEffects;
    property CompressedStoredSkin: TbsCompressedStoredSkin
      read FCompressedStoredSkin write SetCompressedStoredSkin;
    property ResourceStrData: TbsResourceStrData
      read FResourceStrData write SetResourceStrData;
    property SkinList: TbsCompressedSkinList
      read FCompressedSkinList write SetCompressedSkinList;
    property SkinIndex: Integer read
      FCompressedSkinIndex write SetCompressedSkinIndex;
  end;


  TbsSkinListItem = class(TCollectionItem)
  private
    FSkin: TbsCompressedStoredSkin;
    FDescription: String;
    FFileName: String;
    FCompressedFileName: String;
    FName: string;
  protected
    procedure ReadData(Stream: TStream);
    procedure WriteData(Stream: TStream);
    procedure DefineProperties(Filer: TFiler); override;
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Skin: TbsCompressedStoredSkin read FSkin;
    procedure SetDescription(Value: String);
    procedure SetFileName(Value: String);
    procedure SetCompressedFileName(Value: String);
  published
    property Description: String read FDescription write SetDescription;
    property FileName: String read FFileName write SetFileName;
    property CompressedFileName: String read FCompressedFileName write SetCompressedFileName;
    property Name: string read FName write FName;
  end;

  TbsSkinListItems = class(TCollection)
  private
    function GetItem(Index: Integer): TbsSkinListItem;
    procedure SetItem(Index: Integer; Value:  TbsSkinListItem);
  protected
    function GetOwner: TPersistent; override;
  public
    FSkinList: TbsCompressedSkinList;
    constructor Create(ASkinList: TbsCompressedSkinList);
    property Items[Index: Integer]:  TbsSkinListItem read GetItem write SetItem; default;
  end;

  TbsCompressedSkinList = class(TComponent)
  private
    FSkins: TbsSkinListItems;
    procedure SetSkins(Value: TbsSkinListItems);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Skins: TbsSkinListItems read FSkins write SetSkins;
  end;


  function ReadInActiveEffect(IniFile: TCustomIniFile;
                              Section: String; Ident: String): TbsInActiveEffect;

  procedure WriteInActiveEffect(IniFile: TCustomIniFile;
                                Section: String; Ident: String;
                                IE: TbsInActiveEffect);

  procedure WriteMorphKind(IniFile: TCustomIniFile;
                           Section: String; Ident: String; MK: TbsMorphKind);

  function ReadMorphKind(IniFile: TCustomIniFile;
                         Section: String; Ident: String): TbsMorphKind;



  procedure WriteStretchType(IniFile: TCustomIniFile;
                             Section: String; Ident: String; ST: TbsStretchType);


  function ReadStretchType(IniFile: TCustomIniFile;
                           Section: String; Ident: String): TbsStretchType;


// Internal messages
const
  WM_BEFORECHANGESKINDATA = WM_USER + 201;
  WM_CHANGESKINDATA = WM_USER + 202;
  WM_AFTERCHANGESKINDATA = WM_USER + 203;
  WM_CHANGERESSTRDATA = WM_USER + 250;
  WM_CHECKPARENTBG = WM_USER + 260;
  WM_CHANGEFORMSKINNABLE = WM_USER + 270;

implementation

   Uses bsZLibCompress;
   
function CheckSkinFile(F: TCustomIniFile): Boolean;
begin
  Result := F.SectionExists('VERSION') and F.SectionExists('PICTURES') and
            F.SectionExists('FORMINFO') and F.SectionExists('SKINOBJECTS') and
            F.SectionExists('SKINCONTROLS');
end;

procedure WriteInActiveEffect;
var
  S: String;
begin
  case IE of
    ieBrightness: S := 'iebrightness';
    ieDarkness: S := 'iedarkness';
    ieGrayScale: S := 'iegrayscale';
    ieNoise: S := 'ienoise';
    ieSplitBlur: S := 'iesplitblur';
    ieInvert: S := 'ieinvert';
  end;
  IniFile.WriteString(Section, Ident, S);
end;

function ReadInActiveEffect;
var
  S: String;
begin
  S := IniFile.ReadString(Section, Ident, 'iebrightness');
  if S = 'iebrightness'
  then Result := ieBrightness
  else
  if S = 'iedarkness'
  then Result := ieDarkness
  else
  if S = 'iegrayscale'
  then Result := ieGrayScale
  else
  if S = 'ienoise'
  then Result := ieNoise
  else
  if S = 'iesplitblur'
  then Result := ieSplitBlur
  else
  if S = 'ieinvert'
  then Result := ieInvert
  else
    Result := ieGrayScale;
end;

function ReadMorphKind;
var
  S: String;
begin
  S := IniFile.ReadString(Section, Ident, 'mkdefault');
  if S = 'mkdefault'
  then Result := mkDefault
  else
  if S = 'mkgradient'
  then Result := mkGradient
  else
  if S = 'mkleftgradient'
  then Result := mkLeftGradient
  else
  if S = 'mkrightgradient'
  then Result := mkRightGradient
  else
  if S = 'mkleftslide'
  then Result := mkLeftSlide
  else
  if S = 'mkrightslide'
  then Result := mkRightSlide
  else
  if S = 'mkpush'
  then Result := mkPush
  else Result := mkDefault;
end;

procedure WriteStretchType;
var
  S: String;
begin
  case ST of
    bsstFull: S := 'stfull';
    bsstVert: S := 'stvert';
    bsstHorz: S := 'sthorz';
  end;
  IniFile.WriteString(Section, Ident, S);
end;


function ReadStretchType;
var
  S: String;
begin
  S := IniFile.ReadString(Section, Ident, 'stfull');
  if S = 'stfull'
  then
    Result := bsstFull
  else
    if S = 'stvert'
    then
      Result := bsstVert
    else
      Result := bsstHorz;
end;

procedure WriteMorphKind;
var
  S: String;
begin
  case MK of
    mkDefault: S := 'mkdefault';
    mkGradient: S := 'mkgradient';
    mkLeftGradient: S := 'mkleftgradient';
    mkRightGradient: S := 'mkrightgradient';
    mkLeftSlide: S := 'mkleftslide';
    mkRightSlide: S := 'mkrightslide';
    mkPush: S := 'mkpush';
  end;
  IniFile.WriteString(Section, Ident, S);
end;

constructor TbsDataSkinControl.Create;
begin
  IDName := AIDName;
  PictureIndex := -1;
  MaskPictureIndex := -1;
  SkinRect := Rect(0, 0, 0, 0);
end;

procedure TbsDataSkinControl.LoadFromFile;
begin
  PictureIndex := IniFile.ReadInteger(IDName, 'pictureindex', -1);
  MaskPictureIndex := IniFile.ReadInteger(IDName, 'maskpictureindex', -1);
  SkinRect := ReadRect(IniFile, IDName, 'skinrect');
end;