Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win


Windows API ChooseFont EnableHook FindResFailure

Posted on 2008-06-18
Medium Priority
Last Modified: 2010-04-23
I'm trying to implement the API ChooseFont function. I've got everything working fine except when I try and implement the EnableHook. When I do, I get the error FindResFailure returned from CommDlgExtendedError(). Any idea as to what Resource wasn't found and how I can get this to work?
Public Delegate Function CFHookProcDelegate(ByVal hdlg As Integer, ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer  
Private Function HookProc(ByVal hWnd As Integer, ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Select Case (msg)
        Case API.WindowMessage.InitDialog
            ' Center the dialog based on the user's preference
            m_hWndParent = API.GetParent(hWnd)
            Select Case StartPosition
                Case FormStartPosition.CenterParent
                Case FormStartPosition.CenterScreen
            End Select
    End Select
    Return 0
End Function
Public Function ShowDialog() As DialogResult   
    ' Show the dialog   
    If Not API.CHOOSEFONT(m_cf) Then  
        Dim ret As Integer = API.CommDlgExtendedError()   
        Select Case ret   
            Case 0   
            Case API.CommonDialogError.DialogFailure   
                Throw New ApplicationException(("Couldn't show Dialog - Dialog Failure (" +    
ret.ToString + ")"))   
            Case API.CommonDialogError.FindResFailure   
                Throw New ApplicationException(("Couldn't show Dialog - Find Resource Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.GeneralCodes   
                Throw New ApplicationException(("Couldn't show Dialog - General Codes Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.Initialization   
                Throw New ApplicationException(("Couldn't show Dialog - Initialization Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.LoadResFailure   
                Throw New ApplicationException(("Couldn't show Dialog - Load Resource Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.LoadStrFailure   
                Throw New ApplicationException(("Couldn't show Dialog - Load String Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.LockResFailure   
                Throw New ApplicationException(("Couldn't show Dialog - Lock Resource Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.MemAllocFailure   
                Throw New ApplicationException(("Couldn't show Dialog - Memory Allocation Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.MemLockFailure   
                Throw New ApplicationException(("Couldn't show Dialog - Memory Lock Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.NoHInstance   
                Throw New ApplicationException(("Couldn't show Dialog - No HInstance Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.NoHook   
                Throw New ApplicationException(("Couldn't show Dialog - No Hook Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.RegisterMsgFail   
                Throw New ApplicationException(("Couldn't show Dialog - Register Message Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.NoTemplate   
                Throw New ApplicationException(("Couldn't show Dialog - No Template Failure (" + ret.ToString + ")"))   
            Case API.CommonDialogError.StructSize   
                Throw New ApplicationException(("Couldn't show Dialog - Structure Size Failure (" + ret.ToString + ")"))   
            Case Else  
                Throw New ApplicationException(("Couldn't show Dialog - (" + ret.ToString +    
        End Select  
        m_Color = Nothing  
        Return DialogResult.Cancel   
        Dim cancelCheck As New CancelEventArgs()   
        RaiseEvent FileOK(Me, cancelCheck)   
        If cancelCheck.Cancel Then  
            m_Color = Nothing  
            Return DialogResult.Cancel   
            Dim iFontStyle As Integer  
            Dim R As Integer = m_cf.rgbColors And &HFF   
            Dim G As Integer = (m_cf.rgbColors >> 8) And &HFF   
            Dim B As Integer = (m_cf.rgbColors >> 16) And &HFF   
            Dim retLogFont As API.LOGFONT = CType(Marshal.PtrToStructure(New    
IntPtr(m_cf.lpLogFont), GetType(API.LOGFONT)), API.LOGFONT)   
            Me.Color = Color.FromArgb(R, G, B)   
            iFontStyle = FontStyle.Regular   
            If m_cf.nFontType And API.FontType.Bold Then  
                iFontStyle = iFontStyle Or FontStyle.Bold   
            End If  
            If m_cf.nFontType And API.FontType.Italic Then  
                iFontStyle = iFontStyle Or FontStyle.Italic   
            End If  
            If retLogFont.lfStrikeOut Then  
                iFontStyle = iFontStyle Or FontStyle.Strikeout   
            End If  
            If retLogFont.lfUnderline Then  
                iFontStyle = iFontStyle Or FontStyle.Underline   
            End If  
            Me.Font = New Font(retLogFont.lfFaceName, -retLogFont.lfHeight, iFontStyle,    
            Return DialogResult.OK   
        End If  
    End If  
End Function  
Private Function GetFlags() As Integer  
    Dim Flags As Integer  
    Flags = API.ChooseColorFlags.EnableHook Or API.ChooseFontFlags.InitToLogFontStruct Or API.ChooseFontFlags.Both Or API.ChooseFontFlags.Effects   
    If m_ShowHelp Then Flags = Flags Or API.ChooseColorFlags.ShowHelp   
    Return Flags   
End Function  
Private Function PopulateCFStructure() As Boolean  
        ' lfHeight is in Pixels. Convert Font.SizeInPoints to Pixels   
        m_LogFont.lfHeight = -PointToPixels(m_Font.SizeInPoints)   
        If m_Font.Bold Then  
            m_LogFont.lfWeight = API.FontWeight.FW_BOLD   
            m_LogFont.lfWeight = API.FontWeight.FW_NORMAL   
        End If  
        If m_Font.Italic Then  
            m_LogFont.lfItalic = 1   
            m_LogFont.lfItalic = 0   
        End If  
        If m_Font.Underline Then  
            m_LogFont.lfUnderline = 1   
            m_LogFont.lfUnderline = 0   
        End If  
        If m_Font.Strikeout Then  
            m_LogFont.lfStrikeOut = 1   
            m_LogFont.lfStrikeOut = 0   
        End If  
        m_LogFont.lfFaceName = m_Font.Name   
        m_LogFont.lfCharSet = API.FontCharSet.DEFAULT_CHARSET   
        m_LogFont.lfOutPrecision = API.FontPrecision.OUT_DEFAULT_PRECIS   
        m_LogFont.lfClipPrecision = API.FontClipPrecision.CLIP_DEFAULT_PRECIS   
        m_LogFont.lfQuality = API.FontQuality.DEFAULT_QUALITY   
        m_LogFont.lfPitchAndFamily = API.FontPitchAndFamily.DEFAULT_PITCH Or API.FontPitchAndFamily.FF_ROMAN   
        ptrLogFont = Marshal.AllocHGlobal(Marshal.SizeOf(m_LogFont))   
        Marshal.StructureToPtr(m_LogFont, ptrLogFont, False)   
        m_cf.lStructSize = Marshal.SizeOf(m_cf)   
        m_cf.hwndOwner = _hWnd   
        m_cf.lpLogFont = ptrLogFont   
        m_cf.iPointSize = m_Font.SizeInPoints * 10   
        m_cf.flags = GetFlags()   
        m_cf.lpfnHook = New API.CFHookProcDelegate(AddressOf HookProc)   
        m_cf.rgbColors = m_Color.B   
        m_cf.rgbColors = m_cf.rgbColors << 8   
        m_cf.rgbColors = m_cf.rgbColors Or m_Color.G   
        m_cf.rgbColors = m_cf.rgbColors << 8   
        m_cf.rgbColors = m_cf.rgbColors Or m_Color.R   
        m_cf.nSizeMax = 0   
        m_cf.nSizeMin = 0   
    Catch ex As Exception   
        MsgBox("Error Creating CF Strucure: " &ex.Message)   
        Return False  
    End Try  
End Function

Open in new window

Question by:tim8w
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
LVL 96

Expert Comment

by:Bob Learned
ID: 21826087
I am confused--do you want to have a font selection dialog?

Author Comment

ID: 21827087
My original problem was that I couldn't set the initial StartPosition of any of the CommonDialogs in .Net. So I have reverted back to the API versions and have gotten GetOpenFileName, GetSaveFileName and ChooseColor to work by adding a HookProc and positioning the dialog to where the user wants it to be. Then when I got to the ChooseFont dialog, I get the error described in my original question when I attampt to set the HookProc...

Hope that clears things up.
LVL 96

Expert Comment

by:Bob Learned
ID: 21827438
I wonder if this trick still works:


If you are you unhappy with Microsoft's comment in the help ("Note: You cannot specify where a common dialog box is displayed"), but like the idea of common dialog controls, try this.

Start a hidden dummy form instead of calling the open dialog box directly from your main form:


Define the Left and Top properties as you wish and then start the common dialog box from this form. On a Windows 95 system using the 32-bit version of Visual Basic, the open dialog box appears exactly over the left/top coordinates of the form that called the dialog box. This also works if the calling form is hidden and not visible to the user.
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!


Author Comment

ID: 21828751
Regardless of that Microsoft comment, you can specify where a common dialog box is displayed, as I've already done it for three other common dialogs. Hasn't anyone ever used the HookProc for the ChooseFont dialog? I find this very hard to believe...
LVL 96

Expert Comment

by:Bob Learned
ID: 21830039
I haven't, because it is a common dialog, and I don't care where it shows up.

Accepted Solution

tim8w earned 0 total points
ID: 21834363
Since I have been creating solutions for all the Common Dialogs, I ended up with a copy & paste bug. To enable the Hook I was setting the Flag from ChooseColorFlags instead of the one from ChooseFontFlag. Once I changed it to the right Flag, everything worked just fine.

Featured Post

What’s Wrong with Your Cloud Strategy ?

Even as many CIOs are embracing a cloud-first strategy, the reality is that moving to the cloud is a lengthy process and the end-state is likely to be a blend of multiple clouds—public and private. Learn why multicloud solutions matter in this webinar by Nimble Storage.

Question has a verified solution.

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

This tutorial demonstrates one way to create an application that runs without any Forms but still has a GUI presence via an Icon in the System Tray. The magic lies in Inheriting from the ApplicationContext Class and passing that to Application.Ru…
It’s quite interesting for me as I worked with Excel using vb.net for some time. Here are some topics which I know want to share with others whom this might help. First of all if you are working with Excel then you need to Download the Following …
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Want to learn how to record your desktop screen without having to use an outside camera. Click on this video and learn how to use the cool google extension called "Screencastify"! Step 1: Open a new google tab Step 2: Go to the left hand upper corn…

650 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