盒子论坛 v2.1

hi @Dalas

try my code if works for you:

implementation

{$R *.dfm}

uses
  Vcl.Themes;

const
  StyleDir: string = 'C:\Users\Public\Documents\Embarcadero\Studio\22.0\Styles\';
  MyStyle: string  = 'RubyGraphite.vsf'; // 'GoldenGraphite.Style'; // 'RubyGraphite.vsf';

var
  MyStyleServicesHandle: Pointer;

procedure TForm1.BtnAddNewStyleByFileNameClick(Sender: TObject);
var
  StyleInfo: TStyleInfo;
begin
  if TStyleManager.IsValidStyle('C:\Users\Public\Documents\Embarcadero\Studio\22.0\Styles\RubyGraphite.vsf', StyleInfo) then
  begin
    if TStyleManager.Style[StyleInfo.Name] <> nil then
    begin
      // ShowMessage('Style already loaded...');
      exit;
    end;
    //
    MyStyleServicesHandle := TStyleManager.LoadFromFile('C:\Users\Public\Documents\Embarcadero\Studio\22.0\Styles\RubyGraphite.vsf');
    // ShowMessage('MyStyleServicesHandle := TStyleManager.LoadFromFile...');

    if not(MyStyleServicesHandle = nil) then
    begin
      TStyleManager.SetStyle(MyStyleServicesHandle);
      // ShowMessage('TStyleManager.SetStyle(MyStyleServicesHandle);');
    end;
    //
    ListBox1.Items.Clear;
    ListBox1.Items.AddStrings(TStyleManager.StyleNames);
  end
  else
    ShowMessage('Not OK');
end;

procedure TForm1.BntAddAllStyleOnListBoxClick(Sender: TObject);
begin
  ListBox1.Items.AddStrings(TStyleManager.StyleNames);
end;

procedure TForm1.BtnClick(Sender: TObject);
begin
  if not(MyStyleServicesHandle = nil) then
  begin
    ListBox1.Items.Clear;
    ListBox1.Items.AddStrings(TStyleManager.StyleNames);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Items.AddStrings(TStyleManager.StyleNames);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  StyleToRemove: string;
begin
  if (ListBox1.ItemIndex > -1) then
  begin
    StyleToRemove := ListBox1.Items[ListBox1.ItemIndex];
    //
    if not(StyleToRemove = TStyleManager.SystemStyleName) then
    begin
      if not(StyleToRemove = TStyleManager.ActiveStyle.Name) then
      begin
        TStyleManager.RemoveDesigningStyle(StyleToRemove);
        //
        ListBox1.DeleteSelected;
        //
        Memo1.Lines.Clear;
        Memo1.Lines.AddStrings(TStyleManager.StyleNames);
      end
      else
        ShowMessage('Style in use cannot be removed for while...');
    end
    else
      ShowMessage(Format('%s, is a SystemStyle - Cannot be removed', [StyleToRemove]));
    // TStyleManager.SetStyle(ListBox1.Items[ListBox1.ItemIndex]);
  end;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  StyleToApply: string;
begin
  if (ListBox1.ItemIndex > -1) then
  begin
    StyleToApply := ListBox1.Items[ListBox1.ItemIndex];
    //
    TStyleManager.SetStyle(StyleToApply);
  end;
end;

end.
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3

作者：

dalas (dalas)	★☆☆☆☆	-
	普通会员

2021/10/17 16:42:48

2楼：

TStyleManager.RemoveDesigningStyle 没有这个方法

此帖子包含附件:

大小:569.9K

----------------------------------------------
-

作者：

emailx45 (emailx45)	▲▲▲▲△	-
	普通会员

2021/10/18 0:43:45

3楼：

You dont say what EDITION you use!!!!

im using RAD 11 Alexandria for while!
--- Native class "TStyleManager"

It's only important say the target = Edition!

On RAD 11:
class procedure TStyleManager.RemoveDesigningStyle(const Name: string);
var
  LInfo: TSourceInfo;
begin
  if FRegisteredStyles.TryGetValue(Name, LInfo) and LInfo.DesigningState then
  begin
    if SameText(FActiveDesigningStyle.Name, Name, loUserLocale) then
      FActiveDesigningStyle := SystemStyle;
    RemoveStyleData(Name, LInfo);
  end;
end;

class procedure TStyleManager.RemoveStyleData(const AStyleName: string; AInfo: TSourceInfo);
var
  LIndex: Integer;
  LStyle: TCustomStyleServices;
begin
  LStyle := FindStyle(AStyleName, LIndex);
  if LStyle <> nil then
  begin
    LStyle.Free;
    FStyles.Delete(LIndex);
  end;
  TMemoryStream(AInfo.Data).Free;
  FRegisteredStyles.Remove(AStyleName);
end;
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3

作者：

emailx45 (emailx45)	▲▲▲▲△	-
	普通会员

2021/10/18 0:49:01

4楼：

by Stephen Ball - MVP Embarcadero

https://delphiaball.co.uk/2014/10/22/adding-vcl-styles-runtime/
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3

作者：

dalas (dalas)	★☆☆☆☆	-
	普通会员

2021/10/18 11:59:54

5楼：

哦哦，我用的还是 10.4.2，晚上用 11 试试。
谢谢！！
----------------------------------------------
-

作者：

dalas (dalas)	★☆☆☆☆	-
	普通会员

2021/10/18 19:52:24

6楼：

delphi 11 有 RemoveStyle，10和11能共存吗？
----------------------------------------------
-

作者：

emailx45 (emailx45)	▲▲▲▲△	-
	普通会员

2021/10/19 4:45:55

7楼：

RAD 11 can coexists with any other edition, as before editons!!!
--> the basic secret is the "PATH" installation!
-----> distinct FOLDERS on disk!!!
-----> distinct "PATH" environment on system!!!

my preferences:
--- I dont use "Program Files or (x86) folder as ROOT
---> c:\EMB <---- my root folder for RAD/Delphi
-----> c:\Emb\DelphiX
---------> c:\Emb\DelphiX\ComponentsSuiteX
-----> c:\Emb\RAD11
---------> c:\Emb\RAD11\ComponentsSuiteY

do you understand?
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3

信息

登陆以后才能回复