sskinmanager.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

    property Images : TsSkinImages read FImages write SetImages;
    property Patterns : TsSkinPatterns read FPatterns write SetPatterns;
    property MasterBitmap : TBitmap read FMasterBitmap write FMasterBitmap;

    property Shadow1Color : TColor read FShadow1Color write FShadow1Color;
    property Shadow1Offset : integer read FShadow1Offset write FShadow1Offset;
    property Shadow1Blur : integer read FShadow1Blur write FShadow1Blur default -1;
    property Shadow1Transparency : integer read FShadow1Transparency write FShadow1Transparency;

    property BorderColor : TColor read FBorderColor write FBorderColor default clFuchsia;

    property Version : real read FVersion write FVersion;
    property Author : string read FAuthor write FAuthor;
    property Description : string read FDescription write FDescription;
  end;

  TsStoredSkins = class(TCollection)
  private
    FOwner: TsSkinManager;
    function GetItem(Index: Integer): TsStoredSkin;
    procedure SetItem(Index: Integer; Value: TsStoredSkin);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TsSkinManager);
    destructor Destroy; override;
    property Items[Index: Integer]: TsStoredSkin read GetItem write SetItem; default;
    function IndexOf(const SkinName : string) : integer;
  end;
{$ENDIF} // NOTFORHELP

  TacSkinningRule = (srStdForms, srStdDialogs, srThirdParty);
  TacSkinningRules = set of TacSkinningRule;

  TsSkinManager = class(TComponent)
  private
{$IFNDEF NOTFORHELP}
    FGroupIndex: integer;
    FSkinName: TsSkinName;
    FSkinDirectory: TsDirectory;
    FActive: boolean;
    FBuiltInSkins: TsStoredSkins;
    FSkinableMenus: TsSkinableMenus;
    FOnAfterChange: TNotifyEvent;
    FOnBeforeChange: TNotifyEvent;
    FSkinnedPopups: boolean;
    FCommonSections: TStringList;
    FIsDefault: boolean;
    FOnGetPopupLineData: TacGetExtraLineData;
    FMenuSupport: TacMenuSupport;
    FAnimEffects: TacAnimEffects;
    FActiveControl: hwnd;
    GlobalHookInstalled : boolean;
    FWorkMode: TacManagerWorkMode;
    FSkinningRules: TacSkinningRules;
    procedure SetSkinName(const Value: TsSkinName);
    procedure SetSkinDirectory(const Value: string);
    procedure SetActive(const Value: boolean);
    procedure SetBuiltInSkins(const Value: TsStoredSkins);
    procedure SetSkinnedPopups(const Value: boolean);
    function GetVersion: string;
    procedure SetVersion(const Value: string);
    function GetSkinInfo: TacSkinInfo;
    procedure SetSkinInfo(const Value: TacSkinInfo);
    procedure SetHueOffset(const Value: integer);
    procedure SetSaturation(const Value: integer);
    procedure SetIsDefault(const Value: boolean);
    function GetIsDefault: boolean;
    function MainWindowHook(var Message: TMessage): boolean;
    procedure SetActiveControl(const Value: hwnd);
  protected
    procedure SendNewSkin;
    procedure SendRemoveSkin;

    procedure LoadAllMasks;
    procedure LoadAllPatterns;
    procedure FreeBitmaps;
    procedure FreeJpegs;
{$ENDIF} // NOTFORHELP
  public
    SkinData : TsSkinData;
{$IFNDEF NOTFORHELP}
    ma : TsMaskArray;
    pa : TsPatternArray;
    gd : TsGeneralDataArray;
    ConstData : TConstantSkinData;
    MasterBitmap : TBitmap;
    SkinIsPacked : boolean;

    FHueOffset: integer;
    FSaturation: integer;
    procedure InitConstantIndexes;

    procedure LoadAllGeneralData;
    procedure SetCommonSections(const Value: TStringList);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure SaveToIni(Index : integer; sf : TMemIniFile);
    procedure ReloadSkin;
    procedure ReloadPackedSkin;
    procedure InstallHook;
    procedure UnInstallHook;

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure UpdateSkinSection(const SectionName : string);
    property GroupIndex : integer read FGroupIndex write FGroupIndex;
    property SkinableMenus : TsSkinableMenus read FSkinableMenus write FSkinableMenus;
    property ActiveControl : hwnd read FActiveControl write SetActiveControl;
    procedure RepaintForms;
    function MaskSize(MaskIndex : integer) : TSize;
    function GetSkinIndex(const SkinSection : string) : integer;
    function GetMaskIndex(SkinIndex : integer; const SkinSection, mask : string) : integer; overload;
    function GetMaskIndex(const SkinSection, mask : string) : integer; overload;
    function GetTextureIndex(SkinIndex : integer; const SkinSection, PropName : string) : integer;
    function GetPatternIndex(SkinIndex : integer; const SkinSection, pattern : string) : integer;
{$ENDIF} // NOTFORHELP

    function GetFullSkinDirectory : string;
    function GetSkinNames(sl: TStrings; SkinType : TacSkinTypes = stAllSkins) : string;
    function GetExternalSkinNames(sl: TStrings; SkinType : TacSkinTypes = stAllSkins) : string;
    procedure GetSkinSections(sl: TStrings);
    procedure ExtractInternalSkin(const NameOfSkin, DestDir : string);
    procedure ExtractByIndex(Index : integer; const DestDir : string);
    procedure UpdateSkin;

    function GetGlobalColor : TColor;
    function GetGlobalFontColor : TColor;
    function GetActiveEditColor : TColor;
    function GetActiveEditFontColor : TColor;
    function GetHighLightColor : TColor;
    function GetHighLightFontColor : TColor;

