asked on

Windows API ChooseFont EnableHook FindResFailure

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
                    CenterParentWindow(hWnd)
                Case FormStartPosition.CenterScreen
                    CenterScreenWindow(hWnd)
            End Select
    End Select
    Return 0
End Function
 
Public Function ShowDialog() As DialogResult   
    PopulateCFStructure   
  
    ' 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   
    Else  
        Dim cancelCheck As New CancelEventArgs()   
  
        RaiseEvent FileOK(Me, cancelCheck)   
        If cancelCheck.Cancel Then  
            m_Color = Nothing  
            Return DialogResult.Cancel   
        Else  
            Dim iFontStyle As Integer  
            Dim R As Integer = m_cf.rgbColors And &HFF   
            Dim G As Integer = (m_cf.rgbColors &gt;&gt; 8) And &HFF   
            Dim B As Integer = (m_cf.rgbColors &gt;&gt; 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,    
GraphicsUnit.Pixel)   
  
            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  
  
    Try  
        ' 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   
        Else  
            m_LogFont.lfWeight = API.FontWeight.FW_NORMAL   
        End If  
        If m_Font.Italic Then  
            m_LogFont.lfItalic = 1   
        Else  
            m_LogFont.lfItalic = 0   
        End If  
        If m_Font.Underline Then  
            m_LogFont.lfUnderline = 1   
        Else  
            m_LogFont.lfUnderline = 0   
        End If  
        If m_Font.Strikeout Then  
            m_LogFont.lfStrikeOut = 1   
        Else  
            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

Bob Learned

I am confused--do you want to have a font selection dialog?

tim8w

ASKER

TheLearnedOne,
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.

Bob Learned

I wonder if this trick still works:

http://www.devx.com/tips/Tip/12238

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:

(frmDummy_OpenSaveAs.Hide),

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.

tim8w

ASKER

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...

Bob Learned

I haven't, because it is a common dialog, and I don't care where it shows up.

ASKER CERTIFIED SOLUTION

tim8w

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial