System Fonts

Hi CodeGurus,

First, I'm from germany, so my english is not so good and some names of controls and windows components are slightly different, please try to understand me ;)

Ok, I know that I can get all fonts in the actual windows system by screen.fonts .
But I want the fonts windows uses in the display -> appearance properties.
The Standard is Sans Serif, but I for example use always Verdana, because I like it more.

How can I get the fonts of the appearance properties?

thx in advance,
Tom

I'm not exactly clear on what you want to do. Do you:
1. Want to see what the current font setting is?
2. See what the possible fonts are?
3. Set the current font setting?

Hope this helps:


option Explicit
private Const LF_FACESIZE = 32
private Type LOGFONT
lfHeight as Long
lfWidth as Long
lfEscapement as Long
lfOrientation as Long
lfWeight as Long
lfItalic as Byte
lfUnderline as Byte
lfStrikeOut as Byte
lfCharSet as Byte
lfOutPrecision as Byte
lfClipPrecision as Byte
lfQuality as Byte
lfPitchAndFamily as Byte
lfFaceName(LF_FACESIZE) as Byte
End Type

private Const SPIF_SENDWININICHANGE = &H2
private Const SPIF_SENDCHANGE = SPIF_SENDWININICHANGE
private Const SPIF_UPDATEINIFILE = &H1

private Const SPI_GETICONTITLELOGFONT = 31
private Const SPI_SETICONTITLELOGFONT = 34

private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (byval uAction as Long, byval uParam as Long, byref lpvParam as Any, byval fuWinIni as Long) as Long
private Sub Command1_Click()
Dim x as LOGFONT
Dim y as Long
Dim i as Integer
Dim sTemp() as Byte

y = len(x)
'get Current System Font
SystemParametersInfo SPI_GETICONTITLELOGFONT, y, x, 0

'Change it to Arial
'If anyone has a 'prettier' way to do this, let me know!!
sTemp() = StrConv("Arial", vbFromUnicode)
for i = 0 to LF_FACESIZE - 1
If i <= UBound(sTemp) - 1 then
x.lfFaceName(i) = sTemp(i)
else
x.lfFaceName(i) = 0
End If
next i

'set to pitch to 14
x.lfHeight = -14
'set weight to 'Bold'
x.lfWeight = 700
y = len(x)

'set new font
SystemParametersInfo SPI_SETICONTITLELOGFONT, y, x, SPIF_SENDCHANGE Or SPIF_UPDATEINIFILE
End Sub

private Sub Form_Load()
Command1.Caption = "set System Font"
End Sub

But I only want to read out all the fonts. Not only the one in the windows, the fonts used for captions too.