Solved

Font type in menus

Posted on 1997-04-05
14
309 Views
Last Modified: 2013-12-02
How can I change the font type in main menus !
I need to use a specific font which suports CE (Central European characters). If possible I want to do it without creating menus on my own through windows API !
0
Comment
Question by:sile
  • 8
  • 6
14 Comments
 

Author Comment

by:sile
Comment Utility
Adjusted points to 40
0
 

Author Comment

by:sile
Comment Utility
Adjusted points to 60
0
 
LVL 1

Accepted Solution

by:
sleach earned 60 total points
Comment Utility
Below is the code to a form which will use any True Type Font you like for your menu.  Its a bit complex, but you don't have to understand all the details to use it.

The forms on create event parses all the MenuItems, making them Owner Draw with ModifyMenu api function.
WMMeasureItem, and WMDrawItem are registered in the PRIVATE section of the forms object.

To specify your specific font, change the line of code in the WMDrawItem procedure to:

Canvas.Font.Name := YOUR CUSTOM FONT;

That ought to do it.  The program is below.  Just copy and paste it.  Dont forget to put a Main Menu on the form.
******************************************************************

unit CustMenu;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
  Controls, Forms, Dialogs, Menus, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure ModifySubMenu(Submenu: TMenuItem);
  private
    { Private declarations }
    procedure WMMeasureItem(VAR Msg: TWMMeasureItem);
      message WM_MEASUREITEM;
    procedure WMDrawItem(VAR Msg: TWMDrawItem);
      message WM_DRAWITEM;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
VAR N : Integer;
begin
    WITH MainMenu1 DO
    FOR N := 0 TO MainMenu1.Items.Count-1 DO
      BEGIN
          ModifyMenu(Handle, N, MF_BYPOSITION OR MF_OWNERDRAW,
            GetMenuItemID(Handle, N), Pointer(Items[N]));
      if Items[N].count > 0 then ModifySubMenu(Items[N]);
      END;
end;

procedure TForm1.WMMeasureItem(VAR Msg: TWMMeasureItem);
BEGIN
  Inherited;
  WITH Msg, MeasureItemStruct^ DO
    IF CtlType = ODT_MENU THEN
      WITH TMenuItem(Pointer(ItemData)) DO
        begin
          Canvas.Font.Name := Caption;
          Canvas.Font.Size := 10;
          ItemWidth  := Canvas.TextWidth(Caption)+8;
          ItemHeight := Canvas.TextHeight(Caption)+4;
          Result := 1;
        end;
END;

procedure TForm1.WMDrawItem(VAR Msg: TWMDrawItem);
BEGIN
  Inherited;
  WITH Msg, DrawItemStruct^ DO
    IF CtlType = ODT_MENU THEN
      WITH TMenuItem(Pointer(ItemData)) DO
        begin
          Canvas.Handle := hDC;
          IF (ODA_Select AND ItemAction <> 0) AND
             (ODS_Selected AND ItemState <> 0) THEN
            BEGIN
              Canvas.Brush.Color := clHighlight;
              Canvas.Font.Color  := clHighlightText;
            END
          ELSE
            BEGIN
              Canvas.Brush.Color := clMenu;
              Canvas.Font.Color  := clMenuText;
            END;

{replace "Screen.Fonts[3]" with the name of the TrueType font you
want to display in your menu.  NOTE:  MUST be a True Type Font!}
          Canvas.Font.Name := Screen.Fonts[3];{XXXXX change this Line! XXXX}

          Canvas.Font.Size := 10;
          rcItem.Right := rcItem.Right-3;
          Canvas.TextRect(rcItem, rcItem.Left+4, rcItem.Top,
            Caption);
          Canvas.Handle := 0;
          Result := 1;
        end;
END;

procedure TForm1.ModifySubMenu(Submenu: TMenuItem);
var N:  integer;
begin
    WITH Submenu DO
    FOR N := 0 TO Count-1 DO
      BEGIN
          ModifyMenu(Handle, N, MF_BYPOSITION OR MF_OWNERDRAW,
            GetMenuItemID(Handle, N), Pointer(Items[N]));
          if Items[N].count > 0 then ModifySubMenu(Items[N]);

      END;

end;

0
 

Author Comment

by:sile
Comment Utility
Thanks for answering. I wonder if you could just help me with some of the problems I have been experiencing with this solution.
1. I can't use Hot Keys (when I want the letter F to be underlined for example in File I get &File in a menu instead)
2. I can't use separator lines in menus (I get '-' instead)
3. I get a few more characters of space in a menu)

       Thanx
