Width and height of string without 2D drawing lib

[MachineCode]

Like the subject says... it adds overhead to use the 2D drawing lib to get the width and height of text, especially when there's no 2D drawing going on in my app.

[Danilo]

Do you mean the text for gadgets? Because strings do not have a width & height.

You need a context (a drawing area with its DPI) and a font to calculate the
size of displayed text. For example, Windows do not have a text (except the title bar)
and a font. If you draw on a Window you do it with the 2DDrawing functions.

On Windows for Gadgets with Text you could try this:

Code: Select all

EnableExplicit

Procedure GetGadgetTextSize(gadget,*size.SIZE)
    Protected text$, font, dc
    If Not *size:ProcedureReturn:EndIf
    text$  = GetGadgetText(gadget)
    font   = GetGadgetFont(gadget)
    dc     = GetDC_(GadgetID(gadget))
    SelectObject_(dc,font)
    GetTextExtentPoint32_(dc,@text$,Len(text$),*size)
    ReleaseDC_(GadgetID(gadget),dc)
EndProcedure

Procedure GadgetTextWidth(gadget)
    Protected size.SIZE
    GetGadgetTextSize(gadget,@size)
    ProcedureReturn size\cx
EndProcedure

Procedure GadgetTextHeight(gadget)
    Protected size.SIZE
    GetGadgetTextSize(gadget,@size)
    ProcedureReturn size\cy
EndProcedure

If OpenWindow(0, 0, 0, 400, 160, "HyperlinkGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    HyperLinkGadget(0, 10, 10, 250,20,"Red HyperLink", RGB(255,0,0))
    HyperLinkGadget(1, 10, 30, 250,20,"Arial Underlined Green HyperLink", RGB(0,255,0), #PB_HyperLink_Underline)
    SetGadgetFont(1, LoadFont(0, "Arial", 12))
    
    While WindowEvent():Wend
    
    ResizeGadget(0,WindowWidth(0)-GadgetTextWidth(0)-5,10,GadgetTextWidth(0),GadgetTextHeight(0)+3)
    ResizeGadget(1,WindowWidth(0)-GadgetTextWidth(1)-5,30,GadgetTextWidth(1),GadgetTextHeight(1)+3)

    Debug GadgetTextWidth (0)
    Debug GadgetTextHeight(0)
    Debug GadgetTextWidth (1)
    Debug GadgetTextHeight(1)
    
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
        
EndIf

[MachineCode]

Do you mean the text for gadgets?

Yes, I did. And you were even kind and smart enough to know why I asked, and gave me a working example for my HyperLinkGadget. This is exactly the Danilo I remember from years ago, before you disappeared. So happy you're back!

[Danilo]

Thanks for your kind words MachineCode!

I changed the example above: GadgetTextHeight(0)+3 to display the style #PB_HyperLink_Underline correctly.
Looks like +1 pixel is enough, but better use 2 pixels more...

[srod]

Hi,

thought I'd throw this in.

Here's a routine I used on Windows to compute text dimension very accurately. The height calculation is the same as Danilo's, but for the width I factor in the 'over-hang' which can make a slight difference with many fonts. I have found this to give very accurate results.

The routine requires that you either pass a GadgetID() or a HDC. In the former case, make sure you set the optional blnIsHDC parameter to zero.

Code: Select all

Procedure.i GetPreciseTextDimensions(hWndHDC, text$, *sz.SIZE, blnIsHDC = 1)
  Protected hdc, tm.TEXTMETRIC, abc.ABC, overhang, oldFont, char, font
  If text$ And *sz
    If blnIsHDC = 0
      hdc = GetDC_(hWndHDC)
      If hdc = 0
        ProcedureReturn #False
      EndIf
      font = SendMessage_(hWndHDC, #WM_GETFONT, 0, 0)
      If font = 0
        font = GetStockObject_(#DEFAULT_GUI_FONT)
      EndIf
      oldFont = SelectObject_(hdc, font)
    Else
      hdc = hWndHDC    
    EndIf
    ;First obtain the 'raw' dimensions. Equivalent to PB's TextWidth() and TextHeight() functions.
      GetTextExtentPoint32_(hdc, @text$, Len(text$), *sz)
    ;Now an adjustment for any 'overhang'. The method of obtaining this depends on the type of font; raster or true/open type.
    ;For now a quick hack for determining this.
      GetTextMetrics_(hdc, tm) 
      If tm\tmOverhang ;Raster font.
        *sz\cx + tm\tmOverhang 
      Else 
        char = Asc(Right(text$,1)) 
        GetCharABCWidths_(hdc, char, char, abc)  
        overhang = abc\abcC 
        If overHang < 0 
          *sz\cx - overHang 
        EndIf 
      EndIf
    ;Tidy up.
      If blnIsHDC = 0
        SelectObject_(hdc, oldFont)
        ReleaseDC_(hWndHDC, hdc)
      EndIf
  EndIf
  ProcedureReturn #True
EndProcedure

Yes I echo MachineCode's words... welcome back Danilo, it's great to see you around these parts.