Results 1 to 4 of 4

Thread: Font in a toolbar

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2000
    Location
    Whats a location?
    Posts
    516

    Question

    It was only today that I realised that fancy VB menu (well, it's as fancy as
    menus get) is not a menu at all, it's a toolbar. I'd been wanting to add a
    spanking new and fancier menu to my app (with the must-have Tahoma font) for
    a while, so I went straight to the Components window and add all those Microsoft
    OCXs. Then I added a toolbar to my form, and scrolled down to the Font
    property. The problem is that there wasn't one.

    Ermmm?

    Any answers?

    All I want to do is add a few buttons (File, Help etc.) in TAHOMA. Is that, literally, too much to ask?

    Any help, in any shape, would be dearly appreciated by me and my imaginary friend
    Bob.

    Courgettes.

  2. #2
    Fanatic Member Dim's Avatar
    Join Date
    Jul 2000
    Posts
    620
    =/ i'm not sure you can change the fort of a toolbar because..what would the font be for...i think that when you add other controls to the toolbar then you can set then font of those control (ie.label).
    Hope that helped,
    D!m
    Dim

  3. #3
    Guest

    Lightbulb A different approach

    You can try using this method to change the Fonts of Menu's. I got this piece of code and tried to simplify it as much as possible. Once you get the basic idea, you can improve it by a lot.

    Make a Form with a Menu (with SubMenu's), and put the following code into a CommandButton.

    Code:
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
    Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
    Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
    Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
    Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Long) As Long
    Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
    Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
    Const MF_BITMAP = &H4&
    Const MF_STRING = &H0&
    
    Private Sub Command1_Click()
    
            'Declare our Variables
            Dim hID As Long
            Dim hMenu As Long
            Dim hSubMenu As Long
            Dim hDC As Long
            Dim hFont As Long
            Dim hBmp As Long
            Dim lh()
            'The the DC and hWnd of the form and Menu's
            hMenu = GetMenu(Form1.hwnd)
            hSubMenu = GetSubMenu(hMenu, 0)
            hDC = CreateCompatibleDC(Me.hDC)
            'Get the number of SubMenus
            iCount = GetMenuItemCount(hSubMenu)
            ReDim lh(iCount)
            
            'Loop through the SubMenus
            For i = 0 To GetMenuItemCount(hSubMenu)
                
                hID = GetMenuItemID(hSubMenu, i)
                'Create the Font
                hFont = CreateFont(-16, 0, 0, 0, 400, 0, 0, 0, 0, 0, 0, 0, 0, Me.FontName)
                lh(i) = CreateCompatibleBitmap(hDC, 200, 18)
                hBmp = SelectObject(hDC, lh(i))
                
                SelectObject hDC, hFont
                Rectangle hDC, -1, -1, 201, 19
                'Set the Menu Text
                TextOut hDC, 0, 0, "SubMenu" & i, 8
                'Make the modifications
                ModifyMenu hSubMenu, hID, MF_BITMAP, hID, lh(i)
    
            Next i
            
    End Sub
    
    Private Sub Form_Load()
    
        'Change the FontName here
        Me.FontName = "Courier"
        
    End Sub

  4. #4

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2000
    Location
    Whats a location?
    Posts
    516
    Dim:

    Thanks, but I'd already tried that approach, but no luck.

    Megatron:

    I'd seen that code posted in the API forum, and I tried it. The menu was good,
    but it looks a bit strange because the menu is Tahoma, but the 'main' button
    (eg File) is still the same font (MS Sans Serif I'd assume)
    Otherwise, I would have used it.

    I'm still open for suggestions until I go and make a 4000 line control which I've just been revising for.

    (4000 is a rough guess and to show off a little)

    BTW has anybody made a control like it?

    I've been doing my groundwork for it (DrawEdge, TextOut, CreateFont, etc) and it looks like it's going to be a bugger.

    It really feels like I'm starting from scratch. I mean, I've got to subclass EVERY-*******-THING.

    Surely there's got to be a way?

    Any help/Prozac greatly appreciated.

    Spank you.






    Courgettes.

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