0
 
LVL 1

Expert Comment

by:sleach
Comment Utility
You are quite correct.  Hot keys, and menu separators won't display as they should.  I didn't test this.  I have revised the ModifySubMenu procedure to enable menu line seperators to work properly.  However, the problem with shortcuts seems to elude me.  We could draw them correctly in the WMDrawItem procedure, but that is pointless because the shortcuts are not responding anyway.  This may be a side effect of the ModifyMenu function.  Further research into this function may provide an answer.  I have included the revised ModifySubMenu procedure below:


procedure TForm1.ModifySubMenu(Submenu: TMenuItem);
var N:  integer;
begin
    WITH Submenu DO
    FOR N := 0 TO Count-1 DO
      if Items[N].caption  <> '-' then
          begin
          ModifyMenu(Handle, N, MF_BYPOSITION OR MF_OWNERDRAW,
            GetMenuItemID(Handle, N), Pointer(Items[N]));
          if Items[N].count > 0 then ModifySubMenu(Items[N]);
          end;
end;

0
 

Author Comment

by:sile
Comment Utility
Now I have implemented your solution but I still have a few problems *hotkeys* that aren't displayed and with disabled menus (when I disable a menu it still shows up on the main menu.
Now I wonder if there is a way for me to detect when a menu item is disabled and remove it form a menu or change the font.

          Thanx
0
 
LVL 1

Expert Comment

by:sleach
Comment Utility
>Now I wonder if there is a way for me to detect when a menu >item is disabled and remove it form a menu or change the font.

Below is a revised WMDrawItem procedure that will display disabled menu items as "Gray".  As to the HotKeys problem, the problem is not in displaying them correctly.  The problem is that the hotkeys are NOT RESPONDING when pressed.  The WMDrawItem procedure could be revised to display the hotkeys correctly, but that is pointless until we can get them to work.

procedure TForm1.WMDrawItem(VAR Msg: TWMDrawItem);
var
  capText:  string;
BEGIN
  Inherited;
  WITH Msg, DrawItemStruct^ DO
    IF CtlType = ODT_MENU THEN
      WITH TMenuItem(Pointer(ItemData)) DO
        begin
          Canvas.Handle := hDC;
          IF (ODA_Select AND ItemAction <> 0) AND
             (ODS_Selected AND ItemState <> 0) THEN
            BEGIN
              Canvas.Brush.Color := clHighlight;
              Canvas.Font.Color  := clHighlightText;
            END
          ELSE
            BEGIN
              Canvas.Brush.Color :=  clMenu;
              if enabled = true then
                 Canvas.Font.Color  := clMenuText
              else
                 Canvas.Font.Color  := clGray;
            END;

{replace "Screen.Fonts[3]" with the name of the TrueType font you
want to display in your menu.  NOTE:  MUST be a True Type Font!}
          Canvas.Font.Name := Screen.Fonts[3];{XXXXX change this Line! XXXX}

          Canvas.Font.Size := 10;
          rcItem.Right := rcItem.Right-3;
          capText := caption;
          //if pchar(capText)[0] = '&' then capText := copy(capText, 2, length(capText));
          Canvas.TextRect(rcItem, rcItem.Left+4, rcItem.Top,
            CapText);
          Canvas.Handle := 0;
          Result := 1;
        end;
END;
0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:sile
Comment Utility
Hello
Now I have implemented the modified procedure and it works.
However I still haven't succeded in using hotkeys from menus.
Still I have noticed that SHORTCUT KEYS do work (CTRL+ ?).
But they do not display. Now do you have any ideas about displaying them ?
I have tested your menu solution on multiple resolution and the resize of the menus works fine.

         Thanx
0
 

Author Comment

by:sile
Comment Utility
Hello can you comment on the above ? I hope you will respond.
0
 
LVL 1

Expert Comment

