PureBasic Forums - English

Posted: **Fri Oct 17, 2008 12:11 pm**

Hi,

here's a quick utility which I just bashed up for those who (like myself) like to place and size gadgets very precisely depending on the font metrics etc.

The 'GetTextDimensions()' function below is more precise than PB's TextWidth() and TextHeight() functions since it examines any 'overhang' which is added by many fonts when dealing with italic and/or bold styles. Calculating this depends on the nature of the font (raster or true/open type). PB's functions do not take this into account.

The function will either accept a HDC (and uses the font currently selected into the HDC) or an hWnd (in which case it extracts the appropriate font) and returns the relevant dimensions in a SIZE type structure.

Code: Select all

Procedure.l GetTextDimensions(hWndHDC, text$, *sz.SIZE, blnIsHDC = 1)
  Protected result, hdc, tm.TEXTMETRIC, abc.ABC, overhang, oldFont, char
  If text$ And *sz
    If blnIsHDC = 0
      hdc = GetDC_(hWndHDC)
      If hdc = 0
        ProcedureReturn #False
      EndIf
      oldFont = SelectObject_(hdc, SendMessage_(hWndHDC, #WM_GETFONT, 0, 0))
    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

And here's a quick demo. Choose a font and watch the text gadget resize to fit the text.

Code: Select all

;Test.
;=====
selectedFont.s = "Arial"
selectedFontSize = 12

text$ = "Heyho tiddly dee tiddly doo!" 

If OpenWindow(0,10,10,600,600,"Test", #PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
  hWnd = TextGadget(1, 0, 0, 0, 0, text$, #WS_BORDER)
  LoadFont(1, selectedFont, selectedFontSize, SelectedFontStyle)
  SetGadgetFont(1, FontID(1))
  ButtonGadget(2, 500,560, 80, 20, "Choose font")
  GetTextDimensions(hWnd, text$, sz.SIZE, 0) ;0 informs the function that we are passing a hWnd as opposed to a HDC.
  ;Add on border widths etc.
    sz\cx + 2*GetSystemMetrics_(#SM_CXBORDER)
    sz\cy + 2*GetSystemMetrics_(#SM_CYBORDER)
  ResizeGadget(1, (WindowWidth(0)-sz\cx)>>1, (WindowHeight(0)-sz\cy)>>1, sz\cx, sz\cy)
  Repeat 
    Event=WaitWindowEvent() 
    Select Event
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 2
            If FontRequester(selectedFont, selectedFontSize, 0)
              FreeFont(1)
              selectedFont = SelectedFontName() : selectedFontSize = SelectedFontSize()
              LoadFont(1, selectedFont, selectedFontSize, SelectedFontStyle())
              SetGadgetFont(1, FontID(1))
              GetTextDimensions(hWnd, text$, sz.SIZE, 0) ;0 informs the function that we are passing a hWnd as opposed to a HDC.
              ;Add on border widths etc.
                sz\cx + 2*GetSystemMetrics_(#SM_CXBORDER)
                sz\cy + 2*GetSystemMetrics_(#SM_CYBORDER)
              ResizeGadget(1, (WindowWidth(0)-sz\cx)>>1, (WindowHeight(0)-sz\cy)>>1, sz\cx, sz\cy)
            EndIf
        EndSelect
    EndSelect
  Until Event=#PB_Event_CloseWindow 
EndIf

Posted: **Fri Oct 17, 2008 12:32 pm**

Thanks srod -- I needed something like this.

BUT, can you make it fix the "upperhang" (for want of a better word) too?
See in this picture, how there is heaps of blank space above the text?

Posted: **Fri Oct 17, 2008 12:49 pm**

In short no - not really; there's nothing to fix!

Font's have a constant height which, at the outset, is set by the font designer but of course can be scaled by the gdi font mapper etc. This height is independent of the character sets which the font supports. The appearance of the text will also be affected by the basline setting of the font etc. This is unlike character widths which, for true-type fonts are variable and differ between characters.

For example, the characters "A" and "." will have the same height but different widths for tt fonts.

You can play around with the textmetrics if you wish; e.g. you can remove the internal leading height by placing the line :

Code: Select all

*sz\cy=tm\tmHeight-tm\tmInternalLeading

after the GetTextMetrics_() line.

Posted: **Fri Oct 17, 2008 2:06 pm**

A very useful snippet. Thanks, srod!

Posted: **Sat Oct 18, 2008 5:38 am**

Really nice goodie.
And it allowed me to discover GetSystemMetrics().
Such a simple and totally useful API function.
Thanks Srod

Posted: **Sun Oct 26, 2008 10:26 am**

In your example code, Srod, you point out the following

srod wrote:

Code: Select all

  ;Add on border widths etc. 
   sz\cx + 2*GetSystemMetrics_(#SM_CXBORDER) 
   sz\cy + 2*GetSystemMetrics_(#SM_CYBORDER) 
   ResizeGadget(1, (WindowWidth(0)-sz\cx)>>1, (WindowHeight(0)-sz\cy)>>1, s

If I understand well, the above would be required when using TextGadgets with a border. But if there were a way to figure out programmatically whether borders surround the text box, wouldn't it be more practical to include the above in your procedure, enclosing it within an If...Endif block?

The part I can't figure out, of course, is the most important one: how do you test for the presence of borders ? ...

Posted: **Sun Oct 26, 2008 11:07 am**

Testing for borders is a simple matter of using GetWindowLong_(). However, different controls come with different border styles set and different 'margins' (e.g. a string gadget can have margins set and can have it's formatting rectangle adjusted). Taking all this into account in a generic routine is simply not practical and not possible.

Anyhow the code I posted here is about text extents and not about control borders etc. The code does exactly what it says.

Posted: **Sun Oct 26, 2008 8:48 pm**

srod wrote:[...]Anyhow the code I posted here is about text extents and not about control borders etc. The code does exactly what it says.

Yes, of course. I'm not suggesting otherwise.

My question only pertained to the fact that I thought that the resulting sz\cx and sz\cy values varied according to the presence of borders or not around the text being measured.

Besides, now i've learned, accidentally, something new: that there's a lot more to borders than I thought

Posted: **Sun Oct 26, 2008 9:28 pm**

My question only pertained to the fact that I thought that the resulting sz\cx and sz\cy values varied according to the presence of borders or not around the text being measured.

No, my example is assuming the presence of the border. Remove the border and the values of sz\cx etc. will not change!

At the end of the day the example was just that - a simple demo. Using text metrics in order to determine the suitable 'size' of a control is only a part of the story.

PureBasic Forums - English

Calculate text extents - italic / bold etc.

Calculate text extents - italic / bold etc.

Re: Calculate text extents - italic / bold etc.