Results 1 to 6 of 6

Thread: [RESOLVED] System Menu Fonts

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Sep 2005
    Location
    Modesto, Ca.
    Posts
    5,513

    Resolved [RESOLVED] System Menu Fonts

    I searched this forum for information on modifing system menu fonts for my vb6 app. I found references to "CoolMenu" and "Icon Menus" from vbAccelerator but I had problems with these choices.

    CoolMenu would crash my VB6 IDE everytime I closed the my app.
    Icon Menus wouldn't load because there was a missing "vbaIml6.ocx" file.

    I found a thread on how to retrieve the system menu font using an API but it didn't reference how to set the font.

    I would like to,
    Save the system menu font when my app starts
    Set the menu font when my app starts
    Set the font back to the original setting when my app close.
    I would like to keep the overhead of doing this to a minimum. I don't plan on using icons on my menus.

    Could anyone provide any information on this subject?
    Thanks

  2. #2
    Discovering Life Siddharth Rout's Avatar
    Join Date
    Feb 2005
    Location
    Mumbai, India
    Posts
    12,001

    Re: System Menu Fonts

    I found this on the web. As per the author, it is a very simple code to change the system ' NONCLIENTMETRICS like the the window title font, ' the message font,menu font using VB. You can also change ' other elements like status font etc ' in your window only or all the open windows ' like PLUS! or display settings (appearance) ' also it is possible to underline, strikethru fonts in ' your window with this code. This code is very useful ' if you are coding a multi-lingual software.

    Hope this is what you want....

    Code:
    <!--StartFragment-->'**************************************
    'Windows API/Global Declarations for :Ch
    '	 ange System (Message, Menu, Caption) Fon
    '	 ts
    '**************************************
     
     
    Private Type LOGFONT
    	lfHeight As Long
    	lfWidth As Long
    	lfEscapement As Long
    	lfOrientation As Long
    	lfWeight As Long
    	lfItalic As Byte
    	lfUnderline As Byte
    	lfStrikeOut As Byte
    	lfCharSet As Byte
    	lfOutPrecision As Byte
    	lfClipPrecision As Byte
    	lfQuality As Byte
    	lfPitchAndFamily As Byte
    	lfFaceName(1 To 32) As Byte
    	End Type
     
     
    Private Type NONCLIENTMETRICS
    	cbSize As Long
    	iBorderWidth As Long
    	iScrollWidth As Long
    	iScrollHeight As Long
    	iCaptionWidth As Long
    	iCaptionHeight As Long
    	lfCaptionFont As LOGFONT
    	iSMCaptionWidth As Long
    	iSMCaptionHeight As Long
    	lfSMCaptionFont As LOGFONT
    	iMenuWidth As Long
    	iMenuHeight As Long
    	lfMenuFont As LOGFONT
    	lfStatusFont As LOGFONT
    	lfMessageFont As LOGFONT
    	End Type
     
     
    Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As NONCLIENTMETRICS, ByVal fuWinIni As Long) As Long
    '**************************************
     
    ' Inputs:ADD A COMBO BOX
    '
    ' Returns:Changes the Message box font a
    '	 nd Windows Caption Font (Title Font).
    '
    'Assumes:Add a Combo box.
    '
    '**************************************
     
     
     
    Private Sub Combo1_Click()
    	Dim ncm As NONCLIENTMETRICS 'NONCLIENTMETRICS to change
    	Dim Orincm As NONCLIENTMETRICS 'NONCLIENTMETRICS to replace original
    	Dim Returned As Long
    	Dim i As Integer
    	ncm.cbSize = Len(ncm)
    	Returned = SystemParametersInfo(41, 0, ncm, 0) 'get the system NONCLIENTMETRICS
    	Orincm = ncm 'store the value of system NONCLIENTMETRICS to use later
    	'now to change the font name
    	'other functions can be used to change t
    	'	 he font name
    	'but for simplicity i have used asc() & 
    	'	 mid()
     
     
    	For i = 1 To Len(Combo1.Text) 'use ncm.lfMenuFont.lfFacename(i) to change menu font
    		ncm.lfMessageFont.lfFaceName(i) = Asc(Mid(Combo1.Text, i, 1))
    		ncm.lfCaptionFont.lfFaceName(i) = Asc(Mid(Combo1.Text, i, 1))
    	Next i
    	ncm.lfMessageFont.lfFaceName(i) = 0 'add null at the end of font name
    	ncm.lfCaptionFont.lfFaceName(i) = 0
    	Returned = SystemParametersInfo(42, 0, ncm, &H1 Or &H2) 'remove &H2 if you don't want to affect all the open windows
    	MsgBox "Message & Caption Font Changed to " & Combo1.Text, vbOKOnly, "NILESH"
    	Returned = SystemParametersInfo(42, 0, Orincm, &H1 Or &H2) 'replace original font
    	MsgBox "Message & Caption Font Replaced to " & StrConv(Orincm.lfCaptionFont.lfFaceName, vbUnicode), vbOKOnly, "NILESH"
    End Sub
     
     
    Private Sub Form_Load()
    	' Heres a very simple code to change the
    	'	 system
    	' NONCLIENTMETRICS like the the window t
    	'	 itle font,
    	' the message font,menu font using VB. Y
    	'	 ou can also change
    	' other elements like status font etc
    	' in your window only or all the open wi
    	'	 ndows
    	' like PLUS! or display settings (appear
    	'	 ance)
    	' also it is possible to underline, stri
    	'	 kethru fonts in
    	' your window with this code. This code 
    	'	 is very useful
    	' if you are coding a multi-lingual soft
    	'	 ware.
    	' For more info and more free code send 
    	'	 e-mail.
    	' code by - NILESH P KURHADE
    	' email - [email protected]
    	Dim i As Integer
    	Show
    	' to flood the combo box with first 10 f
    	'	 onts
     
     
    	For i = 1 To 10 ' or use For i = 1 To Screen.FontCount to flood all the fonts in your pc
    		Combo1.AddItem Screen.Fonts(i)
    	Next i
    End Sub
    A good exercise for the Heart is to bend down and help another up...
    Please Mark your Thread "Resolved", if the query is solved


    MyGear:
    ★ CPU ★ Ryzen 5 5800X
    ★ GPU ★ NVIDIA GeForce RTX 3080 TI Founder Edition
    ★ RAM ★ G. Skill Trident Z RGB 32GB 3600MHz
    ★ MB ★ ASUS TUF GAMING X570 (WI-FI) ATX Gaming
    ★ Storage ★ SSD SB-ROCKET-1TB + SEAGATE 2TB Barracuda IHD
    ★ Cooling ★ NOCTUA NH-D15 CHROMAX BLACK 140mm + 10 of Noctua NF-F12 PWM
    ★ PSU ★ ANTEC HCG-1000-EXTREME 1000 Watt 80 Plus Gold Fully Modular PSU
    ★ Case ★ LIAN LI PC-O11 DYNAMIC XL ROG (BLACK) (G99.O11DXL-X)
    ★ Monitor ★ LG Ultragear 27" 240Hz Gaming Monitor
    ★ Keyboard ★ TVS Electronics Gold Keyboard
    ★ Mouse ★ Logitech G502 Hero

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Sep 2005
    Location
    Modesto, Ca.
    Posts
    5,513

    Re: System Menu Fonts

    Koolsid,

    thanks for the code, it works great. Is there a way to modify the font size? I didn't see how to do it.

    Do you know if its possible to change the menu font size without changing the system settings? I was playing with your code and it crashed, I had to manually reset my system setting. I don't think my clients would like that, they have no sense of humor or adventure.

    Thanks again.

  4. #4
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    41,974

    Re: System Menu Fonts

    Quote Originally Posted by wes4dbt
    CoolMenu would crash my VB6 IDE everytime I closed the my app.
    Based on the other code on that site, and the action required by that kind of code, I strongly suspect that subclassing (or "Hooking") is involved.. in which case, the crash is actually likely to be your fault.

    I'd recommend reading (at least briefly) a couple of articles from our Classic VB FAQs:

  5. #5

    Thread Starter
    PowerPoster
    Join Date
    Sep 2005
    Location
    Modesto, Ca.
    Posts
    5,513

    Re: System Menu Fonts

    si,

    You were right, I forgot about the "End" I was using during development. I have never used subclassing or hooking before.

    The CollMenu works but if I click the "End" button in my IDE, the IDE crashes. This is very limiting during development because I break out of my program quite often when I'm testing and debugging.

    Is there some way around this problem?

    Thanks for the help.

  6. #6

    Thread Starter
    PowerPoster
    Join Date
    Sep 2005
    Location
    Modesto, Ca.
    Posts
    5,513

    Re: System Menu Fonts

    si,

    I found a download of CoolMenu 1.3 and it solved the IDE crashing prolem.
    But I couldn't find any documentation on using CoolMenu.

    Thanks for your input

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width