Board Logo
« stringWidth function »

Welcome Guest. Please Login or Register.
Nov 20th, 2017, 6:49pm


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: stringWidth function  (Read 1195 times)
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3614
xx stringWidth function
« Thread started on: Sep 19th, 2007, 2:54pm »

Yes, that very function that says you width of your text before you print it ;)
I guess it is possible to use it for word wrapping - and for text justifying (enlarging spaces so you have left and right text columnd edges aligned)... I will not do it here.

Ok, on subject.
The idea is simple: to get width of text printed we use "canned" widths of all letters. These widths calculated by other program (provided here) by reading pixels from screen and looking where we didn't overtype yet. Resulting widths is stored in a string - that allow for easily using more then one font (just use string with widths for that font).
String is cut'n'pasted into your program, with stringWidth() function.
Again: we use "canned" letter widths. So it is important to set same font, size and style in both generator program and main (your) program.

Generator program:
Code:
'stringWidth generator program.
'tsh73, september 2007
'create widths$ string to use for stringWidth$ function
'
    dim charWidth(128)

    UpperLeftX = 20
    UpperLeftY = 20
    WindowWidth = 640       'should be big enough to font to fit
    WindowHeight = 400
    open "Please wait for program to calculate letters width..." for graphics_nsb as #gr
    #gr, "trapclose [quit]"

    #gr, "font Times_New_Roman 12"

    #gr, "down"
    blue$="0 0 255"
    #gr, "fill ";blue$
    #gr, "color black"

    startX = 20
    startY = 50

    'get dimensions for all letters
    #gr, "place "; startX;" ";startY

    widths$ = ""

    #gr, "place "; startX;" ";startY
    for i = 1 to 3
        for j = 0 to 31
            'print the char
            #gr, "posxy x y"

            c = i*32+j

            if  (chr$(c) = "\") then
                #gr, "|"; chr$(c)
            else
                #gr, "\"; chr$(c)
            end if

            'get the width
            for xx = x to x+40
                col$=GetPixelValue$(xx, y, "#gr")
                if col$ = blue$ then
                    charWidth(c) = xx - x
                    exit for
                end if
            next

            widths$ = widths$ + chr$(48+charWidth(c))
            #gr, "place "; x+ charWidth(c);" ";y
        next j
        #gr, "\"
        #gr, "posxy x y"
        #gr, "place "; startX;" ";y
    next i
    '#gr, "flush"
    close #gr

    'now write resulting string
    print "Following statement supposed to be copied and pasted into other program"
    print "where widths$ string wil be used for stringWidth function."
    print
    print "widths$ = ";chr$(34);
    print mid$(widths$, 1, 32);chr$(34);" _"
    print "        + ";chr$(34);mid$(widths$, 33, 32);chr$(34);" _"
    print "        + ";chr$(34);mid$(widths$, 65);chr$(34)
print

    wait


[quit]
    close #gr
    end

'***************************************************
'GetPixelValue$ returns a string with the RGB values of the pixel
'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph")
function GetPixelValue$(x, y, handle$)

'Grab a 1*1 bitmap
    #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1

'Save in a bmp file
    bmpsave "gpv", "getpvaluetemp.bmp"

'Open the file for string input and get it's full contents
    open "getpvaluetemp.bmp" for input as #gpv
    s$ = input$(#gpv, lof(#gpv))
    close #gpv

'Check if user's display is 32-bit, and read the red-green-blue values
'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0
'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment
'otherwise function returns nothing (support for other display types could be added (?))
    bpp =  asc(mid$(s$, 29, 1))
    select case bpp
    case 32
        red = asc(mid$(s$, 69, 1))
        green = asc(mid$(s$, 68, 1))
        blue = asc(mid$(s$, 67, 1))
    case 16
        bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1))
        red =  (bytes AND 63488) /256       '0xF800
        green =  (bytes AND 2016) / 32 * 4  '0x7E0
        blue =  (bytes AND 31) * 8          '0x1F
    end select

'concatenate the return value, delete temporary file and free memory
    GetPixelValue$ = str$(red)+" "+str$(green)+" "+str$(blue)
    kill "getpvaluetemp.bmp"
    unloadbmp "gpv"
end function

 

Demo of using stringWidth function:
Code:
'string width demo
'tsh73, september 2007

'this string with letter widths
'for particular font size and style
'was created by accompanying generator program

widths$ = "45588=<3558946448888888888349997" _
        + "?;:;;99<;56<9><<9<:99;;?;;954588" _
        + "5787876773483;788856477;7767389<"

nomainwin
WindowWidth = 640
WindowHeight = 480
    UpperLeftX = (DisplayWidth - WindowWidth )/2
    UpperLeftY = (DisplayHeight -  WindowHeight )/2

open "demo" for graphics_nsb as #gr
#gr, "trapclose [quit]"
#gr, "home; down; turn 90"
#gr, "posxy halfW halfH"
#gr, "font Times_New_Roman 12"

#gr, "place 0 0"
#gr, "\"
#gr, "posxy dummy txtHeight"

data "This is some examples of string"
data "we underline it to show that we indeed get right widths"
data "and for numbers, too"
data "01234.56789"

for i = 1 to 4
    read a$
    #gr, "place 20 ";i*2*txtHeight
    #gr, "\";a$
    #gr, "go ";stringWidth(a$, widths$)
next

data "Now, some centrally aligned text"
data "More on center"

for i = 1 to 2
    read a$
    #gr, "place ";halfW-stringWidth(a$, widths$)/2;" ";halfH + i*txtHeight
    #gr, "\";a$
