sskinmanager.pas

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

    WriteIniStr(SectionName, s_ParentClass, s, sf);

    s := IntToStr(gd.Color);
    WriteIniStr(SectionName, s_Color, s, sf);
    s := IntToStr(ord(gd.Bevel));
    WriteIniStr(SectionName, s_Bevel, s, sf);

    s := IntToStr(gd.ShadowBlur);
    WriteIniStr(SectionName, s_ShadowBlur, s, sf);
    s := IntToStr(gd.ShadowOffset);
    WriteIniStr(SectionName, s_ShadowOffset, s, sf);
    s := IntToStr(gd.ShadowColor);
    WriteIniStr(SectionName, s_ShadowColor, s, sf);
    s := IntToStr(gd.ShadowTransparency);
    WriteIniStr(SectionName, s_ShadowTransparency, s, sf);
    s := iff(gd.ShadowEnabled, 'TRUE', 'FALSE');
    WriteIniStr(SectionName, s_ShadowEnabled, s, sf);
    s := iff(gd.ReservedBoolean, 'TRUE', 'FALSE');
    WriteIniStr(SectionName, s_ReservedBoolean, s, sf);
    s := ExtractWord(1, gd.FontColor, [' ']);
    WriteIniStr(SectionName, s_FontColor, s, sf);
    s := ExtractWord(2, gd.FontColor, [' ']);
    WriteIniStr(SectionName, s_TCLeft, s, sf);
    s := ExtractWord(3, gd.FontColor, [' ']);
    WriteIniStr(SectionName, s_TCTop, s, sf);
    s := ExtractWord(4, gd.FontColor, [' ']);
    WriteIniStr(SectionName, s_TCRight, s, sf);
    s := ExtractWord(5, gd.FontColor, [' ']);
    WriteIniStr(SectionName, s_TCBottom, s, sf);
    s := ExtractWord(1, gd.HotFontColor, [' ']);
    WriteIniStr(SectionName, s_HotFontColor, s, sf);
    s := ExtractWord(2, gd.HotFontColor, [' ']);
    WriteIniStr(SectionName, s_HotTCLeft, s, sf);
    s := ExtractWord(3, gd.HotFontColor, [' ']);
    WriteIniStr(SectionName, s_HotTCTop, s, sf);
    s := ExtractWord(4, gd.HotFontColor, [' ']);
    WriteIniStr(SectionName, s_HotTCRight, s, sf);
    s := ExtractWord(5, gd.HotFontColor, [' ']);
    WriteIniStr(SectionName, s_HotTCBottom, s, sf);
    s := IntToStr(gd.Transparency);
    WriteIniStr(SectionName, s_Transparency, s, sf);
    s := IntToStr(gd.GradientPercent);
    WriteIniStr(SectionName, s_GradientPercent, s, sf);
    s := IntToStr(gd.ImagePercent);
    WriteIniStr(SectionName, s_ImagePercent, s, sf);
    s := (gd.GradientData);
    WriteIniStr(SectionName, s_GradientData, s, sf);
    s := iff(gd.ShowFocus, 'TRUE', 'FALSE');
    WriteIniStr(SectionName, s_ShowFocus, s, sf);
    s := iff(gd.FadingEnabled, 'TRUE', 'FALSE');
    WriteIniStr(SectionName, s_FadingEnabled, s, sf);
    s := IntToStr(gd.FadingIntervalIn);
    WriteIniStr(SectionName, s_FadingIntervalIn, s, sf);
    s := IntToStr(gd.FadingIntervalOut);
    WriteIniStr(SectionName, s_FadingIntervalOut, s, sf);
    s := IntToStr(gd.FadingIterations);
    WriteIniStr(SectionName, s_FadingIterations, s, sf);
    s := IntToStr(gd.HotColor);
    WriteIniStr(SectionName, s_HotColor, s, sf);
    s := IntToStr(gd.HotTransparency);
    WriteIniStr(SectionName, s_HotTransparency, s, sf);
    s := IntToStr(ord(gd.HotBevel));
    WriteIniStr(SectionName, s_HotBevel, s, sf);
    s := IntToStr(gd.HotGradientPercent);
    WriteIniStr(SectionName, s_HotGradientPercent, s, sf);
    s := gd.HotGradientData;
    WriteIniStr(SectionName, s_HotGradientData, s, sf);
    s := IntToStr(gd.HotImagePercent);
    WriteIniStr(SectionName, s_HotImagePercent, s, sf);
    s := IntToStr(gd.BorderColor1);
    WriteIniStr(SectionName, s_BorderColor1, s, sf);
    s := IntToStr(gd.BorderColor2);
    WriteIniStr(SectionName, s_BorderColor2, s, sf);
  end;