{$IFNDEF NOTFORHELP}
    function MaskWidthTop(MaskIndex : integer) : integer;
    function MaskWidthLeft(MaskIndex : integer) : integer;
    function MaskWidthBottom(MaskIndex : integer) : integer;
    function MaskWidthRight(MaskIndex : integer) : integer;

    function IsValidImgIndex(ImageIndex : integer) : boolean;
    function IsValidSkinIndex(SkinIndex : integer) : boolean;
{$ENDIF} // NOTFORHELP
    property WorkMode : TacManagerWorkMode read FWorkMode write FWorkMode default stFullAuto;
  published
    property AnimEffects : TacAnimEffects read FAnimEffects write FAnimEffects;
    property IsDefault : boolean read GetIsDefault write SetIsDefault default True;
    property Active : boolean read FActive write SetActive default True;
    property CommonSections : TStringList read FCommonSections write SetCommonSections;
    property Saturation : integer read FSaturation write SetSaturation default 0;
    property HueOffset : integer read FHueOffset write SetHueOffset default 0;
    property InternalSkins : TsStoredSkins read FBuiltInSkins write SetBuiltInSkins;
    property MenuSupport : TacMenuSupport read FMenuSupport write FMenuSupport;
    property SkinDirectory : TsDirectory read FSkinDirectory write SetSkinDirectory;
    property SkinName : TsSkinName read FSkinName write SetSkinName;
    property SkinInfo : TacSkinInfo read GetSkinInfo write SetSkinInfo;
    property SkinningRules : TacSkinningRules read FSkinningRules write FSkinningRules default [srStdForms, srStdDialogs, srThirdParty];
    property Version : string read GetVersion write SetVersion stored False;
    property SkinnedPopups : boolean read FSkinnedPopups write SetSkinnedPopups default True;
    property OnAfterChange : TNotifyEvent read FOnAfterChange write FOnAfterChange;
    property OnBeforeChange : TNotifyEvent read FOnBeforeChange write FOnBeforeChange;
    property OnGetMenuExtraLineData : TacGetExtraLineData read FOnGetPopupLineData write FOnGetPopupLineData;
  end;

{$IFNDEF NOTFORHELP}
var
  DefaultManager : TsSkinManager;
  SkinFile : TMemIniFile;
  OSVersionInfo: TOSVersionInfo;
  IsNT : boolean;
  sc : TacSkinConvertor;
  UnPackedFirst : boolean = False;

function ChangeImageInSkin(const SkinSection, PropName, FileName : string; sm : TsSkinManager) : boolean;

procedure ChangeSkinSaturation(sManager : TsSkinManager; Value : integer);
procedure ChangeSkinHue(sManager : TsSkinManager; Value : integer);
procedure ChangeSkinBrightness(sManager : TsSkinManager; Value : integer);
{$ENDIF} // NOTFORHELP

implementation

uses sMessages, acntUtils, sStoreUtils, sVclUtils, sDefaults, sCommonData,
  sSkinProps, acDials, FileCtrl, sGraphUtils, sGradient{$IFDEF DEVEX}, cxLookAndFeels{$ENDIF};

{$IFDEF DEVEX}
var
  OldRootLookAndFeel : TcxLookAndFeelKind;
{$ENDIF}

function ChangeImageInSkin(const SkinSection, PropName, FileName : string; sm : TsSkinManager) : boolean;
var
  i, l : integer;
  s : string;
