Retrieving LogFonts

[Ariad]

Hello,

Using a combination of a LogFont strucutre and calls to CreateFontIndirect and SelectObject I can easily change and restore the font on a memory object.

However, I haven't a clue how I'm can retreive that font, preferably back into a LogFont structure.

Does anybody know how to obtain the current font of a memory object?

[gdebacker]

I'm not sure if this is what you're looking for but her it goes.


Private Const OBJ_FONT = 6
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetCurrentObject Lib "GDI32" (ByVal hDC As Long, ByVal uObjectType As Long) As Long
Private Declare Function GetObject Lib "GDI32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Dim lFontData As LOGFONT
Dim hWinDC As Long
Dim lFont As Long


hWinDC = GetWindowDC(Form1.hWnd)
lFont = GetCurrentObject(hWinDC, OBJ_FONT)
GetObject lFont, Len(lFontData), lFontData


Greg

[Ariad]

Greg,

Thanks for the code sample - this is exactly what I was looking for.

[miben]

Thats really kewl. Is there a way to retrieve the font, change a parameter in the Font Structure and return it back to the control?

[gdebacker]

Yes, after you have the font with the above code you can change it like this...

'Change size and weight
    lFontData.lfWeight = FW_NORMAL
    lFontData.lfHeight = -MulDiv(8, GetDeviceCaps(hWinDC, LOGPIXELSX), 72
 
    ' Change to MS Sans Serif
    ' FontName has to be stored in a byte array
    sFontName = "MS Sans Serif"
    For lRet = 1 To Len(sFontName)
        lFontData.lfFaceName(lRet) = Asc(Mid$(sFontName, lRet, 1))
    Next
    lFontData.lfFaceName(Len(sFontName) + 1) = 0
     
    ' Create the new Font and then set it to hWinDC
    lNewFont = CreateFontIndirect(lFontData)
    lFont = SelectObject(hWinDC, lNewFont)
    
    ' After you finish with it
    ' Restore the old font
    SelectObject hWinDC, lFont
    ' Delete the font we made
    DeleteObject lNewFont

Greg

[Motxopro]

booyah he's right