end;

procedure TsSkinManager.SendNewSkin;
var
  M : TMessage;
  i : integer;
begin
  if not (csDesigning in ComponentState) and (Application.MainForm <> nil) then LockForms(Self);

  if SkinableMenus <> nil then begin
    SkinableMenus.SkinBorderWidth := -1;
  end;
  SkinData.Active := False;
  RestrictDrawing := True;

  InitConstantIndexes; // v4.34

  M.Msg := SM_ALPHACMD;
  M.WParam := MakeWParam(0, AC_SETNEWSKIN);
  M.LParam := longint(Self);
  M.Result := 0;
  if csDesigning in ComponentState
    then for i := 0 to Screen.FormCount - 1 do begin
      if (Screen.Forms[i].Name = '') or (Screen.Forms[i].Name = 'AppBuilder') or (Screen.Forms[i].Name = 'PropertyInspector') then Continue;
      SendToProvider(Screen.Forms[i], M);
      AlphaBroadCast(Screen.Forms[i], M);
      SendToHooked(M);
    end
    else AppBroadCastS(M);
  RestrictDrawing := False;
  SkinData.Active := True;

  if (DefaultManager = Self) and not GlobalHookInstalled then InstallHook;

  RepaintForms;
{$IFDEF DEVEX}
  if RootLookAndFeel.Kind <> lfOffice11 then begin
    OldRootLookAndFeel := RootLookAndFeel.Kind;
  end;
  RootLookAndFeel.Kind := lfStandard;
  RootLookAndFeel.Kind := lfOffice11;
{$ENDIF}
end;

procedure TsSkinManager.SendRemoveSkin;
var
  M : TMessage;//TSMManagerMsg;
  i : integer;
begin
{$IFDEF DEVEX}
  RootLookAndFeel.Kind := OldRootLookAndFeel;
{$ENDIF}
  aSkinRemoving := True;
  UninstallHook;
  SkinData.Active := False;
  M.Msg := SM_ALPHACMD;
  M.WParam := MakeWParam(0, AC_REMOVESKIN);
  M.LParam := longint(Self);
  M.Result := 0;
  if csDesigning in ComponentState then begin
    for i := 0 to Screen.FormCount - 1 do begin
      if (Screen.Forms[i].Name = '') or
         (Screen.Forms[i].Name = 'AppBuilder') or
         (pos('EditWindow_', Screen.Forms[i].Name)> 0) or
         (pos('DockSite', Screen.Forms[i].Name)> 0) or
         (Screen.Forms[i].Name = 'PropertyInspector') then Continue;
      SendToProvider(Screen.Forms[i], M);
      AlphaBroadCast(Screen.Forms[i], M);
      SendToHooked(M);
    end;
  end
  else begin
    AppBroadCastS(M);
  end;
  FreeBitmaps;
  FreeJpegs;
  SetLength(gd, 0);
  aSkinRemoving := False;
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;
      InitConstantIndexes;
//      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.SetCommonSections(const Value: TStringList);
var
  i : integer;
  s : string;
begin
  FCommonSections.Assign(Value);
  for i := 0 to FCommonSections.Count - 1 do begin
    s := FCommonSections[i];
    if (s <> '') and (s[1] <> ';') then FCommonSections[i] := acntUtils.DelChars(s, ' ');
  end;
  SkinName := SkinName;
