[Webinar] Streamline your web hosting managementRegister Today

x
?
Solved

Menu item font

Posted on 2000-02-06
4
Medium Priority
?
399 Views
Last Modified: 2013-12-02
Hi!
How can I change the font style of individual menu item (of TMainMenu or TPopUpMenu)?
0
Comment
Question by:apatit
  • 4
4 Comments
 
LVL 17

Accepted Solution

by:
inthe earned 150 total points
ID: 2494637
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
 
LVL 17

Expert Comment

by:inthe
ID: 2494768
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
 
LVL 17

Expert Comment

by:inthe
ID: 2494774
or email me at
legend@enterprise.net
and i'll reply with them 2 you.
0
 
LVL 17

Expert Comment

by:inthe
ID: 2506246
Hello
do you accept the answer for the question from the stuff i send?

0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…
Suggested Courses
Course of the Month10 days, 20 hours left to enroll

612 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question