unit Unit14;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.Menus,
Vcl.Themes, System.Generics.Collections;
type
TForm14 =
class(TForm)
MainMenu1: TMainMenu;
mnuStyles: TMenuItem;
procedure FormCreate(Sender: TObject);
strict private
FMenuItem: TMenuItem;
private
procedure NativeStyleClick(Sender: TObject);
public
procedure AddNativeStyle(
const AMenuItem: TMenuItem);
end;
var
Form14: TForm14;
implementation
{$R *.dfm}
procedure TForm14.AddNativeStyle(
const AMenuItem: TMenuItem);
procedure AddMenuEntry(
const ACaption:
string;
const AValue: Integer);
var
Item: TMenuItem;
begin
Item := TMenuItem.Create(FMenuItem);
Item.Caption := ACaption;
Item.OnClick := NativeStyleClick;
Item.RadioItem := True;
Item.AutoCheck := True;
Item.GroupIndex := 1;
Item.Checked := TStyleManager.ActiveStyle.
Name = ACaption;
if ((AValue)
mod 10) = 0
then
Item.Break := mbBarBreak;
FMenuItem.Add(Item);
end;
var
Arr: TArray<
string>;
SystemStyle:
string;
FoundStyle:
String;
i: Integer;
begin
FMenuItem := AMenuItem;
FMenuItem.Clear;
FMenuItem.AutoLineReduction := maAutomatic;
arr := TStyleManager.StyleNames;
TArray.Sort<
string>(arr);
SystemStyle := TStyleManager.SystemStyle.
Name;
AddMenuEntry(SystemStyle, 0);
i := 1;
for FoundStyle
in arr
do
begin
if FoundStyle <> SystemStyle
then
begin
AddMenuEntry(FoundStyle, i);
Inc(i);
end;
end;
end;
procedure TForm14.NativeStyleClick(Sender: TObject);
var
StyleName:
String;
begin
StyleName := StripHotkey(TMenuItem(Sender).Caption);
TStyleManager.SetStyle(StyleName);
end;
procedure TForm14.FormCreate(Sender: TObject);
begin
AddNativeStyle(mnuStyles);
end;
end.