Criando MENU em tempo de execução com VCL Theme aplicado = Erro
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
Curtidas 0