sskinmanager.pas

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

              FreeAndNil(ma[i].Bmp);
              for  j := i to l - 2 do begin
                ma[j].ClassName := ma[j + 1].ClassName;
                ma[j].PropertyName := ma[j + 1].PropertyName;
                ma[j].Bmp := ma[j + 1].Bmp;
              end;
              SetLength(ma, l - 1);
              Break;
            end;
          end;
        end;
      end;
    end;
  end
  else begin
    if pos('.BMP', UpperCase(FileName)) > 0 then begin
      l := Length(ma);
      if l > 0 then begin
        for i := 0 to l - 1 do begin
          if (UpperCase(ma[i].PropertyName) = s) and
             (UpperCase(ma[i].ClassName) = UpperCase(skinSection))  then begin
            ma[i].Bmp.LoadFromFile(FileName);
            Result := True;
            Exit;
          end;
        end;
      end;
    end;
  end;
end;

constructor TsSkinManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBuiltInSkins := TsStoredSkins.Create(Self);
  if FSkinDirectory = '' then begin
    FSkinDirectory := DefSkinsDir;
  end;
  if FSkinName = '' then begin
    if DirExists(FSkinDirectory + '/' + DefSkinsName) then begin
      FSkinName := DefSkinsName;
    end;
  end;
  FActive := True;
  FSkinableMenus := TsSkinableMenus.Create(Self);
  if sSkinData.SkinManager = nil then begin
    sSkinData.SkinManager := Self;
  end
  else begin
    ShowWarning('Please, be sure that only one exemplar of TsSkinManager component is present in project.');
  end;
end;

destructor TsSkinManager.Destroy;
begin
  if Assigned(FBuiltInSkins) then FreeAndNil(FBuiltInSkins);
  if sSkinData.SkinManager = Self then begin
    SendRemoveSkin;
    sSkinData.SkinManager := nil;
  end;
  if Assigned(FSkinableMenus) then FreeAndNil(FSkinableMenus);
  inherited Destroy;
end;

procedure TsSkinManager.ExtractByIndex(Index: integer; DestDir: string);
var
  i : integer;
  DirName : string;
  sf : TMemIniFile;
begin
  DirName := NormalDir(DestDir) + InternalSkins[Index].Name + ' extracted\';
  if not DirectoryExists(DirName) then begin
    if not CreateDir(DirName) then begin
      ShowError('Directory ' + DirName + ' creation error.');
      Exit;
    end;
  end;
  sf := TMemIniFile.Create(DirName + 'Options.dat');
  try
    // Extract Bmp's
    for i := 0 to InternalSkins[Index].Images.Count - 1 do begin
      if 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
        ShowError('Images in this skin are not contains information about filenames. Please, reload skin.');
        Break;
      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;
    end;
    // Extract Ini
    SaveToIni(Index, sf);
  finally
    sf.UpdateFile;
    FreeAndNil(sf);
  end;
end;

procedure TsSkinManager.ExtractInternalSkin(NameOfSkin, DestDir: string);
var
  i : integer;
  Executed : boolean;
//  s : string;
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);
      end
      else begin
        ShowError('Directory with such name do not exists.');
      end;
      Executed := True;
    end;
  end;
  if not Executed then begin
    ShowError('Skin with such name do not exists.');
  end;
end;

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

  // External skins names loading
  if DirExists(SkinPath) then begin
    s := SkinPath + '\*.*';
    DosCode := FindFirst(s, faDirectory, FileInfo);
    try
      while DosCode = 0 do begin
        if (FileInfo.Name[1] <> '.') and (FileInfo.Attr and faDirectory = faDirectory) then begin
          sl.Add(FileInfo.Name);
          if Result = '' then Result := FileInfo.Name;
        end;
        DosCode := FindNext(FileInfo);
      end;
    finally
      FindClose(FileInfo);
    end;
  end;
end;

