String size in pixels or units

[Pipes]

Greetings thinBasic USers,

Is there anyway to get the size of a string in pixels (i.e. width, height) after creating the TT font with... {DIM hFont AS DWORD = TBGL_FontHandle("Courier New", 9) :
TBGL_BuildFont( hFont ) }??? By the way TBGL is soooo cool. I'm just beginning to explore its' possibilities. Great job on the 2D sprite routines new in 1.7.8.0. Most impressive :D

Thanks..
Pipes

[Michael Clease]

In your example it uses a proportional font so just count the number of characters and mutiply by 9 (the font size)

[Petr Schreiber]

Hi Pipes,

good question!

Well, there is no native function ( yet ) to do it in TBGL ... but as ThinBasic is Win32 compatible, you can use following function:


' -- API
TYPE SIZEL
cx AS LONG
cy AS LONG
END TYPE
DECLARE FUNCTION GetTextExtentPoint32 LIB "GDI32.DLL" ALIAS "GetTextExtentPoint32A" (BYVAL hdc AS DWORD, byref lpsz AS ASCIIZ, BYVAL cbString AS LONG, byref lpSize AS SIZEL) AS LONG
DECLARE FUNCTION GetDC LIB "USER32.DLL" ALIAS "GetDC" (BYVAL hWnd AS DWORD) AS DWORD
DECLARE FUNCTION SelectObject LIB "GDI32.DLL" ALIAS "SelectObject" (BYVAL hdc AS DWORD, BYVAL hObject AS DWORD) AS DWORD

' -- Helper function
' -- Helper function
SUB GetTextSize( windowHandle AS DWORD, fontHandle AS DWORD, sText AS STRING, byref SizeX as long, byref SizeY as long)

dim l as sizel
dim hdc as dword = GetDC(windowHandle)

SelectObject(windowHandle, fontHandle)
GetTextExtentPoint32(hdc, sText, len(sText), l)
SizeX = l.cx
SizeY = l.cy

END SUB


Usage is like:


GetTextSize(hWnd, hFont, "Programming", width, height)


Mike, you are probably right, the only problem with your solution is that point size of font does not equal the pixel size, so there should be done some units->pixels conversion. The solution above should be general purpose.

If there will be no problems, I will add it as command to TBGL.


Petr

[Petr Schreiber]

Aaaa,

wrong, it does not take the font in consideration. Will seek another solution.


Petr

EDIT: Code above updated, here test (still not good, but usable. It would be better to retrieve RECT bounding whole text):


Uses "TBGL"

FUNCTION TBMAIN()
LOCAL hWnd AS DWORD
LOCAL FrameRate AS DOUBLE

