Older Version
Newer Version
JanetTerra
Nov 9, 2007
==Stringheight for Liberty BASIC==
Stringwidth? is the Liberty BASIC command for obtaining the width in pixels of any given character or chain of characters. Stringwidth? calculates this measurement based upon the current font in use.
[[code format="vbnet"]]
Open "The Stringwidth? Command" for Graphics as #g
#g, "Trapclose XbyTrap"
char$ = "X"
#g, "Down; Place 20 50"
#g, "Font Times_New_Roman 14"
#g, "Stringwidth? char$ PixelWidth"
#g, "\The width of ";char$;" is ";PixelWidth;" pixels."
#g, "Font Courier_New 36"
#g, "Stringwidth? char$ PixelWidth"
#g, "\\The width of ";char$;" is ";PixelWidth;" pixels."
#g, "Flush"
Wait
Sub XbyTrap handle$
Close #g
End
End Sub
[[code]]
Unfortunately, there is no native Stringheight? function. It is possible to calculate the height using a simple gdi32 call. The "GetPixel" API call returns the pixel color at a given x,y location. Set the backcolor to black, then search for 0, the numerical value of black, to find the boundaries of the drawn character.
===Define a Font and Draw the Character===
[[code format="vbnet"]]
WindowWidth = 800
WindowHeight = 600
Graphicbox #main.g, 0, 0, 800, 600
Open "StringHeight for Liberty BASIC" for Window as #main
#main, "Trapclose XbyTrap"
#main.g, "Down; Color Blue; Backcolor Black"
' Assign a font
#main.g, "Font Times_New_Roman 24"
' Draw a character
#main.g, "Place 100 100"
#main.g, "\X"
#main.g, "Flush"
Wait
Sub XbyTrap handle$
Close #main
End
End Sub
[[code]]
===The GetPixel Call===
Include a custom function to return the pixel value in your code. Since the "GetPixel" calls requires the handle of the device context, that custom function should also be included in your code. Before ending your program, release the retrieved device contexts with the ReleaseDC sub.
[[code format="vbnet"]]
' Get the device context
hDC = hDC(hWnd(#main.g))
Function PixelLong(hDC, xVar, yVar)
Open "gdi32"for DLL as #gdi
CallDLL #gdi, "GetPixel",_
hDC as Ulong,_
xVar as Long,_
yVar as Long,_
PixelLong as Long
Close #gdi
End Function
Function hDC(handle)
CallDLL #user32, "GetDC",_
handle as Ulong,_
hDC as Ulong
End Function
Sub ReleaseDC hW, hDC
CallDLL#user32,"ReleaseDC", _
hW as Ulong, _
hDC as Ulong, _
result as Long
End Sub
[[code]]
===Find the Boundaries of the Font Space===
The font space contains more than just the font. There is usually a padding above and below the font, as well as to the left and right of the font. To find the font space boundaries, start at a location outside of the font and work toward the font, stopping when a black pixel is found.
* Finding UpperY of the Font Space
Beginning at 0, work down until a black pixel is found. The x value of 101 is used because the font was drawn at 100, 100.
[[code format="vbnet"]]
For y = 1 to 600
If PixelLong(hDC, 101, y) = 0 Then
UpperY = y
Exit For
End If
Next y
[[code]]
* Finding LowerY of the Font Space
Start at the lowest possible and work up until a black pixel is found.
[[code format="vbnet"]]
For y = 600 to 1 Step -1
If PixelLong(hDC, 101, y) = 0 then
LowerY = y
Exit For
End If
Next y
[[code]]
* Finding the LeftX of the Font Space
LeftX is the first black pixel encountered beginning at 0 and working to the right (x increases).
[[code format="vbnet"]]
For x = 0 to 800
If PixelLong(hDC, x, 100) = 0 Then
LeftX = x
Exit For
End If
Next x
[[code]]
* Finding the RightX of the Font Space
RightX is the first black pixel encountered moving from the farthest right of the window to the left (x decreases).
[[code format="vbnet"]]
For x = 800 to 0 Step -1
If PixelLong(hDC, x, 100) = 0 Then
RightX = x
Exit For
End If
Next x
[[code]]
* Boxing the Font Space
To show that the variables are accurate, draw a box around the font space beginning with LeftX, UpperY and extending to RightX, LowerY.
[[code format="vbnet"]]
#main.g, "Color Red; Backcolor White"
#main.g, "Place ";LeftX;" ";UpperY
#main.g, "Box ";RightX + 1;" ";LowerY + 1
[[code]]
* Calculating Stringheight
Stringheight is RightX - LeftX.
[[code format="vbnet"]]
Stringheight = LowerY - UpperY
#main.g, "Place 100 "; 100 + Stringheight * 2
#main.g, "\Stringheight = ";Stringheight
[[code]]
* Release the Device Context
Finally, release the device context from memory.
[[code format="vbnet"]]
Call ReleaseDC hWnd(#main.g), hDC
[[code]]
* Putting It All Together
Here is the code in its entirety.
[[code format="vbnet"]]
WindowWidth = 800
WindowHeight = 600
Graphicbox #main.g, 0, 0, 800, 600
Open "StringHeight for Liberty BASIC" for Window as #main
#main, "Trapclose XbyTrap"
#main.g, "Down; Color Blue; Backcolor Black"
' Assign a font
#main.g, "Font Times_New_Roman 24"
' Draw a character
#main.g, "Place 100 100"
#main.g, "\X"
#main.g, "Flush"
' Get the device context
hDC = hDC(hWnd(#main.g))
' Find the UpperY boundary of the font space
For y = 0 to 600
If PixelLong(hDC, 101, y) = 0 Then
UpperY = y
Exit For
End If
Next y
' Find the LowerY boundary of the font space
For y = 600 to 0 Step -1
If PixelLong(hDC, 101, y) = 0 then
LowerY = y
Exit For
End If
Next y
' Find the LeftX boundary of the font space
For x = 0 to 800
If PixelLong(hDC, x, 100) = 0 Then
LeftX = x
Exit For
End If
Next x
' Find the RightX boundary of the font space
For x = 800 to 0 Step -1
If PixelLong(hDC, x, 100) = 0 Then
RightX = x
Exit For
End If
Next x
' Outline the font
#main.g, "Color Red; Backcolor White"
#main.g, "Place ";LeftX;" ";UpperY
#main.g, "Box ";RightX + 1;" ";LowerY + 1
' Calculate Stringheight
Stringheight = LowerY - UpperY
#main.g, "Place 100 "; 100 + Stringheight * 2
#main.g, "\Stringheight = ";Stringheight
' Release the device context
Call ReleaseDC hWnd(#main.g), hDC
Wait
Sub XbyTrap handle$
Close #main
End
End Sub
Function PixelLong(hDC, xVar, yVar)
Open "gdi32"for DLL as #gdi
CallDLL #gdi, "GetPixel",_
hDC as Ulong,_
xVar as Long,_
yVar as Long,_
PixelLong as Long
Close #gdi
End Function
Function hDC(handle)
CallDLL #user32, "GetDC",_
handle as Ulong,_
hDC as Ulong
End Function
Sub ReleaseDC hW, hDC
CallDLL#user32,"ReleaseDC", _
hW as Ulong, _
hDC as Ulong, _
result as Long
End Sub
[[code]]
===Disadvantages of Using GetPixel to Determine Stringheight===
There are at least two disadvantages to this method. The first is that the character has to actually be drawn using graphic text. And, the entire font space must always be visible. The second disadvantage is the speed, or lack thereof, in which each pixel is identified for color. The slowness may prevent the routine from being used 'on the fly' throughout the program. Still, the routine may be of some benefit for those programmers in need of the Stringheight measurement.
===Actual Font Height===
If the actual font height, not including the over and under padding, is required, additional searching of black pixels is required. In this instance, the area inside the font space is searched looking for black and non-black pixels. The following demo shows how the width and height of any character of any font can be determined using the "GetPixel" API call.
[[code format="vbnet"]]
Global CurrentFontSpec$, Char$
Global x1Left, x1Right, y1Upper, y1Lower
Global x2Left, x2Right, y2Upper, y2Lower
Global FontPixelWidth1, FontPixelHeight1
Global FontPixelWidth2, FontPixelHeight2
Nomainwin
WindowWidth = 800
WindowHeight = 600
UpperLeftX = Int((DisplayWidth - WindowWidth) /2)
UpperLeftY = Int((DisplayHeight - WindowHeight) /2)
Graphicbox #main.g, 100, 0, 700, 570
Stylebits #main.f1, _BS_MULTILINE, 0, 0, 0
Button #main.f1, "Select Font", FontSelect, UL, 5, 50, 90, 50
Stylebits #main.f2, _BS_MULTILINE, 0, 0, 0
Button #main.f2 "Font Character", FontCharacter, UL, 5, 120, 90, 50
Stylebits #main.f3, _BS_MULTILINE, 0, 0, 0
Button #main.f3 "Font Dimensions", FontDimensions, UL, 5, 190, 90, 50
Open "Calculating Graphic Text Dimensions" for Window as #main
Print #main, "Trapclose XbyTrap"
CurrentFontSpec$ = "Times_New_Roman 12 Bold"
Char$ = "X"
Print #main, " Font ";CurrentFontSpec$
Print #main.g, "Font ";CurrentFontSpec$
Print #main.g, "Down; Fill White"
Print #main.g, "Color Black; Flush"
Wait
Sub XbyTrap handle$
Close #main
End
End Sub
Sub FontSelect handle$
FontDialog CurrentFontSpec$, NewFontSpec$
If NewFontSpec$ <> "" Then
CurrentFontSpec$ = NewFontSpec$
End If
End Sub
Sub FontCharacter handle$
p$ = "Character to be measured";Chr$(13)
p$ = p$;"(Current = ";Char$;")"
Prompt p$;c$
If c$ <> "" Then
Char$ = c$
End If
End Sub
Sub FontDimensions handle$
#main.g, "Fill White; Cls; Fill White"
#main.g, "Backcolor Black; Color Blue"
#main.g, "Font ";CurrentFontSpec$
#main.g, "Stringwidth? Char$ FontStringWidth"
h1 = Val(Word$(CurrentFontSpec$, 2))
h2 = Val(Word$(CurrentFontSpec$, 3))
yPos = Max(h1, h2) * 2
#main.g, "Place 20 ";yPos
#main.g, "\";Char$
hDC = hDC(hWnd(#main.g))
For y = 0 to yPos
If PixelLong(hDC, 20, y) = 0 Then
y1Upper = y
Exit For
End If
Next y
For y = yPos * 2 to 0 Step -1
If PixelLong(hDC, 20, y) = 0 Then
y1Lower = y
Exit For
End If
Next y
FontPixelHeight1 = y1Lower - y1Upper
For x = 10 to 800
If PixelLong(hDC, x, y1Upper) = 0 Then
x1Left = x
Exit For
End If
Next x
For x = yPos * 2 to 10 Step -1
If PixelLong(hDC, x, y1Upper) = 0 Then
x1Right = x
Exit For
End If
Next x
FontPixelWidth1 = x1Right - x1Left
For y = y1Upper to y1Lower
pixel = 0
For x = x1Left + 1 to x1Right
If PixelLong(hDC, x, y) <> 0 Then
pixel = 1
Exit For
End If
Next x
If pixel <> 0 Then
y2Upper = y
Exit For
End If
Next y
For y = y1Lower to y1Upper Step -1
pixel = 0
For x = x1Left to x1Right
If PixelLong(hDC, x, y) <> 0 Then
pixel = 1
Exit For
End If
Next x
If pixel <> 0 Then
y2Lower = y
Exit For
End If
Next y
FontPixelHeight2 = y2Lower - y2Upper
For x = x1Left to x1Right
pixel = 0
For y = y2Upper to y2Lower
If PixelLong(hDC, x, y) <> 0 Then
pixel = 1
Exit For
End If
Next y
If pixel <> 0 Then
x2Left = x
Exit For
End If
Next x
For x = x1Right to x2Left Step -1
pixel = 0
For y = y2Upper to y2Lower
If PixelLong(hDC, x, y) <> 0 Then
pixel = 1
Exit For
End If
Next y
If pixel <> 0 Then
x2Right = x
Exit For
End If
Next x
FontPixelWidth2 = x2Right - x2Left
#main.g, "Backcolor White"
#main.g, "Color Yellow"
#main.g, "Line ";x1Left;" ";yPos;" ";x1Right;" ";yPos
#main.g, "Color Red"
#main.g, "Place ";x1Left - 1;" ";y1Upper - 1
#main.g, "Box ";x1Right + 1;" ";y1Lower + 1
#main.g, "Place ";x1Left;" ";y1Lower + 20
#main.g, "Font Times_New_Roman 12 Bold"
#main.g, "\Total Width = ";FontPixelWidth1;" pixels"
#main.g, "\Total Height = ";FontPixelHeight1;" pixels"
#main.g, "Color Cyan"
#main.g, "Place ";x2Left;" ";y2Upper
#main.g, "Box ";x2Right + 1;" ";y2Lower + 1
#main.g, "Place ";x1Left;" ";y1Lower + 70
#main.g, "Font Times_New_Roman 12 Bold"
#main.g, "\Font Width = ";FontPixelWidth2;" pixels"
#main.g, "\Font Height = ";FontPixelHeight2;" pixels"
#main.g, "Color Black"
#main.g, "\\Stringwidth? = ";FontStringWidth;" pixels"
#main.g, "Flush"
Call ReleaseDC hWnd(#main.g), hDC
End Sub
Function PixelLong(hDC, xVar, yVar)
Open "gdi32"for DLL as #gdi
CallDLL #gdi, "GetPixel",_
hDC as Ulong,_
xVar as Long,_
yVar as Long,_
PixelLong as Long
Close #gdi
End Function
Function hDC(handle)
CallDLL #user32, "GetDC",_
handle as Ulong,_
hDC as Ulong
End Function
Sub ReleaseDC hW, hDC
CallDLL#user32,"ReleaseDC", _
hW as Ulong, _
hDC as Ulong, _
result as Long
End Sub
[[code]]