next

data "And now some right aligned text"
data "Very handy for numbers"
data "12345.99", "12.34","123345.60"

for i = 1 to 5
    read a$
    #gr, "place ";2*halfW-stringWidth(a$, widths$);" ";4/3*halfH + i*txtHeight
    #gr, "\";a$
next

#gr, "flush"
wait

[quit]
    close #gr
    end

'***********************************************
function stringWidth(aStr$, widths$)
    aLen = 0
    for i = 1 to len(aStr$)
        c$ = mid$(aStr$, i, 1)
        w$ = mid$(widths$, asc(c$) - 31, 1)    'so we start with space
        aLen = aLen + asc(w$) - 48    'so "1" corresponds to 1, "2" to 2 etc
        'print i, c$, asc(c$) - 31, w$, asc(w$) - 48
    next i
     stringWidth=aLen
end function
 
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3614
xx Re: stringWidth function
« Reply #1 on: Nov 14th, 2017, 11:58am »

Suddenly, 10 years after initial post (!),
just after JB2.0 is out and supports native "stringwidth"
- I got an idea how to make it work with JB 1.01.
(without any generators)
(actually it was Rod who suggested using subtle color changes to check hitting of text area in
Extracting a data from a graphicbox
thread.)
So it uses upper part of graphic box to draw text in almost-white, GetPixelValue$ to get color and binary search to make it fast.
Code:
'string width demo for JB 1.01
'tsh73, Nov 2017

nomainwin
WindowWidth = 640
WindowHeight = 480
    UpperLeftX = (DisplayWidth - WindowWidth )/2
    UpperLeftY = (DisplayHeight -  WindowHeight )/2

open "demo" for graphics_nsb as #gr
#gr, "trapclose [quit]"
#gr, "home; down; turn 90"
#gr, "posxy halfW halfH"
#gr, "font Times_New_Roman 12"

#gr, "place 0 0"
#gr, "\"
#gr, "posxy dummy txtHeight"

data "This is some examples of string"
data "we underline it to show that we indeed get right widths"
data "and for numbers, too"
data "01234.56789"

for i = 1 to 4
    read a$
    strLen = stringWidth(a$, "#gr")
    #gr, "place 20 ";i*2*txtHeight
    #gr, "\";a$
    #gr, "go "; strLen
next

data "Now, some centrally aligned text"
data "More on center"

for i = 1 to 2
    read a$
    #gr, "place ";halfW-stringWidth(a$, "#gr")/2;" ";halfH + i*txtHeight
    #gr, "\";a$
next

data "And now some right aligned text"
data "Very handy for numbers"
data "12345.99", "12.34","123345.60"

for i = 1 to 5
    read a$
    #gr, "place ";2*halfW-stringWidth(a$, "#gr");" ";4/3*halfH + i*txtHeight
    #gr, "\";a$
next

#gr, "flush"
wait

[quit]
    close #gr
    end

'***********************************************

function stringWidth(aStr$, handle$)
    #handle$ "home; posxy halfW dummy"
    'full width white line
    #handle$ "color white"
    #handle$ "line 0 1 ";2*halfW;" 1"
    'now, text
    #handle$ "backcolor 254 254 254" 'near, but not 255 255 255
    #handle$ "color 254 254 254"
    #handle$ "place 0 0 "
    #handle$ "\";aStr$
    'now find first white pt
    l = 1
    h = 1
    while GetPixelValue$(h, 1, handle$) <>"255 255 255"
        'print h, GetPixelValue$(h, 1, "#gr")
        l = h
        h = h*2
        if h >2*halfW then h = 2*halfW: exit while
    wend
    if GetPixelValue$(h, 1, handle$)<>"255 255 255" then
        'actually in this case we dont know - string too long
            'print "string too long (>";h;")"
            stringWidth = h
        else
            'print l, h 'now we should find first white simbol in (l, h]
            while h-l>1
                m = int((l+h)/2)
                'print l, h, m
                if GetPixelValue$(m, 1, handle$)<>"255 255 255" then l = m else h = m
            wend
            'print m
            stringWidth = m
    end if
    'restore colors
    #handle$ "backcolor white"
    #handle$ "color black"
end function

'GetPixelValue$ returns a string with the RGB values of the pixel
'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph")
function GetPixelValue$(x, y, handle$)

'Grab a 1*1 bitmap
    #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1

'Save in a bmp file
    bmpsave "gpv", "getpvaluetemp.bmp"

'Open the file for string input and get it's full contents
    open "getpvaluetemp.bmp" for input as #gpv
    s$ = input$(#gpv, lof(#gpv))
    close #gpv

'Check if user's display is 32-bit, and read the red-green-blue values
'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0
'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment
'otherwise function returns nothing (support for other display types could be added (?))
    bpp =  asc(mid$(s$, 29, 1))
    select case bpp
    case 32
        red = asc(mid$(s$, 69, 1))
        green = asc(mid$(s$, 68, 1))
        blue = asc(mid$(s$, 67, 1))
    case 16
        bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1))
        red =  (bytes AND 63488) /256       '0xF800
        green =  (bytes AND 2016) / 32 * 4  '0x7E0
        blue =  (bytes AND 31) * 8          '0x1F
    end select

'concatenate the return value, delete temporary file and free memory
    GetPixelValue$ = str$(red)+" "+str$(green)+" "+str$(blue)
    'to save some time. colud delete stuff in the end
    kill "getpvaluetemp.bmp"
    unloadbmp "gpv"
end function
 
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls