sskinmanager.pas

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

end;

procedure TsSkinManager.SendRemoveSkin;
var
  M : TSMSkin;
  i : integer;
begin
  sSkinData.Active := False;
  M.Msg := SM_REMOVESKIN;
  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;
  FreeBitmaps;
end;

procedure TsSkinManager.SetActive(const Value: boolean);
begin
  if FActive <> Value then begin
    FActive := Value;
    if not Value then begin
      if Assigned(FOnBeforeChange) then FOnBeforeChange(Self);
      if not (csLoading in ComponentState) then SendRemoveSkin;
      if Assigned(FOnAfterChange) then FOnAfterChange(Self);
    end
    else begin
      SkinName := FSkinName;
    end;
  end;
end;

procedure TsSkinManager.SetBuiltInSkins(const Value: TsStoredSkins);
begin
  FBuiltInSkins.Assign(Value);
end;

procedure TsSkinManager.SetSkinDirectory(const Value: string);
begin
  if FSkinDirectory <> Value then begin
    FSkinDirectory := Value;
    sSkinData.SkinPath := GetFullSkinDirectory;
  end;
end;

procedure TsSkinManager.SetSkinName(const Value: TsSkinName);
var
  s : string;
begin
  FSkinName := Value;
  if FActive and (sSkinData.SkinManager = Self) then begin
    if Assigned(FOnBeforeChange) then FOnBeforeChange(Self);

    if FSkinName = '' then FSkinDirectory := '';

    sSkinData.Active := False;
    if Assigned(sSkinData.SkinFile) then FreeAndNil(sSkinData.SkinFile);
    s := GetFullskinDirectory + '\' + SkinName + '\Options.dat';
    // If used external skins
    if FileExists(s) then begin
      sSkinData.SkinFile := TMemIniFile.Create(s);
      sSkinData.SkinPath := GetFullskinDirectory + '\' + SkinName + '\';
    end
    // If used internal skins
    else begin
      sSkinData.SkinPath := '';
    end;

    LoadAllMasks;
    LoadAllPatterns;
    LoadAllGeneralData;

    SendNewSkin;
    if Assigned(FOnAfterChange) then FOnAfterChange(Self);
  end;
end;

procedure TsSkinManager.UpdateSkin;
begin
  SendNewSkin;
end;

procedure TsSkinManager.UpdateSkinSection(SectionName: string);
var
  M : TSMSkin;
  i : integer;
begin
  GlobalSectionName := UpperCase(SectionName);

  M.GroupIndex := 0;
  M.Msg := SM_UPDATESECTION;
  M.Result := 0;
  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;
end;

{ TsStoredSkins }

constructor TsStoredSkins.Create(AOwner: TsSkinManager);
begin
  inherited Create(TsStoredSkin);
  FOwner := AOwner;
end;

destructor TsStoredSkins.Destroy;
begin
  FOwner := nil;
  inherited Destroy;
end;

function TsStoredSkins.GetItem(Index: Integer): TsStoredSkin;
begin
  Result := TsStoredSkin(inherited GetItem(Index))
end;

function TsStoredSkins.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TsStoredSkins.SetItem(Index: Integer; Value: TsStoredSkin);
begin
  inherited SetItem(Index, Value);
end;

procedure TsStoredSkins.Update(Item: TCollectionItem);
begin
  inherited;
end;

{ TsStoredSkin }

procedure TsStoredSkin.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
end;

constructor TsStoredSkin.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FImages := TsSkinImages.Create(Self);
  FPatterns := TsSkinPatterns.Create(Self);
  FGeneralData := TsSkinGenerals.Create(Self);
end;

destructor TsStoredSkin.Destroy;
begin
  if Assigned(FImages) then FreeAndNil(FImages);
  if Assigned(FPatterns) then FreeAndNil(FPatterns);
  if Assigned(FGeneralData) then FreeAndNil(FGeneralData);
  inherited Destroy;
end;

