Re: Problem with API GetDC
public Function GetFontDialogUnits(byval frmIn as Form) as Long
Dim hFont as Long
Dim hFontOld as Long
Dim r as Long
Dim avgWidth as Long
Dim hDc as Long
Dim tmp as string
Dim sz as SIZE
'get the hdc to the main window
hDc = GetDC(frmIn.hwnd)
'with the current font attributes, select the font
hFont = GetStockObject(ANSI_VAR_FONT)
hFontOld = SelectObject(hDc, hFont&)
'get its length, then calculate the average character width
tmp = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
GetTextExtentPoint32(hDc, tmp, 52, sz)
avgWidth = (sz.cx \ 52)
're-select the previous font & delete the hDc
SelectObject(hDc, hFontOld)
DeleteObject(hFont)
ReleaseDC(frmIn.hwnd, hDc)
'return the average character width
GetFontDialogUnits = avgWidth
End Function
To use:
Debug.print GetFontDialogUnits(Form1)
HTH,
Duncan
-------------------------------------------------
Ex. Datis: Duncan Jones
Merrion Computing Ltd
http://www.merrioncomputing.com
Re: Problem with API GetDC
Hi Duncan,
Any thanx since my code is working fine, in don't know what was the problem with that.
Regards,
Mahesh
Re: Problem with API GetDC
Hi Duncan,
Anyway thanx since my code is working fine, I don't know what was the problem with that.
Regards,
Mahesh