smaskdata.pas

AlphaControls是一个Delphi标准控件的集合

unit sMaskData;
{$I sDefs.inc}

interface

uses Graphics, sConst, sGradient, jpeg;

type

  TsMaskData = record
    Bmp : TBitmap;
    ClassName : string;
    PropertyName : string;
    TransparentColor : TColor;
  end;

  TsPatternData = record
    Img : TJPegImage;
    ClassName : string;
    PropertyName : string;
  end;

  TsGeneralData = record
//////////// GENERAL PROPERTIES /////////
    ParentClassName : string;
    ClassName : string;
    PaintingColor : TColor;
    PaintingBevel : TsControlBevel;
    PaintingBevelWidth : integer;
    FontColor : array [1..5] of integer;
    HotFontColor : array [1..5] of integer;

    ReservedBoolean : boolean;
    // ---- Effects -----
    ShadowBlur : integer;
    ShadowColor : TColor;
    ShadowDontUse : boolean;
    ShadowEnabled : boolean;
    ShadowOffset : integer;
    ShadowTransparency : integer;
/////////// PANELS PROPERTIES ////////////
    PaintingTransparency : integer;
    GradientPercent : integer;
    GradientData : string;
    GradientArray : TsGradArray;
    ImagePercent : integer;
///////////// BUTTONS PROPERTIES /////////
    ShowFocus : boolean;
    // ---- BtnEffects ----
    FadingEnabled : boolean;
    FadingIntervalIn : integer;
    FadingIntervalOut : integer;
    FadingIterations : integer;
    // ---- PaintingOptions -----
    HotPaintingColor : TColor;
    HotPaintingTransparency : integer;
    HotPaintingBevel : TsControlBevel;
    HotPaintingBevelWidth : integer;
    HotGradientPercent : integer;
    HotGradientData : string;
    HotGradientArray : TsGradArray;
    HotImagePercent : integer;
//////////// EDITORS PROPERTIES ///////////
    PaintingColorBorderTop : TColor;
    PaintingColorBorderBottom : TColor;
    SelectionBorderBevel : TsEditorBevel;
    SelectionBorderWidth : integer;
    SelectionColor : TColor;
  end;

  TsMaskArray = array of TsMaskData;
  TsPatternArray = array of TsPatternData;
  TsGeneralDataArray = array of TsGeneralData;

procedure FreeBitmaps;
procedure FreeJpegs;
procedure LoadAllMasks;
procedure LoadAllPatterns;
procedure LoadAllGeneralData;
function IsValidImgIndex(ImageIndex : integer) : boolean;
function IsValidSkinIndex(SkinIndex : integer) : boolean;

var
  ma : TsMaskArray;
  pa : TsPatternArray;
  gd : TsGeneralDataArray;
//  i : integer;
  path : string;

implementation

uses sStyleSimply, inifiles, classes, sysutils, Dialogs, sUtils,
{$IFNDEF ALITE}
  sStoreUtils,
{$ENDIF}  
  sSkinManager, sSkinProps;

{.$DEFINE USEDUMP}

procedure FreeBitmaps;
begin
  while Length(ma) > 0 do begin
    if Assigned(ma[Length(ma) - 1].Bmp) then FreeAndNil(ma[Length(ma) - 1].Bmp);
    SetLength(ma, Length(ma) - 1);
  end;
end;

procedure FreeJpegs;
begin
  while Length(pa) > 0 do begin
    if Assigned(pa[Length(pa) - 1].Img) then FreeAndNil(pa[Length(pa) - 1].Img);
    SetLength(pa, Length(pa) - 1);
  end;
end;

procedure LoadAllPatterns;
var
  sf : TMemIniFile;
  Sections, Values : TStringList;
  SkinIndex, i, j, l : integer;
  s : string;
