PureBasic Forums - English

Code: Select all

fnt.l=GetStockObject_(#DEFAULT_GUI_FONT)
If fnt
    finfo.LOGFONT
    GetObject_(fnt,SizeOf(LOGFONT),@finfo)
    fontsize=finfo\lfHeight
    fontname$=PeekS(@finfo\lfFaceName[0])
Else
    fontname$="System"
    fontsize=12
EndIf

b$="FONTNAME: "+fontname$+"    FONTSIZE: "+Str(fontsize)
MessageRequester("FONT INFO",b$,0)
a=LoadFont(#PB_Any,fontname$,fontsize)

Code: Select all

;===============================================================================
; Include/Tailbite Library Command: GetMessageBoxFont
; Author:                           netmaestro
; Date:                             September 8, 2007
; Target OS:                        Microsoft Windows All
; Target Compiler:                  PureBasic 4.xx and later
; License:                          Free, unrestricted, credit appreciated
;                                   but not required
;===============================================================================

Global hook, *fi.LOGFONT 

Procedure CbtProc(nCode, wParam, lParam) 

  Select nCode 
    
    Case #HCBT_CREATEWND 
        
      hWnd = wParam 
      *pcbt.CBT_CREATEWND = lParam 
      *pcs.CREATESTRUCT = *pcbt\lpcs 
      If *pcs\lpszClass = 32770    
        *pcs\x = -2 * *pcs\cx ; if it's a dialog box, move it off the screen
      EndIf 
          
    Case #HCBT_ACTIVATE 
        
      hwnd = wParam 
      control = GetDlgItem_(hwnd, $FFFF) 
      font = SendMessage_(control, #WM_GETFONT, 0,0) 
      GetObject_(font,SizeOf(LOGFONT),*fi)
      SendMessage_(hwnd, #WM_CLOSE,0, 0) ; we examined it, now let's kill it

  EndSelect 

  ProcedureReturn CallNextHookEx_(hook, nCode, wParam, lParam) 

 EndProcedure 

ProcedureDLL GetMessageBoxFont(*finfo.LOGFONT)
  *fi = *finfo
  hook = SetWindowsHookEx_(#WH_CBT, @CbtProc(), #Null, GetCurrentThreadId_()) 
  MessageRequester("Title","Message",$C0) ; this won't make a sound and you won't see it 
  UnhookWindowsHookEx_(hook) 
EndProcedure

Code: Select all

ProcedureDLL ReadBinaryKey(OpenKey.l, SubKey$, Valuename$) 
  *regdata = AllocateMemory(1024) 
  hKey = 0 
  Datasize = 1024 
  KeyType = #REG_BINARY 
  Result=0 
  If RegOpenKeyEx_(OpenKey, SubKey$, 0, #KEY_READ, @hKey) = 0 
    If RegQueryValueEx_(hkey, valuename$, 0, @keytype,  *regdata, @Datasize)  = 0 
      ReAllocateMemory(*regdata, Datasize) 
      Result = 1 
    EndIf 
    RegCloseKey_(hKey) 
  EndIf 
  If Result 
    ProcedureReturn *regdata 
  Else 
    FreeMemory(*regdata) 
    ProcedureReturn 0 
  EndIf 
EndProcedure 

*fi.LOGFONT = ReadBinaryKey(#HKEY_CURRENT_USER, "Control Panel\Desktop\WindowMetrics", "MessageFont") 

If *fi 
  hdc = GetWindowDC_(#Null)
  logPixSY = GetDeviceCaps_(hdc, #LOGPIXELSY) 
  ReleaseDC_(#Null, hdc)
  FontSize.f = -(*fi\lfHeight * 72) / logPixSY 
  fontname.s = Space(16) 
  
  CompilerIf #PB_Compiler_Unicode 
    fontname = PeekS(@*fi\lfFacename) 
  CompilerElse 
    namelength = MemorySize(*fi)-OffsetOf(LOGFONT\lfFacename) 
    WideCharToMultiByte_(#CP_ACP, 0, @*fi\lfFacename, namelength, @fontname, namelength/2, 0, 0); 
  CompilerEndIf 
  
  Debug fontname 
  Debug Str(fontsize)
EndIf 

Code: Select all

ncm.NONCLIENTMETRICS\cbSize = SizeOf(NONCLIENTMETRICS)
SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(ncm), @ncm, 0) 
msgFont$ = PeekS(@ncm\lfMessageFont\lfFaceName)
hdc = CreateDC_(@"DISPLAY", 0, 0, 0)
logPixSY = GetDeviceCaps_(hdc, #LOGPIXELSY) 
DeleteDC_(hdc)
msgFontSize.f = -(ncm\lfMessageFont\lfHeight * 72) / logPixSY
MessageRequester("Message Box Font Info:", "FontName: " + msgFont$ + #crlf$ + "FontSize: " + Str(msgFontSize))