sskinmanager.pas

Alpha Controls.v5.46b Source

  if (DefaultManager = nil) then FIsDefault := True;

  l := ord(acLastSupportedType);
  SetLength(ThirdLists, l + 1);
  for i := 0 to l do ThirdLists[i] := TStringList.Create;

  SkinData := TsSkinData.Create;
  SkinData.Active := False;
  FBuiltInSkins := TsStoredSkins.Create(Self);
  FCommonSections := TStringList.Create;
  FSkinnedPopups := True;
  FHueOffset := 0;
  FMenuSupport := TacMenuSupport.Create;
  FAnimEffects := TacAnimEffects.Create;
  FAnimEffects.Manager := Self;
  FAnimEffects.Buttons.Manager := Self;
  GlobalHookInstalled := False;
  FSkinningRules := [srStdForms, srStdDialogs, srThirdParty];
  if (DefaultManager = nil) then begin
    DefaultManager := Self;
    if IsNT and not (csDesigning in ComponentState) then Application.HookMainWindow(MainWindowHook);
  end;
  FActive := True;
  FSkinableMenus := TsSkinableMenus.Create(Self);
  SetLength(gd, 0);
  SetLength(ma, 0);
  SetLength(pa, 0);
end;

destructor TsSkinManager.Destroy;
var
  i : integer;
begin
{.$IFDEF LOGGED
  if LogLines <> nil then begin
    LogLines.SaveToFile(LogFile);
    LogLines.Free;
  end;
$ENDIF}
  Active := False;
  FreeAndNil(FAnimEffects);
  if Assigned(FBuiltInSkins) then FreeAndNil(FBuiltInSkins);
  if Assigned(FSkinableMenus) then FreeAndNil(FSkinableMenus);
  FreeAndNil(FCommonSections);
  if Assigned(SkinData) then SkinData.Free;
  FreeAndNil(FMenuSupport);
  FreeJpegs;
  FreeBitmaps;
  if (DefaultManager = Self) then begin
    if IsNT and not (csDesigning in ComponentState) then Application.UnHookMainWindow(MainWindowHook);
    DefaultManager := nil;
  end;

  UpdateThirdNames(Self);

  for i := 0 to Length(ThirdLists) - 1 do if ThirdLists[i] <> nil then FreeAndNil(ThirdLists[i]);
  SetLength(ThirdLists, 0);

  FreeAndNil(FThirdParty);

  inherited Destroy;
end;

procedure TsSkinManager.ExtractByIndex(Index: integer; const DestDir: string);
var
  i : integer;
  DirName, s : string;
  sf : TMemIniFile;
begin
  DirName := NormalDir(DestDir) + InternalSkins[Index].Name + ' extracted\';
  if not DirectoryExists(DirName) then begin
    if not CreateDir(DirName) then begin
{$IFNDEF ALITE}
      ShowError('Directory ' + DirName + ' creation error.');
{$ENDIF}
      Exit;
    end;
  end;
  sf := TMemIniFile.Create(DirName + OptionsDatName);
  try
    if Assigned(InternalSkins[Index].FMasterBitmap) then begin
      InternalSkins[Index].FMasterBitmap.SaveToFile(DirName + MasterBmpName);
      WriteIniStr(s_GLOBALINFO, s_MASTERBITMAP, UpperCase(MasterBmpName), sf);
    end;
    // Extract Bmp's
    for i := 0 to InternalSkins[Index].Images.Count - 1 do begin
      if (InternalSkins[Index].Images[i].Image <> nil) and (InternalSkins[Index].Images[i].Name <> '') then begin
        InternalSkins[Index].Images[i].Image.SaveToFile(DirName + InternalSkins[Index].Images[i].Name);
        WriteIniStr(InternalSkins[Index].Images[i].SectionName, InternalSkins[Index].Images[i].PropertyName, InternalSkins[Index].Images[i].Name, sf);
      end
      else begin
        if (InternalSkins[Index].Images[i].PropertyName = s_Pattern) or (InternalSkins[Index].Images[i].PropertyName = s_HotPattern) then begin
          s := TexChar + AddChar(ZeroChar, IntToStr(InternalSkins[Index].Images[i].Left), 4) +
               TexChar + AddChar(ZeroChar, IntToStr(InternalSkins[Index].Images[i].Top), 4) +
               TexChar + AddChar(ZeroChar, IntToStr(InternalSkins[Index].Images[i].Right), 4) +
               TexChar + AddChar(ZeroChar, IntToStr(InternalSkins[Index].Images[i].Bottom), 4) +
               TexChar + AddChar(ZeroChar, IntToStr(InternalSkins[Index].Images[i].StretchMode), 2) + 
               TexChar + AddChar(ZeroChar, IntToStr(InternalSkins[Index].Images[i].MaskType), 1);
        end
        else begin
          s := '#(' + IntToStr(InternalSkins[Index].Images[i].Left) + ',' +
                      IntToStr(InternalSkins[Index].Images[i].Top) + ',' +
                      IntToStr(InternalSkins[Index].Images[i].Right) + ',' +
                      IntToStr(InternalSkins[Index].Images[i].Bottom) + '),' +
                      IntToStr(InternalSkins[Index].Images[i].ImageCount) + ',' +
                      IntToStr(InternalSkins[Index].Images[i].MaskType);
        end;
        WriteIniStr(InternalSkins[Index].Images[i].SectionName, InternalSkins[Index].Images[i].PropertyName, s, sf);
      end;
    end;
    // Extract Jpeg's
    for i := 0 to InternalSkins[Index].Patterns.Count - 1 do begin
      if InternalSkins[Index].Patterns[i].Name <> '' then begin
        InternalSkins[Index].Patterns[i].Image.SaveToFile(DirName + InternalSkins[Index].Patterns[i].Name);
        WriteIniStr(InternalSkins[Index].Patterns[i].SectionName, InternalSkins[Index].Patterns[i].PropertyName, InternalSkins[Index].Patterns[i].Name, sf);
{      end
      else begin
        s := '#(' + IntToStr(InternalSkins[Index].Patterns[i].R.Left) + ',' +
                    IntToStr(InternalSkins[Index].Patterns[i].R.Top) + ',' +
                    IntToStr(InternalSkins[Index].Patterns[i].R.Right) + ',' +
                    IntToStr(InternalSkins[Index].Patterns[i].R.Bottom) + '),3,1';
        WriteIniStr(InternalSkins[Index].Patterns[i].SectionName, InternalSkins[Index].Patterns[i].PropertyName, s, sf); v402}
      end;
    end;
    // Extract Ini
    SaveToIni(Index, sf);
  finally
    sf.UpdateFile;
    FreeAndNil(sf);
  end;
