Menu item font

Hi!
How can I change the font style of individual menu item (of TMainMenu or TPopUpMenu)?
apatitAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

intheCommented:
HI,
you need to ownderdraw it here is old example of what i mean:

Here is how it's done in Delphi v1.0 (Code snipped from a how to book called "Borland Delphi How-To" from the Waite Group"  (great action packed adventure)
 
Owner Drawn Menus:
 
unit Odmenu1;
 
interface
 
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,   Forms, Dialogs, Menus, StdCtrls;
 
type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Test1: TMenuItem;
    Font1: TMenuItem;
    FontDialog1: TFontDialog;
    DisableFont1: TMenuItem;
    EnableFont1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Font1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure EnableFont1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure DisableFont1Click(Sender: TObject);
  private
    { Private declarations }
    BM: TBitmap;
    MenuCap: array [0..255] of char;
    procedure WMMeasureItem(var MInfo: TMessage); message wm_MeasureItem;     procedure WMDrawItem(var DInfo: TMessage); message wm_DrawItem;   public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  {Create a work area}
  BM := TBitmap.Create;
  {Initialize current font to standard menu text color}
  FontDialog1.Font.Color := GetSysColor(color_MenuText);
  {Tell Windows this menu item is Owner-Draw}
  ModifyMenu(MainMenu1.Handle, Font1.Command,
    mf_ByCommand or mf_OwnerDraw, Font1.Command, nil);
  {Make a copy of menu caption now to save time}
  StrPCopy(MenuCap, Font1.Caption);
  {Does menu item have a shortcut assigned?}
  if Font1.ShortCut <> 0 then
    StrPCopy(StrEnd(MenuCap), #9 + ShortCutToText(Font1.ShortCut)); end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  {Dispose work area}
  BM.Free;
end;
 
procedure TForm1.WMMeasureItem(var MInfo: TMessage);
var
  MIS: TMeasureItemStruct;
const
  zero: integer = 0;
begin
  {Address the Windows supplied info}
  with PMeasureItemStruct(MInfo.lParam)^ do begin
    {Is message for a menu item}
    if CtlType = odt_Menu then begin
      {Is message for Font menu item}
      if ItemID = Font1.Command then begin
        {Assign currently selected font to work space}
        BM.Canvas.Font := FontDialog1.Font;
        {Calculate needed height for current font}
        ItemHeight := BM.Canvas.TextHeight(Font1.Caption);
        {Calculate needed width for caption in current font}
        ItemWidth := LoWord(GetTabbedTextExtent(BM.Canvas.Handle, MenuCap,           StrLen(MenuCap), zero, zero));
        {Tell Windows it's handled}
        MInfo.Result := 1;
      end;
    end;
  end;
end;
 
procedure TForm1.WMDrawItem(var DInfo: TMessage);
var
  oldFont: hFont;
begin
  {Address Windows supplied info}
  with PDrawItemStruct(DInfo.lParam)^ do begin
    {Is message for a menu item?}
    if CtlType = odt_Menu then begin
      {Is message for Font menu item?}
      if ItemID = Font1.Command then begin
        {Select current font into menu's device context}
        oldFont := SelectObject(hDC, FontDialog1.Font.Handle);
        {Set correct background color}
        if (ItemState and ods_Selected) <> 0 then
          BM.Canvas.Brush.Color := clHighlight
        else
          BM.Canvas.Brush.Color := clMenu;
        {Paint the background}
        FillRect(hDC, rcItem, BM.Canvas.Brush.Handle);
        {Adjust left bound of caption}
        Inc(rcItem.Left, LoWord(GetMenuCheckMarkDimensions));
        {Set text color according to state}
        if (ItemState and ods_disabled <> 0)
        or (ItemState and ods_Grayed <> 0) then
          {Use system's 'grayed' color}
          SetTextColor(hDC, GetSysColor(color_GrayText))
        else if (ItemState and ods_Selected <>0) then
          {Use reverse of current font color}
          SetTextColor(hDC, not FontDialog1.Font.Color)
        else
          {Use selected font color}
          SetTextColor(hDC, FontDialog1.Font.Color);
        {Allow background color to surround characters}
        SetBkMode(hDC, Transparent);
        {Draw the menu's caption}
        DrawText(hDC, MenuCap, StrLen(MenuCap), rcItem,
          dt_Top or dt_SingleLine or dt_ExpandTabs);
        {Release current font handle}
        SelectObject(hDC, oldFont);
        {Tell Windows it's handled}
        DInfo.Result := 1;
      end;
    end;
  end;
end;
 
procedure TForm1.EnableFont1Click(Sender: TObject);
begin
  {Tell Windows this menu item is selectable again}
  ModifyMenu(MainMenu1.Handle, Font1.Command,
    mf_ByCommand or mf_Enabled or mf_OwnerDraw, Font1.Command, nil); end;
 
procedure TForm1.DisableFont1Click(Sender: TObject);
begin
  {Tell Windows this menu item not selectable}
  ModifyMenu(MainMenu1.Handle, Font1.Command,
    mf_ByCommand or mf_Grayed or mf_OwnerDraw, Font1.Command, nil); end;
 
procedure TForm1.Font1Click(Sender: TObject);
begin
  if FontDialog1.Execute then
  {Fool Windows into sending another wm_MeasureItem message
  so menu item can be sized for newly selected font.}
    ModifyMenu(MainMenu1.Handle, Font1.Command,
      mf_ByCommand or mf_OwnerDraw, Font1.Command, nil);
end;
 
procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;
 
end.


Regards Barry
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
intheCommented:
hi,
i must tell you that example is no good i would not try to build it.
but i have found about 12 really good example projects of this and various menu stuff.
leave your email address and i send them 2 you.
shows how to change fonts/colors/ add bitmaps etc ..

cheers Barry
0
intheCommented:
or email me at
legend@enterprise.net
and i'll reply with them 2 you.
0
intheCommented:
Hello
do you accept the answer for the question from the stuff i send?

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Fonts Typography

From novice to tech pro — start learning today.