procedure TsStoredSkin.LoadFromIni(gd : TsSkinGenerals; sf: TMemIniFile);
var
  Sections : TStringList;
  i, len : integer;

  function FindString(ClassName, PropertyName, DefaultValue : string) : string; var s : string; begin
    Result := sf.ReadString(ClassName, PropertyName, '?');
    if Result = '?' then begin
      s := sf.ReadString(ClassName, 'ParentClassName', '?');
      if (s <> '?') and (s <> '') and (s <> ClassName) then begin
        Result := FindString(s, PropertyName, '?');
      end;
    end;
    if Result = '?' then Result := DefaultValue;
  end;

  function FindInteger(ClassName, PropertyName : string; DefaultValue : integer) : integer; var s : string; begin
    Result := sf.ReadInteger(ClassName, PropertyName, -1);
    if Result = -1 then begin
      s := sf.ReadString(ClassName, 'ParentClassName', '?');
      if (s <> '?') and (s <> '') and (s <> ClassName) then begin
        Result := FindInteger(s, PropertyName, -1);
      end;
    end;
    if Result = -1 then Result := DefaultValue;
  end;

begin
  if sf <> nil then begin

    Sections := TStringList.Create;
    try
    sf.ReadSections(Sections);
    len := Sections.Count - 1;
    for i := 0 to len do begin
      gd.Add;
//General data
      gd[i].SectionName := Sections[i];
      gd[i].ParentClassName := sf.ReadString(Sections[i], 'ParentClassName', '');

      gd[i].PaintingColor := FindInteger(Sections[i], 'PaintingColor', clWhite);
      gd[i].PaintingBevel := aControlBevels[FindInteger(Sections[i], 'PaintingBevel', 0)];


      gd[i].PaintingBevelWidth := FindInteger(Sections[i], 'PaintingBevelWidth', 2);
      gd[i].ShadowBlur := FindInteger(Sections[i], 'ShadowBlur', 6);
      gd[i].ShadowOffset := FindInteger(Sections[i], 'ShadowOffset', 3);
      gd[i].ShadowColor := sf.ReadInteger(Sections[i], 'ShadowColor', 0);
      gd[i].ShadowTransparency := FindInteger(Sections[i], 'ShadowTransparency', 60);

      gd[i].ShadowEnabled := UpperCase(FindString(Sections[i], 'ShadowEnabled', 'FALSE')) = 'TRUE';
      gd[i].ReservedBoolean := UpperCase(FindString(Sections[i], ReservedBoolean, 'FALSE')) = 'TRUE';

      gd[i].FontColor := FindString(Sections[i], FColor, '0') + ' ' +
                         FindString(Sections[i], TCLeft  , '-1') + ' ' +
                         FindString(Sections[i], TCTop   , '-1') + ' ' +
                         FindString(Sections[i], TCRight , '-1') + ' ' +
                         FindString(Sections[i], TCBottom, '-1');

      gd[i].HotFontColor := FindString(Sections[i], HotFColor, '0') + ' ' +
                            FindString(Sections[i], HotTCLeft  , '-1') + ' ' +
                            FindString(Sections[i], HotTCTop   , '-1') + ' ' +
                            FindString(Sections[i], HotTCRight , '-1') + ' ' +
                            FindString(Sections[i], HotTCBottom, '-1');


      gd[i].PaintingTransparency := FindInteger(Sections[i], 'PaintingTransparency', 0);
      gd[i].GradientPercent := FindInteger(Sections[i], 'GradientPercent', 0);
      gd[i].ImagePercent := FindInteger(Sections[i], 'ImagePercent', 0);
      gd[i].GradientData := FindString(Sections[i], 'GradientData', ' ');
      gd[i].ShowFocus := UpperCase(FindString(Sections[i], 'ShowFocus', 'FALSE')) = 'TRUE';
      gd[i].FadingEnabled := UpperCase(FindString(Sections[i], 'FadingEnabled', 'FALSE')) = 'TRUE';
      gd[i].FadingIntervalIn := FindInteger(Sections[i], 'FadingIntervalIn', 5);
      gd[i].FadingIntervalOut := FindInteger(Sections[i], 'FadingIntervalOut', 5);
      gd[i].FadingIterations := FindInteger(Sections[i], 'FadingIterations', 5);

      gd[i].HotPaintingColor := TColor(FindInteger(Sections[i], 'HotPaintingColor', clWhite));
      gd[i].HotPaintingTransparency := FindInteger(Sections[i], 'HotPaintingTransparency', 0);
      gd[i].HotPaintingBevel := aControlBevels[FindInteger(Sections[i], 'HotPaintingBevel', 0)];
      gd[i].HotPaintingBevelWidth := FindInteger(Sections[i], 'HotPaintingBevelWidth', 2);

      gd[i].HotGradientPercent := FindInteger(Sections[i], 'HotGradientPercent', 0);
      gd[i].HotGradientData := FindString(Sections[i], 'HotGradientData', ' ');
      gd[i].HotImagePercent := FindInteger(Sections[i], 'HotImagePercent', 0);

      gd[i].PaintingColorBorderTop := TColor(FindInteger(Sections[i], 'PaintingColorBorderTop', 0));
      gd[i].PaintingColorBorderBottom := TColor(FindInteger(Sections[i], 'PaintingColorBorderBottom', 0));
      gd[i].SelectionColor := TColor(FindInteger(Sections[i], 'SelectionColor', clWhite));
      gd[i].SelectionBorderBevel := aEditorBevels[FindInteger(Sections[i], 'SelectionBorderBevel', 2)];
      gd[i].SelectionBorderWidth := FindInteger(Sections[i], 'SelectionBorderWidth', 2);

    end;

    finally
      if Assigned(Sections) then FreeAndNil(Sections);
    end;
  end