end;

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

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

    SkinData.Active := False;

    s := NormalDir(SkinDirectory) + Value + '.' + acSkinExt;
    SkinIsPacked := False;
    if UnPackedFirst and DirectoryExists(NormalDir(SkinDirectory) + Value) then begin
      SkinIsPacked := False;
    end
    else begin
      SkinIsPacked := FileExists(s);
    end;

    if SkinIsPacked then ReloadPackedSkin else ReloadSkin;

    if FActive then begin
      if not NonAutoUpdate then SendNewSkin ;
    end
    else SendRemoveSkin;
    aSkinChanging := False;
    if Assigned(FOnAfterChange) then FOnAfterChange(Self);
  end;
end;

procedure TsSkinManager.SetSkinnedPopups(const Value: boolean);
begin
  if FSkinnedPopups <> Value then begin
    FSkinnedPopups := Value;
    if not (csDesigning in ComponentState) and FSkinnedPopups and (SkinableMenus <> nil) and IsDefault then begin
      SkinableMenus.UpdateMenus;
    end;
  end;
end;

procedure TsSkinManager.SetSkinInfo(const Value: TacSkinInfo); begin end;

procedure TsSkinManager.SetVersion(const Value: string); begin end;

procedure TsSkinManager.UpdateSkin;
begin
  if Active then SendNewSkin;
end;

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

  M.Msg := SM_ALPHACMD;
  M.WParamHi := AC_UPDATESECTION;
  M.Result := 0;
  if csDesigning in ComponentState then begin
    for i := 0 to Screen.FormCount - 1 do begin
      AlphaBroadCast(Screen.Forms[i], M);
    end;
  end
  else begin
    AppBroadCastS(M);
  end;
end;

procedure TsSkinManager.RepaintForms;
var
  M : TMessage;
  i : integer;
begin
  M.Msg := SM_ALPHACMD;
  M.LParam := longint(Self);

  if not (csDesigning in ComponentState) then begin
    M.WParam := MakeWParam(0, AC_STOPFADING);
    M.Result := 0;
    AppBroadCastS(M);
  end;

  M.WParam := MakeWParam(0, AC_REFRESH);
  M.Result := 0;
  if csDesigning in ComponentState then for i := 0 to Screen.FormCount - 1 do begin
    if (Screen.Forms[i].Name = '') or (Screen.Forms[i].Name = 'AppBuilder') or (Screen.Forms[i].Name = 'PropertyInspector') then Continue;
    AlphaBroadCast(Screen.Forms[i], M);
    SendToProvider(Screen.Forms[i], M);
    SendToHooked(M);
  end
  else begin
    if not (csLoading in ComponentState) and (Application.MainForm <> nil) then LockForms(Self);
    AppBroadCastS(M);
    if not (csLoading in ComponentState) and (Application.MainForm <> nil) then UnLockForms(Self);
  end;
  if Assigned(acMagnForm) then SendMessage(acMagnForm.Handle, M.Msg, M.WParam, M.LParam);
end;

procedure TsSkinManager.SetHueOffset(const Value: integer);
var
  s : string;
begin
  if FHueOffset <> Value then begin
    FHueOffset := Value;

    if SkinData.Active then begin
      aSkinChanging := True;
      s := NormalDir(SkinDirectory) + SkinName + '.' + acSkinExt;
      SkinIsPacked := FileExists(s);

      if SkinIsPacked then ReloadPackedSkin else ReloadSkin;
//      if ReloadSkin;
      aSkinChanging := False;
      if not (csLoading in ComponentState) and not (csReading in ComponentState) then RepaintForms;
{$IFDEF DEVEX}
      if RootLookAndFeel.Kind <> lfOffice11 then OldRootLookAndFeel := RootLookAndFeel.Kind;
      RootLookAndFeel.Kind := lfStandard;
      RootLookAndFeel.Kind := lfOffice11;
{$ENDIF}
//      AnimEffects.Dialogs.FTime := i1;
//      AnimEffects.Forms.FTime := i2;
    end
  end;
end;

procedure TsSkinManager.SetSaturation(const Value: integer);
var
  s : string;
begin
  if FSaturation <> Value then begin
    FSaturation := Value;
    if SkinData.Active then begin
      aSkinChanging := True;
      s := NormalDir(SkinDirectory) + SkinName + '.' + acSkinExt;