begin
  with sm do begin

  Result := False;
  if not SkinData.Active then Exit;
  if (SkinSection = '') or (PropName='') or not FileExists(FileName) then Exit;

  s := UpperCase(PropName);
  // If property is Background texture
  if (s = s_PatternFile) or ( s = s_HotPatternFile) then begin
    // If loaded file is Bitmap
    if pos('.BMP', UpperCase(FileName)) > 0 then begin
      l := Length(ma);
      // ma - is array of records with image description
      if l > 0 then begin
        // search of the required image in the massive
        for i := 0 to l - 1 do begin
          if (UpperCase(ma[i].PropertyName) = s) and
               (UpperCase(ma[i].ClassName) = UpperCase(skinSection))  then begin
            // If found then we must define new Bmp
            if ma[i].Bmp = nil then ma[i].Bmp := TBitmap.Create;
            ma[i].Bmp.LoadFromFile(FileName);
            // To exit
            Result := True;
            Break;
          end;
        end;
      end;

      // If not found we must to add new image
      if not Result then begin
        l := Length(ma) + 1;
        SetLength(ma, l);
        ma[l - 1].PropertyName := '';
        ma[l - 1].ClassName := '';
        try
          ma[l - 1].Bmp := TBitmap.Create;
          ma[l - 1].Bmp.LoadFromFile(FileName);
        finally
          ma[l - 1].PropertyName := s;
          ma[l - 1].ClassName := UpperCase(skinSection);
          ma[l - 1].Manager := sm;
          ma[l - 1].R := Rect(0, 0, ma[l - 1].Bmp.Width, ma[l - 1].Bmp.Height);
          ma[l - 1].ImageCount := 1;
          ma[l - 1].ImgType := itisaTexture;
        end;
        if ma[l - 1].Bmp.Width < 1 then begin
          FreeAndNil(ma[l - 1].Bmp);
          SetLength(ma, l - 1);
        end;

        l := Length(pa);
        if l > 0 then for i := 0 to l - 1 do if (pa[i].PropertyName = s) and (pa[i].ClassName = UpperCase(skinSection)) then begin
          FreeAndNil(pa[i].Img);

          l := Length(pa) - 1;
          if l <> i then begin
            pa[i].Img          := pa[l].Img         ;
            pa[i].ClassName    := pa[l].ClassName   ;
            pa[i].PropertyName := pa[l].PropertyName;
          end;
          SetLength(pa, l);
          Break;
        end;
        Result := True;
      end;
    end
    // If loaded image is Jpeg, then working with massive of JPegs
    else begin
      l := Length(pa);
      if l > 0 then for i := 0 to l - 1 do if (pa[i].PropertyName = s) and (pa[i].ClassName = UpperCase(skinSection)) then begin
        if not Assigned(pa[i].Img) then pa[i].Img := TJpegImage.Create;
        pa[i].Img.LoadFromFile(FileName);
        Result := True;
        Break;
      end;
      if not Result then begin
        l := Length(pa) + 1;
        SetLength(pa, l);
        try
          pa[l - 1].Img := TJpegImage.Create;
          pa[l - 1].Img.LoadFromFile(FileName);
        finally
          pa[l - 1].PropertyName := s;
          pa[l - 1].ClassName := UpperCase(SkinSection);
        end;
        if pa[l - 1].Img.Width < 1 then begin
          FreeAndNil(pa[l - 1].Img);
          SetLength(pa, l - 1);
        end;
        l := Length(ma);
        if l > 0 then begin
          for i := 0 to l - 1 do begin
            if (ma[i].PropertyName = s) and (ma[i].ClassName = UpperCase(skinSection))  then begin
              FreeAndNil(ma[i].Bmp);

              l := Length(ma) - 1;
              if l <> i then begin
                ma[i].Bmp          := ma[l].Bmp         ;
                ma[i].BorderWidth  := ma[l].BorderWidth ;
                ma[i].ClassName    := ma[l].ClassName   ;
                ma[i].DrawMode     := ma[l].DrawMode    ;
                ma[i].ImageCount   := ma[l].ImageCount  ;
                ma[i].Manager      := ma[l].Manager     ;
                ma[i].MaskType     := ma[l].MaskType    ;
                ma[i].PropertyName := ma[l].PropertyName;
                ma[i].R            := ma[l].R           ;
                ma[i].WT           := ma[l].WT          ;
                ma[i].WL           := ma[l].WL          ;
                ma[i].WR           := ma[l].WR          ;
                ma[i].WB           := ma[l].WB          ;
              end;
              SetLength(ma, l);
              Break;
            end;
          end;
        end;
      end;
    end;
  end
  // If property is not background texture
  else begin
    if pos('.BMP', FileName) > 0 then begin
      l := Length(ma);
      if l > 0 then for i := 0 to l - 1 do if (ma[i].PropertyName = s) and (ma[i].ClassName = UpperCase(skinSection)) then begin
        ma[i].Bmp.LoadFromFile(FileName);
        Result := True;
        Exit
      end;
    end;
  end;

  end;
end;

procedure ChangeSkinSaturation(sManager : TsSkinManager; Value : integer);
var
  S1 : PRGBArray;
  i, l, j, w, h, x, y : integer;
  C : TsColor;
begin