PureBasic Forums - English

Posted: **Fri Oct 22, 2004 3:14 am**

How do I get the font information for a gadget? Like I want to modify a current button gadget to be bold. I understand how to *set* the font attributes but not how to retrieve the existing information.

Posted: **Sat Oct 23, 2004 2:26 am**

This may be information overkill but it's all I have. 8O

Code: Select all

; --> Array for ListViewGadget tabstops
Dim tStop(0)

Procedure doFontStuff()
   
  ; --> Request font and use currently select font if available
  If myFont <> 0
    result = FontRequester(SelectedFontName(), SelectedFontSize(), SelectedFontStyle())
  Else
    result = FontRequester("Arial", 12, 0)
  EndIf
  
  ; --> Load the font
  If result <> 0
    myFont = LoadFont(0, SelectedFontName(), SelectedFontSize(), SelectedFontStyle()) 
  EndIf
  
  If myFont <> 0
    SetGadgetFont(1, UseFont(0))
    SetGadgetText(1, SelectedFontName())
    
    ; --> Get DC for TextGadget that will contain our loaded font
    hdc = GetDC_(GadgetID(1))
    SelectObject_(hdc, myFont)
    
    ; --> Get font info
    GetTextMetrics_(hdc, @tm.TEXTMETRIC)
    
    ; --> Get font weight
    Select tm\tmweight
      Case 100
        fontWeight$ = "#FW_THIN"
      Case 200
        fontWeight$ = "#FW_EXTRALIGHT or #FW_ULTRALIGHT"
      Case 300
        fontWeight$ = "#FW_LIGHT"
      Case 400
        fontWeight$ = "#FW_NORMAL or #FW_REGULAR"
      Case 500
        fontWeight$ = "#FW_MEDIUM"
      Case 600
        fontWeight$ = "#FW_SEMIBOLD or #FW_DEMIBOLD"
      Case 700
        fontWeight$ = "#FW_BOLD"
      Case 800
        fontWeight$ = "#FW_EXTRABOLD or FW_ULTRABOLD"
      Case 900
        fontWeight$ = "#FW_HEAVY or FW_BLACK"
        
    EndSelect
    
    ; --> Is it Italic style
    If tm\tmItalic = 0
      italic$ = "No"
    Else
      italic$ = "Yes"
    EndIf
    
    ; --> Is it Underline style
    If tm\tmUnderlined = 0
      underline$ = "No"
    Else
      underline$ = "Yes"
    EndIf
    
    ; --> Is it Strikeout style
    If tm\tmStruckOut = 0
      strikeout$ = "No"
    Else
      strikeout$ = "Yes"
    EndIf
    
    ; --> Get pitch info
    pitch$ = ""
    If (tm\tmPitchAndFamily&$F) & #TMPF_DEVICE
      pitch$ + "Device  "
    EndIf
    If (tm\tmPitchAndFamily&$F) & #TMPF_TRUETYPE
      pitch$ + "TrueType  "
    EndIf
    If (tm\tmPitchAndFamily&$F) & #TMPF_VECTOR
      pitch$ + "Vector  "
    EndIf
    If (tm\tmPitchAndFamily&$F) & #TMPF_FIXED_PITCH
      pitch$ + "Variable Pitch " ; Yes, this is correct for bit enabled
    EndIf
    
    ; --> Get family info
    family$ = ""
    If (tm\tmPitchAndFamily &$F0) & #FF_DECORATIVE
      family$ = "Decorative"
    EndIf
    If (tm\tmPitchAndFamily&$F0) & #FF_DONTCARE
      family$ = "Dont Care"
    EndIf
    If (tm\tmPitchAndFamily&$F0) & #FF_MODERN
      family$ = "Modern"
    EndIf
    If (tm\tmPitchAndFamily&$F0) & #FF_ROMAN
      family$ = "Roman" 
    EndIf
    If (tm\tmPitchAndFamily&$F0) & #FF_SCRIPT
      family$ = "Script" 
    EndIf
    If (tm\tmPitchAndFamily&$F0) & #FF_SWISS 
      family$ = "Swiss" 
    EndIf
    
    ; --> Get character set
    Select tm\tmCharSet
      Case #ANSI_CHARSET
        charSet$ = "ANSI_CHARSET"
      Case #BALTIC_CHARSET
        charSet$ = "BALTIC_CHARSET"
      Case #CHINESEBIG5_CHARSET
        charSet$ = "CHINESEBIG5_CHARSET"
      Case #DEFAULT_CHARSET
        charSet$ = "DEFAULT_CHARSET"
      Case #EASTEUROPE_CHARSET
        charSet$ = "EASTEUROPE_CHARSET"
      Case #GREEK_CHARSET
        charSet$ = "GREEK_CHARSET"
      Case #MAC_CHARSET
        charSet$ = "MAC_CHARSET"
      Case #OEM_CHARSET
        charSet$ = "OEM_CHARSET"
      Case #RUSSIAN_CHARSET
        charSet$ = "RUSSIAN_CHARSET"
      Case #SHIFTJIS_CHARSET
        charSet$ = "SHIFTJIS_CHARSET"
      Case #SYMBOL_CHARSET
        charSet$ = "SYMBOL_CHARSET"
      Case #TURKISH_CHARSET
        charSet$ = "TURKISH_CHARSET"
      Default
        charSet$ = Str(tm\tmCharSet)
        
    EndSelect
    
    ; --> Resize TextGadget height to fit our font height
    ResizeGadget(1, -1, -1, -1, tm\tmheight)
    
    ; --> Display our font info
    ClearGadgetItemList(2) 
    AddGadgetItem(2, -1,"Font Name: " + Chr(9) + SelectedFontName())
    AddGadgetItem(2, -1,"Weight: " + Chr(9) + Str(tm\tmweight) + "   " + fontWeight$)
    AddGadgetItem(2, -1,"Italic: " + Chr(9) + italic$)
    AddGadgetItem(2, -1,"Underlined: " + Chr(9) + underline$)
    AddGadgetItem(2, -1,"Strike Out: " + Chr(9) + strikeout$)
    AddGadgetItem(2, -1,"Pitch: " + Chr(9) + pitch$)
    AddGadgetItem(2, -1,"Family: " + Chr(9) + family$)
    AddGadgetItem(2, -1,"Char Set: " + Chr(9) + charSet$)
    AddGadgetItem(2, -1, "Height: " + Chr(9) + Str(tm\tmheight))
    AddGadgetItem(2, -1, "Ascent: " + Chr(9) + Str(tm\tmAscent))
    AddGadgetItem(2, -1,"Descent: " + Chr(9) + Str(tm\tmDescent))
    AddGadgetItem(2, -1,"Internal Leading: " + Chr(9) + Str(tm\tmInternalLeading))
    AddGadgetItem(2, -1,"External Leading: " + Chr(9) + Str(tm\tmExternalLeading))
    AddGadgetItem(2, -1,"Avg Char Width: " + Chr(9) + Str(tm\tmAveCharWidth))
    AddGadgetItem(2, -1,"Max Char Width: " + Chr(9) + Str(tm\tmMaxCharWidth))
    AddGadgetItem(2, -1,"Overhang: " + Chr(9) + Str(tm\tmOverhang))
    AddGadgetItem(2, -1,"Digitized AspectX: " + Chr(9) + Str(tm\tmDigitizedAspectX))
    AddGadgetItem(2, -1,"Digitized AspectY: " + Chr(9) + Str(tm\tmDigitizedAspectY))
    AddGadgetItem(2, -1,"First Char: " + Chr(9) + "Chr(" + Str(tm\tmFirstChar) +")  " + Chr(tm\tmFirstChar))
    AddGadgetItem(2, -1,"Last Char: " + Chr(9) + "Chr(" + Str(tm\tmLastChar) +")  " + Chr(tm\tmLastChar))
    AddGadgetItem(2, -1,"Default Char: " + Chr(9) + "Chr(" + Str(tm\tmDefaultChar) +")  " + Chr(tm\tmDefaultChar))
    AddGadgetItem(2, -1,"Break Char: " + Chr(9) + "Chr(" + Str(tm\tmBreakChar) +")  " + Chr(tm\tmBreakChar))
    
    ; --> Set our ListViewGadget tabstops
    tStop(0) = 75
    SendMessage_(GadgetID(2), #LB_SETTABSTOPS, 1, @tStop(0))
    InvalidateRect_(GadgetID(2), 0, 1)
    
  EndIf 
EndProcedure

If OpenWindow(0, 0, 0, 600, 520, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Font Information") And CreateGadgetList(WindowID(0)) 
   
  ButtonGadget(0, 10, 10, 100, 20, "Select Font")
  TextGadget(1, 10, 50, 580, 40, "") 
  ListViewGadget(2, 10, 200, 380, 300, #LBS_USETABSTOPS)
  
  Repeat
    
    event = WaitWindowEvent()
    If event = #PB_EventGadget And EventGadgetID() = 0
      doFontStuff()
    EndIf
    
  Until event = #PB_Event_CloseWindow 
  
  ; --> Clean up
  ReleaseDC_(GadgetID(1), hdc)
  
EndIf 
End

Posted: **Mon Oct 25, 2004 5:03 am**

That is a large amount of information

However, the thing I'm trying to shoot for is to retrieve the basic information about a gadget and then change them.

Take this for an example. I have a button that I would like to alternately bold and unbold whenever I need. That's about it ^_^ However, it'd be nice to know how to retrieve the font name/styles (bold, italics, underlines, etc...) and then reapply those settings to the same gadget with a few changes - change the font or italicize the gadget programmatically (without the user selecting the font).

I tried the following to get the font name but it seems to return "System" even if I change the font of the button gaget to Arial using LoadFont, etc...

Code: Select all

If OpenWindow(0, 0, 0, 600, 520, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Font Information") And CreateGadgetList(WindowID(0))
   ButtonGadget(1, 10, 10, 100, 20, "Select Font")
   sHold.s = Space(255)
   Repeat
      event = WaitWindowEvent()
      If event = #PB_EventGadget And EventGadgetID() = 1
         hDC = GetDC_(GadgetID(1))
         Debug GetTextFace_(hDC,255,sHold)
         ReleaseDC_(GadgetID(1), hDC)
         Debug sHold
      EndIf
   Until event = #PB_Event_CloseWindow
EndIf

End

Any more great ideas?

And I can use your code with a few changes. I think I just need to know how to properly get the font name and then reapply the changes to a gadget. Without loading a programmatically selected font (through FontRequestor, for example).

Thanks again for the large, great example.

Posted: **Mon Oct 25, 2004 2:30 pm**

See if you can work with this.

Code: Select all

Global normalFont, boldFont

normalFont = LoadFont(0, "Arial", 10)
boldFont = LoadFont(1, "Arial", 10, #PB_Font_Bold)

Procedure getFontInfo(change)
  
  currentFont = SendMessage_(GadgetID(1), #WM_GETFONT, 0, 0)
  GetObject_(currentFont, SizeOf(LOGFONT), @lf.LOGFONT)
  faceName$ = PeekS(@lf\lfFacename)
  faceWeight.l = lf\lfWeight
  SetGadgetText(0, faceName$ + "  " + Str(faceWeight))
  
  If change = 1
    If faceWeight < 600
      SetGadgetFont(1, boldFont)
      SetGadgetFont(2, normalFont)
      SetGadgetText(2, "Change to normal")
    Else
      SetGadgetFont(1, normalFont)
      SetGadgetFont(2, boldFont)
      SetGadgetText(2, "Change to BOLD")
    EndIf
    
    currentFont = SendMessage_(GadgetID(1), #WM_GETFONT, 0, 0)
    GetObject_(currentFont, SizeOf(LOGFONT), @lf.LOGFONT)
    faceName$ = PeekS(@lf\lfFacename)
    faceWeight.l = lf\lfWeight
    SetGadgetText(0, faceName$ + "  " + Str(faceWeight))
  EndIf
  
EndProcedure

If OpenWindow(0, 0, 0, 300, 100, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Change Font Style") And CreateGadgetList(WindowID(0)) 
  TextGadget(0, 10, 10, 150, 20, "")
  TextGadget(1, 170, 10, 100, 20, "Hello World!") 
  SetGadgetFont(1, normalFont)
  ButtonGadget(2, 130, 50, 150, 25, "Change to BOLD") 
  SetGadgetFont(2, boldFont)
  getFontInfo(0)
   
  Repeat 
    
    event = WaitWindowEvent() 
    If event = #PB_EventGadget
      
      Select EventGadgetID()
        
        Case 2
           getFontInfo(1)
          
       EndSelect
      
    EndIf 
    
  Until event = #PB_Event_CloseWindow 
  
EndIf 
End

Posted: **Wed Oct 27, 2004 4:27 am**

Bah. Your example works nicely but when I run a frankenstein-ed function

Code: Select all

Procedure fontSetGadget(inGadget.l, setBold.w)
   ;
   lRet.l
   lf.LOGFONT
   ;
   currentFont.l = SendMessage_(GadgetID(inGadget), #WM_GETFONT, 0, 0)
   GetObject_(currentFont, SizeOf(LOGFONT), @lf.LOGFONT)
   ;
   faceName$ = PeekS(@lf\lfFacename)
   faceWeight.l = lf\lfWeight
   faceHeight.l = lf\lfHeight
   ;
   Debug faceName$
   ;
   If setBold = #True 
      lRet = LoadFont(#PB_Any,faceName$,faceHeight)
   Else
      lRet = LoadFont(#PB_Any,faceName$,faceHeight,#PB_Font_Bold)
   EndIf
   SetGadgetFont(inGadget,lRet)
   CloseFont(lRet)
   ;
EndProcedure

... the debug keeps returning 'MS Shell Dlg' when I pass it a constant for the buttongadget I want to change. And then does not change the gadget itself.

I think I'll just work on some other stuff and let this one sit for a while since it's not really that important at the moment.

I just don't understand why yours works and mine doesn't

However, thanks for your example. It works and I'll just have to worry about it later

PureBasic Forums - English

Get Font Information

Get Font Information