by:sleach
Comment Utility
Your right, Shortcut Keys do work.  I was confusing them with Hot Keys(which don't work).  I have once again revised WMMeasureItem, and WMDrawItem.  They will now display Shortcut Keys.  However, the spaceing will not right align them.  This is just a matter of programming, and I will let you do that work.  Study the code, and you'll figure it out.  Hope this helps.

procedure TForm1.WMMeasureItem(VAR Msg: TWMMeasureItem);
var
   captext:  string;
BEGIN
  Inherited;
  WITH Msg, MeasureItemStruct^ DO
    IF CtlType = ODT_MENU THEN
      WITH TMenuItem(Pointer(ItemData)) DO
        begin
          //CapText is the string that will be displayed in the menu
          capText := caption+' '+ShortCutToText(ShortCut);          //Duplicat Font name bleow!!!
          Canvas.Font.Name := Screen.Fonts[3];
          Canvas.Font.Size := 10;
          ItemWidth  := Canvas.TextWidth(capText)-8{8};
          ItemHeight := Canvas.TextHeight(capText)+4;
          Result := 1;
        end;
END;

procedure TForm1.WMDrawItem(VAR Msg: TWMDrawItem);
var
  capText:  string;
BEGIN
  Inherited;
  WITH Msg, DrawItemStruct^ DO
    IF CtlType = ODT_MENU THEN
      WITH TMenuItem(Pointer(ItemData)) DO
        begin
          Canvas.Handle := hDC;
          IF (ODA_Select AND ItemAction <> 0) AND
             (ODS_Selected AND ItemState <> 0) THEN
            BEGIN
              Canvas.Brush.Color := clHighlight;
              Canvas.Font.Color  := clHighlightText;
            END
          ELSE
            BEGIN
              Canvas.Brush.Color :=  clMenu;
              if enabled = true then
                 Canvas.Font.Color  := clMenuText
              else
                 Canvas.Font.Color  := clGray;
            END;

{replace "Screen.Fonts[3]" with the name of the TrueType font you
want to display in your menu.  NOTE:  MUST be a True Type Font!}
          Canvas.Font.Name := Screen.Fonts[3];{XXXXX change this Line! XXXX}

          Canvas.Font.Size := 10;
          rcItem.Right := rcItem.Right-3;
          //CapText is the string that will be displayed in the menu
          capText := caption+' '+ShortCutToText(ShortCut);
          Canvas.TextRect(rcItem, rcItem.Left+4, rcItem.Top,
            CapText);
          Canvas.Handle := 0;
          Result := 1;
        end;
END;

0
 
LVL 1

Expert Comment

by:sleach
Comment Utility
P.S. if you know the name(if there is one) of the transparant color defined for the color palet, I can make they grayed out menu items look like they should.  I just cant find the color for transparant.
0
 

Author Comment

by:sile
Comment Utility
I'm not sure what do you mean by transparent color, could you explain it a bit more...

I have implemented the short cut keys and the code works, still I can't get it to align to the right (could you help me).

Another problem I have run into is the disabled menus which are still active and clickable , they are just displayed in a different colour --- I'would like if they could be completely disabled or simply not displayed.

       Thanx
0
 

Author Comment

by:sile
Comment Utility
So far I came up with this modification for not displaying the disabled menus.

procedure Tglavna_forma.WMMeasureItem(VAR Msg: TWMMeasureItem);
var capText: string;
BEGIN
 Inherited;
 WITH Msg,MeasureItemStruct^ DO
 IF CtlType = ODT_MENU THEN
    WITH TMenuItem(Pointer(ItemData)) DO
         begin
         //CapText is the string that will be displayed in the menu
         capText := caption + ' ' + ShortCutToText(ShortCut);
         Canvas.Font.Name := 'Arial CE';
         Canvas.Font.Size := Sheet_Slikarazreda.Font.Size-2;
         {sirina je povecena za 10}
         ItemWidth := Canvas.TextWidth(capText)+ 10;
         {visina je povecena za 5}
         if enabled = true then ItemHeight := Canvas.TextHeight(capText)+ 5 else
         ItemHeight:= 0;
         Result := 1;
         end;
END;

Now if there is a better way to do this please let me know.

I'm still not able to align the shortcuts to right if you could please help me with that .

           Thanx
0
 
LVL 1

Expert Comment

by:sleach
Comment Utility
MenuItem.enabled := false;

I cannot understand why the above line of code would still allow you to click the menu item.  It is not clickable on my computer.  All the routines WM measure/draw item do are display.  they don't effect the behavior of the menuitems(much) ;)

As to the transparent color, I need to know the color Transparent in order to make the 3D grayed look.

1)  draw text in white with button gray background.
2)  ofset text by -1 pixel horazontal & vertical.
3) redraw text in Medium gray with transparent background.

this gives the 3d effect of the grayed out menu item.
I just don't know the color code for transparent.

Remember, any changes you make to either function, must also be made in the other.

PS  You might try:
MenuItem.Visible := false;
Instead of MenuItem.enabled := false.  

That will make it invisible & unclickable.
Just a thought.
 
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
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…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

771 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now