begin
  if sSkinData.SkinFile <> nil then begin

    sf := sSkinData.SkinFile;
    Sections := TStringList.Create;
    Values := TStringList.Create;
    try

    FreeJpegs;
    sf.ReadSections(Sections);
    for i := 0 to Sections.Count - 1 do begin
      sf.ReadSection(Sections[i], Values);
      for j := 0 to Values.Count - 1 do begin
        s := sf.ReadString(Sections[i], Values[j], '-');
        s := AnsiUpperCase(s);

        if (pos('.JPG', s) > 0) or (pos('.JPEG', s) > 0) then begin

          if (pos(':', s) < 1) then begin
            s := sSkinData.SkinPath + s;
          end;
          if FileExists(s) then begin //Break;
            l := Length(pa) + 1;
            SetLength(pa, l);
            pa[l - 1].PropertyName := '';
            pa[l - 1].ClassName := '';
            try
              pa[l - 1].Img := TJpegImage.Create;
              pa[l - 1].Img.LoadFromFile(s);
            finally
              pa[l - 1].PropertyName := UpperCase(Values[j]);
              pa[l - 1].ClassName := UpperCase(Sections[i]);
            end;
            if pa[l - 1].Img.Width < 1 then begin
              if Assigned(pa[l - 1].Img) then FreeAndNil(pa[l - 1].Img);
              SetLength(pa, l - 1);
            end;
          end;
        end;
      end;
    end;
    finally
      if Assigned(Values) then FreeAndNil(Values);
      if Assigned(Sections) then FreeAndNil(Sections);
    end;
  end
  else begin
    FreeJpegs;
    SkinIndex := -1;
    for i := 0 to sSkinData.SkinManager.InternalSkins.Count - 1 do begin
      if sSkinData.SkinManager.InternalSkins[i].Name = sSkinData.SkinManager.SkinName then begin
        SkinIndex := i;
        break;
      end;
    end;
    if SkinIndex < 0 then Exit;
    for i := 0 to sSkinData.SkinManager.InternalSkins[SkinIndex].Patterns.Count - 1 do begin
      l := Length(pa) + 1;
      SetLength(pa, l);
      pa[l - 1].Img := TJpegImage.Create;
      pa[l - 1].Img.Assign(sSkinData.SkinManager.InternalSkins[SkinIndex].Patterns[i].Image);
      pa[l - 1].PropertyName := UpperCase(sSkinData.SkinManager.InternalSkins[SkinIndex].Patterns[i].PropertyName);
      pa[l - 1].ClassName := UpperCase(sSkinData.SkinManager.InternalSkins[SkinIndex].Patterns[i].SectionName);
    end;
  end;
end;

procedure LoadAllMasks;
var
  sf : TMemIniFile;
  Sections, Values{$IFDEF USEDUMP}, Dump{$ENDIF} : TStringList;
  SkinIndex, i, j, l : integer;
  s : string;
begin
  if sSkinData.SkinFile <> nil then begin

    sf := sSkinData.SkinFile;
    Sections := TStringList.Create;
    Values := TStringList.Create;
{$IFDEF USEDUMP}
    Dump := TStringList.Create;
{$ENDIF}
    try

    FreeBitmaps;
    sf.ReadSections(Sections);
    for i := 0 to Sections.Count - 1 do begin
      sf.ReadSection(Sections[i], Values);
//if Sections[i] = 'TsStatusBar' then ;
      for j := 0 to Values.Count - 1 do begin
        s := sf.ReadString(Sections[i], Values[j], '-');
        s := AnsiUpperCase(s);

        if (pos('.BMP', s) > 0) then begin

          if (pos(':', s) < 1) then begin
            s := sSkinData.SkinPath + s;
          end;
          if FileExists(s) then begin //Break;
            l := Length(ma) + 1;
            SetLength(ma, l);
            ma[l - 1].PropertyName := '';
            ma[l - 1].ClassName := '';
            ma[l - 1].TransparentColor := clFuchsia;
            try
              ma[l - 1].Bmp := TBitmap.Create;
              ma[l - 1].Bmp.LoadFromFile(s);
            finally
              ma[l - 1].PropertyName := UpperCase(Values[j]);
              ma[l - 1].ClassName := UpperCase(Sections[i]);
{$IFDEF USEDUMP}
              Dump.Add(ma[l - 1].ClassName + ' : ' + ma[l - 1].PropertyName + ' = ' + s);
{$ENDIF}
            end;
//            if (ma[l - 1].Bmp.Width < 1) or (ma[l - 1].Bmp.PixelFormat <> pf24bit) then begin
            if (ma[l - 1].Bmp.Width < 1) then begin
              if Assigned(ma[l - 1].bmp) then FreeAndNil(ma[l - 1].Bmp);
              SetLength(ma, l - 1);
            end
            else
              try
                ma[l - 1].Bmp.PixelFormat := pf24bit;
              except
                ShowError('Error of PixelFormat changing');
              end;
          end;
        end;

      end;
    end;