Fórum Fonte do MainMenu #336072

A forma de fazer isso é fazendo a propriedade OwnerDraw do menu ser True e você se encarregar do desenho de cada item do menu. Tem este artigo (em ingles, mas com exemplos)...

[url=http://delphi.about.com/od/vclusing/a/owner_drawing.htm]Understanding Owner Drawing in Delphi[/url]

...que mostra como fazer isso com um TPopupMenu, mas não é muito diferente do seu caso.

Que site legal.
Obrigado pela dica MUSSUDA.
Abraços
Neto

Olá a todos.
Estou criando um Menu Dinamicamente, só existe uma procedure criada para ( OnDrawItem ); preciso que todos os itens do menu executem esta mesma procedure quando forem criados.

// --- Criando o novo item no menu
FrPrincipal.MenuPrincipal.Items.Add(NewItem);

// --- executar OnDrawItem
FrPrincipal.MenuPrincipal.Items.OnDrawItem.......

// ---
procedure TFrPrincipal.MnCadastroDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin

ARect.Left := 120;
ACanvas.FillRect(ARect);

ACanvas.Font.Name := ´Courier New´;
ACanvas.Font.Style := [fsItalic];

end;


Abraços a todos
Neto

:?: Oi gente.
Como posso fazer para forçar a execução da procedure citada.
Abraços
Neto

Você está falando do OnDrawItem? A procedure não é executada por você, é executada pelo Delphi quando o menu é desenhado (não esqueça de deixar o OwnerDraw do menu em True).

Oi Mussuda, ainda não desisti....
Por favor como posso saber dentro da procedure OnDrawItem, qual o Item que esta sendo desenhado (escrito)
Quero saber se é o item (cabeçalho) ou algum item.item[x].. que está sendo escrito..
Obrigado
Neto

O Sender do OnDrawItem é o TMenuItem que gerou o evento, ou seja, que está sendo desenhado......lembrando que você precisa definir o OnDrawItem de cada TMenuItem do seu menu.

Olá a todos.
Abaixo coloco parte do código onde crio um menu dinamico.
Meu problema esta em escrever(desenhar) as opções com font diferente.


// ---
//
// -----
procedure TFrPrincipal.MontarMenuPrincipal;
var
NewItem: TMenuItem;
I, K, C, PTag: integer;
Menu, SubMenu : integer;
PTitulo, PNome, PStatus : String;

begin
// --- abrir a tabela de opções do menu ordenada por grupo / grau
DtmSys.CliDtStMenu.Close;
M_Aux := ´Select * From Menus Where Mnu_MenuOk = :Ok ´;
M_Aux := M_Aux + ´Order By Mnu_MenuGrau , Mnu_MenuSequencia ´;
DtmSys.SqlDtStMenu.CommandText := M_Aux;
DtmSys.SqlDtStMenu.ParamByName(´Ok´).AsString := ´1´;
DtmSys.CliDtStMenu.Open;

DtmSys.CliDtStMenu.First;
MenuPrincipal.Items.Clear;

// --- ler a tabela até o final, posicionando no primeiro grau do menu
while not CliDtStMenu.Eof do
begin
Menu := CliDtStMenu.FieldByName(´Mnu_MenuGrau´).AsInteger;
PTitulo := CliDtStMenu.FieldByName(´Mnu_MenuTexto´).AsString;
PTag := CliDtStMenu.FieldByName(´Mnu_Tag´).AsInteger;
PNome := CliDtStMenu.FieldByName(´Mnu_MenuNomePrg´).AsString;
PStatus := CliDtStMenu.FieldByName(´Mnu_MenuAtivo´).AsString;

AddNovoMenu(MenuPrincipal.Items, PTitulo, CapturaClick, PTag, PNome, PStatus );

CliDtStMenu.Next;
SubMenu := Menu;
// --- enquanto for o mesmo grau cria os sub-menus da opção
while (SubMenu = CliDtStMenu.FieldByName(´Mnu_MenuGrau´).AsInteger) and not CliDtStMenu.Eof do
begin
PTitulo := CliDtStMenu.FieldByName(´Mnu_MenuTexto´).AsString;
PTag := CliDtStMenu.FieldByName(´Mnu_Tag´).AsInteger;
PNome := CliDtStMenu.FieldByName(´Mnu_MenuNome´).AsString;
PStatus := CliDtStMenu.FieldByName(´Mnu_MenuAtivo´).AsString;
AddNovoMenu(MenuPrincipal.Items.Items[SubMenu-1], PTitulo, CapturaClick, PTag, PNome, PStatus );
DtmSys.CliDtStMenu.Next;
end;
end;
end;


// ---
//
// ------
procedure TFrPrincipal.AddNovoMenu(AParent : TMenuItem; ACaption : String;
AOnClick : TNotifyEvent; ATag : Integer;
ANomePrg : String; AStatus : String);
var
MItens: TMenuItem;
begin
try
MItens := TMenuItem.Create(AParent);
MItens.Caption := ACaption;
MItens.OnClick := AOnClick;
MItens.Tag := ATag;
MItens.Name := ANomePrg;

If AStatus = ´1´ then
MItens.Enabled := true
else
MItens.Enabled := false;

***** Como passar por parametro o evento ONDRAWITEM
***** Neste ponto preciso desenhar o item do menu.....

*** Chamando a procedure ColocarFonte ??????

AParent.Add(MItens);
except
MItens.Free;
raise; { reraise the exception }
end;

end;

procedure TFrPrincipal.ColocarFonte(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean, APArent: TMenuItem);
var
tx : String;

begin

ARect.Left := 60;
ACanvas.FillRect(ARect);

ACanvas.Font.Name := ´Courier New´;
ACanvas.Font.Size := 12;

tx := Trim((Sender as TMenuItem).Caption);

DrawText(ACanvas.Handle, PChar( tx ), -1, ARect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);

end;


procedure TFrPrincipal.CapturaClick(Sender: TObject);
begin

// tudo ok. aqui..

end;

Bem amigos meu problema é passar por parametro o evento ONDRAWITEM.

Abraços
Neto

Ok. pessoal resolvido, abaixo parte do código com a solução..
====
procedure TFrPrincipal.AddNovoMenu(AParent : TMenuItem; ACaption : String;AOnClick : TNotifyEvent; ATag : Integer; ANomePrg : String; AStatus : String; AFonte : Boolean);
var
MItens: TMenuItem;
begin
try
MItens := TMenuItem.Create(AParent);
MItens.Caption := ACaption;
MItens.OnClick := AOnClick;
MItens.Tag := ATag;
MItens.Name := ANomePrg;

If AStatus = ´1´ then
MItens.Enabled := true
else
MItens.Enabled := false;

AParent.Add(MItens);

** ==> aqui está a chamada para o método
If AFonte = true then
MItens.OnDrawItem := ColocarFonte;

except
MItens.Free;
raise; { reraise the exception }
end;
end;

Abraços a todos em especial ao Mussuda...
Neto

Existe uma forma fácil de mudar a cor e estilo do MainMenu?