Systemfonts ermitteln

[Andreas Miethe]

ich hab's neulich mal gebraucht, vielleicht kann es ja noch jemand gebrauchen.

$H Windows.ph

DEF Checkmin(1) @If(@!(1) < 0, Int(@!(1)*-1), Int(@!(1)))

Struct LOGFONT = \ 
  lfHeight&,\ 
  lfWidth&,\ 
  lfEscapement&,\ 
  lfOrientation&,\ 
  lfWeight&,\ 
  lfItalic#(1),\ 
  lfUnderline#(1),\ 
  lfStrikeOut#(1),\ 
  lfCharSet#(1),\ 
  lfOutPrecision#(1),\ 
  lfClipPrecision#(1),\ 
  lfQuality#(1),\ 
  lfPitchAndFamily#(1),\ 
  lfFaceName$(31) 

Struct NONCLIENTMETRICS =\
  cbSize&,\
  iBorderWidth&,\
  iScrollWidth&,\
  iScrollHeight&,\
  iCaptionWidth&,\
  iCaptionHeight&,\
  lfCaptionFont!LOGFONT,\
  iSmCaptionWidth&,\
  iSmCaptionHeight&,\
  lfSmCaptionFont!LOGFONT,\
  iMenuWidth&,\
  iMenuHeight&,\
  lfMenuFont!LOGFONT,\
  lfStatusFont!LOGFONT,\
  lfMessageFont!LOGFONT

cls

Var NCM# = New(NONCLIENTMETRICS)
NCM#.cbSize& = SizeOf(NCM#)
~SystemParametersInfo(~SPI_GETNONCLIENTMETRICS,SizeOf(NCM#),NCM#,0)
Print "Systemfonts"  
Print 
Print "TITELLEISTE         : " ,NCM#.lfCaptionFont!lfFacename$, Checkmin(- ~MulDiv(NCM#.lfCaptionFont!lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  
Print "SCHMALE TITELLEISTE : " ,NCM#.lfSmCaptionFont!lfFacename$, Checkmin(- ~MulDiv(NCM#.lfSmCaptionFont!lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  
Print "MENÜ                : " ,NCM#.lfMenuFont!lfFacename$, Checkmin(- ~MulDiv(NCM#.lfMenuFont!lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  
Print "STATUSBAR           : " ,NCM#.lfStatusFont!lfFacename$, Checkmin(- ~MulDiv(NCM#.lfStatusFont!lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  
Print "MESSAGEBOX          : " ,NCM#.lfMessageFont!lfFacename$, Checkmin(- ~MulDiv(NCM#.lfMessageFont!lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  
Dispose NCM#

Var GUI# = New(LOGFONT)
~GetObject(~GetStockObject(~DEFAULT_GUI_FONT), SizeOf(GUI#),GUI#)
Print "DEFAULT_GUI_FONT    : " ,GUI#.lfFacename$, Checkmin(- ~MulDiv(GUI#.lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  
~GetObject(~GetStockObject(~ANSI_FIXED_FONT), SizeOf(GUI#),GUI#)
Print "ANSI_FIXED_FONT     : " ,GUI#.lfFacename$, Checkmin(- ~MulDiv(GUI#.lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))
~GetObject(~GetStockObject(~ANSI_VAR_FONT), SizeOf(GUI#),GUI#)
Print "ANSI_VAR_FONT       : " ,GUI#.lfFacename$, Checkmin(- ~MulDiv(GUI#.lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  
~GetObject(~GetStockObject(~DEVICE_DEFAULT_FONT), SizeOf(GUI#),GUI#)
Print "DEVICE_DEFAULT_FONT : " ,GUI#.lfFacename$, Checkmin(- ~MulDiv(GUI#.lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  
~GetObject(~GetStockObject(~OEM_FIXED_FONT), SizeOf(GUI#),GUI#)
Print "OEM_FIXED_FONT      : " ,GUI#.lfFacename$, Checkmin(- ~MulDiv(GUI#.lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  
~GetObject(~GetStockObject(~SYSTEM_FONT), SizeOf(GUI#),GUI#)
Print "SYSTEM_FONT         : " ,GUI#.lfFacename$, Checkmin(- ~MulDiv(GUI#.lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  
~GetObject(~GetStockObject(~SYSTEM_FIXED_FONT), SizeOf(GUI#),GUI#)
Print "SYSTEM_FIXED_FONT   : " ,GUI#.lfFacename$, Checkmin(- ~MulDiv(GUI#.lfHeight&,72,~GetDeviceCaps(%hDc,~LOGPIXELSY)))  

Dispose GUI#
waitinput
end

[Frabbing]

Funktioniert schön, danke.
Irgendwie klingen die ganzen Win7-Fonts noch so fremd.