function TsSkinManager.GetFullskinDirectory: string;
begin
  Result := SkinDirectory;
  if (pos('.\', Result) = 1) or (pos('./', Result) = 1) then begin
    Delete(Result, 1, 2);
    Result := GetAppPath + Result;
  end
  else if (pos(':', Result) < 1) then begin
    Result := GetAppPath + Result;
  end;
  NormalDir(Result);
end;

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

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

  // External skins names loading
  if DirExists(SkinPath) then begin
    s := SkinPath + '\*.*';
    DosCode := FindFirst(s, faDirectory, FileInfo);
    try
      while DosCode = 0 do begin
        if (FileInfo.Name[1] <> '.') and (FileInfo.Attr and faDirectory = faDirectory) then begin
          sl.Add(FileInfo.Name);
          if Result = '' then Result := FileInfo.Name;
        end;
        DosCode := FindNext(FileInfo);
      end;
    finally
      FindClose(FileInfo);
    end;
  end;
end;

procedure TsSkinManager.GetSkinSections(sl: TStrings);
begin
  if sSkinData.Active and (sSkinData.SkinFile <> nil) then sSkinData.SkinFile.ReadSections(sl);
end;

procedure TsSkinManager.Loaded;
var
  M : TSMSkin;
  i : integer;
begin
  inherited;
  if Active and (SkinName <> '') then begin
    RestrictDrawing := False;
    M.Msg := SM_SETNEWSKIN;
    M.GroupIndex := GroupIndex;
    M.Result := 0;
    M.SkinManager := Self;
    if csDesigning in ComponentState then begin
      if (csLoading in ComponentState) or (csReading in ComponentState) then Exit;
      for i := 0 to Screen.FormCount - 1 do begin
        BroadCastS(Screen.Forms[i], M);
      end;
    end
    else begin
      AppBroadCastS(M);
    end;
    M.Msg := SM_REFRESH;
    M.GroupIndex := GroupIndex;
    M.Result := 0;
    M.SkinManager := Self;
    if csDesigning in ComponentState then begin
      if (csLoading in ComponentState) or (csReading in ComponentState) then Exit;
      for i := 0 to Screen.FormCount - 1 do begin
        BroadCastS(Screen.Forms[i], M);
      end;
    end
    else begin
      AppBroadCastS(M);
    end;
  end;
end;

procedure TsSkinManager.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (AComponent is TMenuItem) then begin
//    if not FSkinableMenus.IsTopLine(TMenuItem(AComponent)) then
//      FSkinableMenus.InitItem(TMenuItem(AComponent), (Operation = opInsert) and sSkinData.Active and not (csDesigning in ComponentState));
  end
  else if (AComponent is TMainMenu) then begin
    FSkinableMenus.InitMenuLine(TMainMenu(AComponent), Operation = opInsert);
  end;
end;

procedure TsSkinManager.SaveToIni(Index: integer; sf: TMemIniFile);
var
  gd : TsSkinGeneral;
  i : integer;
  s, SectionName : string;
begin
  for i := 0 to InternalSkins[Index].GeneralData.Count - 1 do begin
    gd := InternalSkins[Index].GeneralData.Items[i];
    if gd.SectionName = '' then Continue;
      SectionName := gd.SectionName;

      s := gd.ParentClassName;
      WriteIniStr(SectionName, ParentClassName, s, sf);

      s := IntToStr(gd.PaintingColor);
      WriteIniStr(SectionName, PaintingColor, s, sf);
      s := IntToStr(ord(gd.PaintingBevel));
      WriteIniStr(SectionName, PaintingBevel, s, sf);
      s := IntToStr(gd.PaintingBevelWidth);
      WriteIniStr(SectionName, PaintingBevelWidth, s, sf);

      s := IntToStr(gd.ShadowBlur);
      WriteIniStr(SectionName, ShadowBlur, s, sf);
      s := IntToStr(gd.ShadowOffset);
      WriteIniStr(SectionName, ShadowOffset, s, sf);
      s := IntToStr(gd.ShadowColor);
      WriteIniStr(SectionName, ShadowColor, s, sf);
      s := IntToStr(gd.ShadowTransparency);
      WriteIniStr(SectionName, ShadowTransparency, s, sf);
      s := iff(gd.ShadowEnabled, 'TRUE', 'FALSE');
      WriteIniStr(SectionName, ShadowEnabled, s, sf);
      s := iff(gd.ReservedBoolean, 'TRUE', 'FALSE');
      WriteIniStr(SectionName, ReservedBoolean, s, sf);
      s := ExtractWord(1, gd.FontColor, [' ']);
      WriteIniStr(SectionName, FColor, s, sf);
      s := ExtractWord(2, gd.FontColor, [' ']);
      WriteIniStr(SectionName, TCLeft, s, sf);
      s := ExtractWord(3, gd.FontColor, [' ']);
      WriteIniStr(SectionName, TCTop, s, sf);
      s := ExtractWord(4, gd.FontColor, [' ']);
      WriteIniStr(SectionName, TCRight, s, sf);
      s := ExtractWord(5, gd.FontColor, [' ']);
      WriteIniStr(SectionName, TCBottom, s, sf);
      s := ExtractWord(1, gd.HotFontColor, [' ']);
      WriteIniStr(SectionName, HotFColor, s, sf);
      s := ExtractWord(2, gd.HotFontColor, [' ']);
      WriteIniStr(SectionName, HotTCLeft, s, sf);
      s := ExtractWord(3, gd.HotFontColor, [' ']);
      WriteIniStr(SectionName, HotTCTop, s, sf);
      s := ExtractWord(4, gd.HotFontColor, [' ']);
      WriteIniStr(SectionName, HotTCRight, s, sf);
      s := ExtractWord(5, gd.HotFontColor, [' ']);
      WriteIniStr(SectionName, HotTCBottom, s, sf);
      s := IntToStr(gd.PaintingTransparency);
      WriteIniStr(SectionName, PaintingTransparency, s, sf);
      s := IntToStr(gd.GradientPercent);
      WriteIniStr(SectionName, GradientPercent, s, sf);
      s := IntToStr(gd.ImagePercent);
      WriteIniStr(SectionName, ImagePercent, s, sf);
      s := (gd.GradientData);
      WriteIniStr(SectionName, GradientData, s, sf);
      s := iff(gd.ShowFocus, 'TRUE', 'FALSE');
      WriteIniStr(SectionName, ShowFocus, s, sf);
      s := iff(gd.FadingEnabled, 'TRUE', 'FALSE');
      WriteIniStr(SectionName, FadingEnabled, s, sf);
      s := IntToStr(gd.FadingIntervalIn);
      WriteIniStr(SectionName, FadingIntervalIn, s, sf);
      s := IntToStr(gd.FadingIntervalOut);
      WriteIniStr(SectionName, FadingIntervalOut, s, sf);
      s := IntToStr(gd.FadingIterations);
      WriteIniStr(SectionName, FadingIterations, s, sf);
      s := IntToStr(gd.HotPaintingColor);
      WriteIniStr(SectionName, HotPaintingColor, s, sf);
      s := IntToStr(gd.HotPaintingTransparency);
      WriteIniStr(SectionName, HotPaintingTransparency, s, sf);
      s := IntToStr(ord(gd.HotPaintingBevel));
      WriteIniStr(SectionName, HotPaintingBevel, s, sf);
      s := IntToStr(gd.HotPaintingBevelWidth);
      WriteIniStr(SectionName, HotPaintingBevelWidth, s, sf);
      s := IntToStr(gd.HotGradientPercent);
      WriteIniStr(SectionName, HotGradientPercent, s, sf);
      s := gd.HotGradientData;
      WriteIniStr(SectionName, HotGradientData, s, sf);
      s := IntToStr(gd.HotImagePercent);
      WriteIniStr(SectionName, HotImagePercent, s, sf);
      s := IntToStr(gd.PaintingColorBorderTop);
      WriteIniStr(SectionName, PaintingColorBorderTop, s, sf);
      s := IntToStr(gd.PaintingColorBorderBottom);
      WriteIniStr(SectionName, PaintingColorBorderBottom, s, sf);
      s := IntToStr(gd.SelectionColor);
      WriteIniStr(SectionName, SelectionColor, s, sf);
      s := IntToStr(ord(gd.SelectionBorderBevel));
      WriteIniStr(SectionName, SelectionBorderBevel, s, sf);
      s := IntToStr(gd.SelectionBorderWidth);
      WriteIniStr(SectionName, SelectionBorderWidth, s, sf);


  end;
end;

procedure TsSkinManager.SendNewSkin;
var
  M : TSMSkin;
  i : integer;
begin
  sSkinData.Active := False;
  RestrictDrawing := True;

  M.Msg := SM_CLEARINDEXES;
  M.GroupIndex := GroupIndex;
  M.Result := 0;
  M.SkinManager := Self;
  if csDesigning in ComponentState then begin
    for i := 0 to Screen.FormCount - 1 do begin
      BroadCastS(Screen.Forms[i], M);
    end;
  end
  else begin
    AppBroadCastS(M);
  end;

  sSkinData.Active := True;

  M.Msg := SM_SETNEWSKIN;
  M.GroupIndex := GroupIndex;
  M.Result := 0;
  M.SkinManager := Self;
  if csDesigning in ComponentState then begin
    for i := 0 to Screen.FormCount - 1 do begin
      BroadCastS(Screen.Forms[i], M);
    end;
  end
  else begin
    AppBroadCastS(M);
  end;

  RestrictDrawing := False;
  M.Msg := SM_REFRESH;
  M.GroupIndex := GroupIndex;
  M.Result := 0;
  M.SkinManager := Self;
  if (csLoading in ComponentState) or (csReading in ComponentState) then Exit;
  if csDesigning in ComponentState then begin
    for i := 0 to Screen.FormCount - 1 do begin
      BroadCastS(Screen.Forms[i], M);
    end;
  end
  else begin
    AppBroadCastS(M);
  end;