end;

procedure TsSkinManager.ExtractInternalSkin(const NameOfSkin, DestDir: string);
var
  i : integer;
  Executed : boolean;
begin
  Executed := False;
  for i := 0 to InternalSkins.Count - 1 do begin
    if InternalSkins[i].Name = NameOfskin then begin
      if DirectoryExists(Destdir) then begin
        ExtractByIndex(i, Destdir);
{$IFNDEF ALITE}
      end
      else begin
        ShowError('Directory with such name do not exists.');
{$ENDIF}
      end;
      Executed := True;
    end;
  end;
  if not Executed then begin
{$IFNDEF ALITE}
    ShowError('Skin with such name do not exists.');
{$ENDIF}
  end;
end;

function TsSkinManager.GetExternalSkinNames(sl: TStrings; SkinType : TacSkinTypes = stAllSkins): string;
var
  FileInfo: TSearchRec;
  DosCode: Integer;
  s : string;
  SkinPath : string;
  stl : TStringList;
begin
  Result := '';
  SkinPath := GetFullskinDirectory;
  sl.Clear;
  stl := TStringList.Create;

  // External skins names loading
  if DirectoryExists(SkinPath) then begin
    s := SkinPath + '\*.*';
    DosCode := FindFirst(s, faDirectory, FileInfo);
    try
      while DosCode = 0 do begin
        if (FileInfo.Name[1] <> '.') then begin
          if (SkinType in [stUnpacked, stAllSkins]) and (FileInfo.Attr and faDirectory = faDirectory) and FileExists(SkinPath + '\' + FileInfo.Name + '\' + OptionsDatName) then begin
            stl.Add(FileInfo.Name);
            if Result = '' then Result := FileInfo.Name;
          end
          else if (SkinType in [stPacked, stAllSkins]) and (FileInfo.Attr and faDirectory <> faDirectory) and (ExtractFileExt(FileInfo.Name) = '.' + acSkinExt) then begin
            s := ExtractWord(1, FileInfo.Name, ['.']);
            stl.Add(s);
            if Result = '' then Result := s;
          end;
        end;
        DosCode := FindNext(FileInfo);
      end;
    finally
      FindClose(FileInfo);
    end;
  end;
  stl.Sort;
  sl.Assign(stl);
  FreeAndNil(stl);
end;

function TsSkinManager.GetFullSkinDirectory: string;
var
  s : string;
begin
  Result := SkinDirectory;
  if (pos('..', Result) = 1) then begin
    s := GetAppPath;
    Delete(s, Length(s), 1);
    while (s[Length(s)] <> '/') and (s[Length(s)] <> '\') do begin
      Delete(s, Length(s), 1);
    end;
    Delete(Result, 1, 3);
    Result := s + Result;
  end
  else if (pos('.\', Result) = 1) or (pos('./', Result) = 1) then begin
    Delete(Result, 1, 2);
    Result := GetAppPath + Result;
  end
  else if (pos(':', Result) < 1) and (pos('\\', Result) < 1) then begin
    Result := GetAppPath + Result;
  end;
  NormalDir(Result);
end;

function TsSkinManager.GetGlobalColor: TColor;
begin
  if (ConstData.IndexGlobalInfo > -1) and (ConstData.IndexGlobalInfo <= Length(gd) - 1) then Result := ColorToRGB(gd[ConstData.IndexGlobalInfo].Color) else Result := ColorToRGB(clBtnFace);
end;

function TsSkinManager.GetGlobalFontColor: TColor;
begin
  if (ConstData.IndexGlobalInfo > -1) and (ConstData.IndexGlobalInfo <= Length(gd) - 1) then Result := ColorToRGB(gd[ConstData.IndexGlobalInfo].FontColor[1]) else Result := clFuchsia;
end;

function TsSkinManager.GetSkinNames(sl: TStrings; SkinType : TacSkinTypes = stAllSkins) : string;
var
  FileInfo: TSearchRec;
  DosCode: Integer;
  s : string;
  SkinPath : string;
  stl : TStringList;
begin
  Result := '';
  SkinPath := GetFullskinDirectory;
  sl.Clear;
  stl := TStringList.Create;

  // Internal skins names loading
  if InternalSkins.Count > 0 then begin
    for DosCode := 0 to InternalSkins.Count - 1 do begin
      stl.Add(InternalSkins[DosCode].Name);
      if Result = '' then Result := InternalSkins[DosCode].Name;
    end;
  end;

  // External skins names loading
  if DirectoryExists(SkinPath) then begin
    s := SkinPath + '\*.*';
    DosCode := FindFirst(s, faDirectory, FileInfo);
    try
      while DosCode = 0 do begin
        if (FileInfo.Name[1] <> '.') then begin
          if (SkinType in [stUnpacked, stAllSkins]) and (FileInfo.Attr and faDirectory = faDirectory) and FileExists(SkinPath + '\' + FileInfo.Name + '\' + OptionsDatName) then begin
            stl.Add(FileInfo.Name);
            if Result = '' then Result := FileInfo.Name;
          end
          else if (SkinType in [stPacked, stAllSkins]) and (FileInfo.Attr and faDirectory <> faDirectory) and (ExtractFileExt(FileInfo.Name) = '.' + acSkinExt) then begin
            s := ExtractWord(1, FileInfo.Name, ['.']);
            stl.Add(s);
            if Result = '' then Result := s;
          end;
        end;
        DosCode := FindNext(FileInfo);
      end;
    finally
      FindClose(FileInfo);
    end;
  end;
  stl.Sort;
  sl.Assign(stl);
  FreeAndNil(stl);
end;

procedure TsSkinManager.GetSkinSections(sl: TStrings);
var
  i : integer;
begin
  sl.Clear;
  if SkinData.Active
    then for i := Low(gd) to High(gd) do sl.Add(gd[i].ClassName);
end;

function TsSkinManager.GetSkinInfo: TacSkinInfo;
var
  s : char;
begin
  if SkinData.Active then begin
    s := DecimalSeparator;
    DecimalSeparator := '.';
    Result := FloatToStr(SkinData.Version);
    DecimalSeparator := s;
  end
  else Result := 'N/A';
end;

function TsSkinManager.GetVersion: string;
begin
  Result := CurrentVersion;
end;

procedure TsSkinManager.InitConstantIndexes;
begin
  with ConstData do begin
    IndexGlobalInfo := GetSkinIndex(s_GlobalInfo);
    if IndexGlobalInfo > -1 then begin
      // Global data
      CheckBoxChecked := GetMaskIndex(IndexGlobalInfo, s_GlobalInfo, s_CheckBoxChecked);
      CheckBoxUnChecked := GetMaskIndex(IndexGlobalInfo, s_GlobalInfo, s_CheckBoxUnChecked);
      CheckBoxGrayed := GetMaskIndex(IndexGlobalInfo, s_GlobalInfo, s_CheckBoxGrayed);
      RadioButtonChecked := GetMaskIndex(IndexGlobalInfo, s_GlobalInfo, s_RadioButtonChecked);
      RadioButtonUnChecked := GetMaskIndex(IndexGlobalInfo, s_GlobalInfo, s_RadioButtonUnChecked);
      RadioButtonGrayed := GetMaskIndex(IndexGlobalInfo, s_GlobalInfo, s_RadioButtonGrayed);

      SmallCheckBoxChecked := GetMaskIndex(IndexGlobalInfo, s_GlobalInfo, s_SmallBoxChecked);
      SmallCheckBoxUnChecked := GetMaskIndex(IndexGlobalInfo, s_GlobalInfo, s_SmallBoxUnChecked);