end;

procedure TsStoredSkin.LoadSkin(sf : TMemIniFile);
var
  Sections, Values : TStringList;
  i, j{, l} : integer;
  s : string;
begin
  GeneralData.Add;
  LoadFromIni(GeneralData, sf);

  Images.Clear;
  Sections := TStringList.Create;
  Values := TStringList.Create;
  try
  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('.BMP', s) > 0) then begin

        if (pos(':', s) < 1) then begin
          s := ExtractFilePath(sf.FileName) + s;
        end;
//        ShowMessage(s);
        if FileExists(s) then begin
          Images.Add;

          Images[Images.Count - 1].PropertyName := '';
          Images[Images.Count - 1].SectionName := '';
          Images[Images.Count - 1].Name := ExtractFileName(s);
          try
            Images[Images.Count - 1].Image := TBitmap.Create;
            Images[Images.Count - 1].Image.LoadFromFile(s);
          finally
            Images[Images.Count - 1].PropertyName := Values[j];
            Images[Images.Count - 1].SectionName := Sections[i];
          end;
          if Images[Images.Count - 1].Image.Width < 1 then begin
//            FreeAndNil(Images[Images.Count - 1].Image);
            Images.Delete(Images.Count - 1);
          end
          else begin
            Images[Images.Count - 1].Image.PixelFormat := pf24bit;
          end;
        end;
      end;

    end;
  end;
  // Read patterns
  Sections.Clear;
  Values.Clear;
  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 := ExtractFilePath(sf.FileName) + s;
        end;
        if FileExists(s) then begin
          Patterns.Add;

          Patterns[Patterns.Count - 1].PropertyName := '';
          Patterns[Patterns.Count - 1].SectionName := '';
          Patterns[Patterns.Count - 1].Name := ExtractFileName(s);
          try
            Patterns[Patterns.Count - 1].Image := TJpegImage.Create;
            Patterns[Patterns.Count - 1].Image.LoadFromFile(s);
          finally
            Patterns[Patterns.Count - 1].PropertyName := Values[j];
            Patterns[Patterns.Count - 1].SectionName := Sections[i];
          end;
          if Patterns[Patterns.Count - 1].Image.Width < 1 then begin
            Patterns.Delete(Images.Count - 1);
          end;
        end;
      end;
    end;
  end;

  finally
    if Assigned(Values) then FreeAndNil(Values);
    if Assigned(Sections) then FreeAndNil(Sections);
  end;
end;

procedure TsStoredSkin.SetGeneralData(const Value: TsSkinGenerals);
begin
  FGeneralData.Assign(Value);
end;

procedure TsStoredSkin.SetImages(const Value: TsSkinImages);
begin
  FImages.Assign(Value);
end;

procedure TsStoredSkin.SetName(const Value: string);
begin
  if FName <> Value then begin
    FName := Value;
  end;
end;

procedure TsStoredSkin.SetPatterns(const Value: TsSkinPatterns);
begin
  FPatterns.Assign(Value);
end;

{ TsSkinImages }

constructor TsSkinImages.Create(AOwner: TsStoredSkin);
begin
  inherited Create(TsSkinImage);
  FOwner := AOwner;
end;

destructor TsSkinImages.Destroy;
begin
  FOwner := nil;
  inherited Destroy;
end;

function TsSkinImages.GetItem(Index: Integer): TsSkinImage;
begin
  Result := TsSkinImage(inherited GetItem(Index))
end;

function TsSkinImages.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TsSkinImages.SetItem(Index: Integer; Value: TsSkinImage);
begin
  inherited SetItem(Index, Value);
end;

procedure TsSkinImages.Update(Item: TCollectionItem);
begin
  inherited;