Fórum Criando MENU em tempo de execução com VCL Theme aplicado = Erro #614120
15/02/2021
0
Boa noite galera.
Quando criado menu em tempo de execução e em seguida aplicando um tema da VCL, os menos estão ficando desconfigurados.
1 - Imagem com menu em tempo de execução sem TEMA ATIVO = OK.
https://uploaddeimagens.com.br/imagens/tNXtYTY
2 - Imagem com menu em tempo de execução com TEMA ATIVO = ERRO.
https://uploaddeimagens.com.br/imagens/3d5kcRA
Seguem código de é gerado o carregamento dos dados:
E esse DataModule:
O que pode estar causando isso ?
Quando criado menu em tempo de execução e em seguida aplicando um tema da VCL, os menos estão ficando desconfigurados.
1 - Imagem com menu em tempo de execução sem TEMA ATIVO = OK.
https://uploaddeimagens.com.br/imagens/tNXtYTY
2 - Imagem com menu em tempo de execução com TEMA ATIVO = ERRO.
https://uploaddeimagens.com.br/imagens/3d5kcRA
Seguem código de é gerado o carregamento dos dados:
unit UFormPrincipal;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Actions,
Vcl.ActnList, Vcl.Menus, System.ImageList, Vcl.ImgList, cxImageList,
cxGraphics, UdmLista, Vcl.ComCtrls, Vcl.ToolWin;
type
TFormPrincipal = class(TForm)
btnAplicar: TButton;
btnCarregarTema: TButton;
btnCriarMenus: TButton;
pgnModulos: TPageControl;
ToolBarOne: TToolBar;
procedure btnAplicarClick(Sender: TObject);
procedure btnCarregarTemaClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnCriarMenusClick(Sender: TObject);
private
{ Private declarations }
FModuloLista: TdmLista;
public
{ Public declarations }
end;
var
FormPrincipal: TFormPrincipal;
implementation
Uses
Vcl.Styles,
Vcl.Themes;
{$R *.dfm}
procedure TFormPrincipal.btnAplicarClick(Sender: TObject);
begin
if btnAplicar.Caption = 'Aplicar CARBON' then begin
btnAplicar.Caption := 'Aplicar WINDOWS';
TStyleManager.TrySetStyle('Carbon');
end else begin
btnAplicar.Caption := 'Aplicar CARBON';
TStyleManager.TrySetStyle('Windows');
end;
end;
procedure TFormPrincipal.btnCarregarTemaClick(Sender: TObject);
begin
TStyleManager.LoadFromFile('C:\Users\Jozimar\Desktop\TST\Tema\Carbon.vsf');
end;
procedure TFormPrincipal.btnCriarMenusClick(Sender: TObject);
var
lMenu: TMainMenu;
lItem: TMenuItem;
lIndex: iNTEGER;
TabSheet: TTabSheet;
begin
TabSheet := TTabSheet.Create(pgnModulos);
TabSheet.PageControl := pgnModulos;
TabSheet.Caption := ' - Menu - ';
ToolBarOne.Parent := TabSheet;
lMenu := TMainMenu.Create(ToolBarOne);
lMenu.Images := FModuloLista.ImageList1;
lItem := TMenuItem.Create(lMenu);
lItem.Caption := ' -- SubMenu -- ';
lMenu.Items.Add(lItem);
for lIndex := 0 to FModuloLista.ActionList1.ActionCount-1 do begin
lItem := TMenuItem.Create(lMenu);
lItem.Action := FModuloLista.ActionList1[lIndex];
lMenu.Items[0].Add(lItem);
end;
ToolBarOne.Menu := lMenu;
end;
procedure TFormPrincipal.FormCreate(Sender: TObject);
begin
FModuloLista := TdmLista.Create(Self);
end;
end.
E esse DataModule:
unit UdmLista;
interface
uses
System.SysUtils, System.Classes, System.ImageList, Vcl.ImgList, Vcl.Controls,
cxImageList, cxGraphics, System.Actions, Vcl.ActnList, Vcl.Menus;
type
TdmLista = class(TDataModule)
ActionList1: TActionList;
Action1: TAction;
Action2: TAction;
Action3: TAction;
Action4: TAction;
ImageList1: TImageList;
MainMenuOne: TMainMenu;
Novidades1: TMenuItem;
Action11: TMenuItem;
Action21: TMenuItem;
Action31: TMenuItem;
Action41: TMenuItem;
procedure Action1Execute(Sender: TObject);
procedure Action2Execute(Sender: TObject);
procedure Action3Execute(Sender: TObject);
procedure Action4Execute(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
dmLista: TdmLista;
implementation
Uses
Vcl.Dialogs;
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TdmLista.Action1Execute(Sender: TObject);
begin
ShowMessage('1111');
end;
procedure TdmLista.Action2Execute(Sender: TObject);
begin
ShowMessage('2222');
end;
procedure TdmLista.Action3Execute(Sender: TObject);
begin
ShowMessage('3333');
end;
procedure TdmLista.Action4Execute(Sender: TObject);
begin
ShowMessage('4444');
end;
end.
O que pode estar causando isso ?
Jozimar
Curtir tópico
+ 0
Responder
Clique aqui para fazer login e interagir na Comunidade :)