' -- Create and show window
hWnd = TBGL_CreateWindowEx("TBGL script - press ESC to quit", 640, 480, 32, %TBGL_WS_WINDOWED or %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow

dim hFont as dword = TBGL_FontHandle("Arial Black", 32)
TBGL_BuildFont hFont

local width, height as long
GetTextSize(hWnd, hFont, "Hello Pipes!", width, height)

TBGL_UseDepth %FALSE

' -- Resets status of all keys
TBGL_ResetKeyState()

' -- Main loop
While TBGL_IsWindow(hWnd)
FrameRate = TBGL_GetFrameRate
TBGL_RenderMatrix2D
TBGL_ClearFrame
TBGL_Color 255,0,0
TBGL_Rect 100,100,100+width, 100+height
TBGL_Color 255,255,255

TBGL_PrintFont "Hello Pipes!",100,100,0

TBGL_DrawFrame

' -- ESCAPE key to exit application
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While

Wend

TBGL_DestroyWindow
END FUNCTION


' -- API
TYPE SIZEL
cx AS LONG
cy AS LONG
END TYPE
DECLARE FUNCTION GetTextExtentPoint32 LIB "GDI32.DLL" ALIAS "GetTextExtentPoint32A" (BYVAL hdc AS DWORD, byref lpsz AS ASCIIZ, BYVAL cbString AS LONG, byref lpSize AS SIZEL) AS LONG
DECLARE FUNCTION GetDC LIB "USER32.DLL" ALIAS "GetDC" (BYVAL hWnd AS DWORD) AS DWORD
DECLARE FUNCTION SelectObject LIB "GDI32.DLL" ALIAS "SelectObject" (BYVAL hdc AS DWORD, BYVAL hObject AS DWORD) AS DWORD

' -- Helper function
SUB GetTextSize( windowHandle AS DWORD, fontHandle AS DWORD, sText AS STRING, byref SizeX as long, byref SizeY as long)

dim l as sizel
dim hdc as dword = GetDC(windowHandle)

SelectObject(windowHandle, fontHandle)
GetTextExtentPoint32(hdc, sText, len(sText), l)
SizeX = l.cx
SizeY = l.cy

END SUB

[Pipes]

Hi Petr,

Man, you jumped all over that request. I'll try out the solutions you posted and let you know how it turned out. I do appreciate all the help. No doubt I'll have more questions concerning TBGL the further I get into it. It's great to know the questions will be answered and help is available.

Thanks
Pipes

[Pipes]

Hey Petr,

Excellant man! It works as advertised. It would have taken me hours to figure out that solution. I'm really not that familiar with win32 API. I'm working on it a little at a time. I only have one question

SUB GetTextSize( windowHandle AS DWORD, fontHandle AS DWORD, sText AS STRING, byref SizeX as long, byref SizeY as long)
dim l as sizel
dim hdc as dword = GetDC(windowHandle)
SelectObject(windowHandle, fontHandle) '<---------------------------------Not sure why this is here or exactly what it does. Sub still works even if it's commented out
GetTextExtentPoint32(hdc, sText, len(sText), l)
SizeX = l.cx SizeY = l.cy

END SUB

Thanks again

Pipes

[Petr Schreiber]

Hi Pipes,

I am sorry for late reply, but I was out of town.

Well, I *thought* the SelectObject will make sure GetTextExtentPoint32 is properly casted on picked font (not some default), but there is still something wrong, and thats what makes me unhappy.

Code here demonstrates, that in case of 2 different fonts, it does not work :(
So still some investigation must be done.


Uses "TBGL"

FUNCTION TBMAIN()
LOCAL hWnd AS DWORD
LOCAL FrameRate AS DOUBLE

' -- Create and show window
hWnd = TBGL_CreateWindowEx("TBGL script - press ESC to quit", 640, 480, 32, %TBGL_WS_WINDOWED or %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow

dim hFont1 as dword = TBGL_FontHandle("Arial Black", 32)
TBGL_BuildFont hFont1, 1

dim hFont2 as dword = TBGL_FontHandle("Courier", 9)
TBGL_BuildFont hFont2, 2

local width1, height1 as long
GetTextSize(hWnd, hFont1, "Hello Pipes!", width1, height1)

local width2, height2 as long
GetTextSize(hWnd, hFont2, "Hello Pipes!", width2, height2)

TBGL_UseDepth %FALSE

' -- Resets status of all keys
TBGL_ResetKeyState()

' -- Main loop
While TBGL_IsWindow(hWnd)
FrameRate = TBGL_GetFrameRate
TBGL_RenderMatrix2D
TBGL_ClearFrame
TBGL_SetActiveFont 1
TBGL_Color 255,0,0
TBGL_Rect 100,100,100+width1, 100+height1
TBGL_Color 255,255,255
TBGL_PrintFont "Hello Pipes!",100,100,0

TBGL_SetActiveFont 2
TBGL_Color 255,0,0
TBGL_Rect 200,200,200+width2, 200+height2
TBGL_Color 255,255,255
TBGL_PrintFont "Hello Pipes!",200,200,0

TBGL_DrawFrame

' -- ESCAPE key to exit application
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While

Wend

TBGL_DestroyWindow
END FUNCTION


' -- API
TYPE SIZEL
cx AS LONG
cy AS LONG
END TYPE
DECLARE FUNCTION GetTextExtentPoint32 LIB "GDI32.DLL" ALIAS "GetTextExtentPoint32A" (BYVAL hdc AS DWORD, byref lpsz AS ASCIIZ, BYVAL cbString AS LONG, byref lpSize AS SIZEL) AS LONG
DECLARE FUNCTION GetDC LIB "USER32.DLL" ALIAS "GetDC" (BYVAL hWnd AS DWORD) AS DWORD
DECLARE FUNCTION SelectObject LIB "GDI32.DLL" ALIAS "SelectObject" (BYVAL hdc AS DWORD, BYVAL hObject AS DWORD) AS DWORD

' -- Helper function
SUB GetTextSize( windowHandle AS DWORD, fontHandle AS DWORD, sText AS STRING, byref SizeX as long, byref SizeY as long)

dim l as sizel
dim hdc as dword = GetDC(windowHandle)

SelectObject(windowHandle, fontHandle)
GetTextExtentPoint32(hdc, sText, len(sText), l)
SizeX = l.cx
SizeY = l.cy

END SUB

[Michael Hartlef]

Hi Petr,

Maybe the font returned isn't the one you first choosed. Sometimes i noticed that the fonts look the same, no matter what i type. I booked it under less experience with choosing the right font name.

Maybe the font name has to be different.

Michael

[Petr Schreiber]

Thats odd,

could it be caused by emulation?

In case the font name is not properly spelled, Windows try to find "something similar", and even if that fails, they put there some default font. At least according to my experience.

But for correct name I always got correct output so far ... but I will check the code to make me sure.


Petr

[Michael Hartlef]

Sure, coudl be caused by my emulation.