StringheightWithGetPixel

Edit 4 …
Older Version Newer Version

JanetTerra 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]]