Text scaling demo
This message is in MIME format. Since your mail reader does not understand
this format, some or all of this message may not be legible.
------_=_NextPart_000_01C2C71C.A1201040
Got a text scaling demo working, thought I'd share it with y'all.
It will fit the text perfectly inside a given rectangle, and it will support
strings with tab and newline characters, and automatically strip out carriage
return characters.
=======================
Patrick Barnes
Information Systems Group
201 Elizabeth St, Sydney
Patrick.Barnes at transgrid.com.au
Ext: 91-3583
Ph:(02) 9284-3583
Mob: 0410 751 044
=======================
Below for those people without attachments.
=======================
------------------------------------
--Title: Automatic text sizing demo
--Author: Patrick Barnes
--Date: 28 / 1 / 2003
------------------------------------
--This demo revolves around the
--procedure drawText. It will
--tokenize a given string into lines
--and add tabs to it, then size it
--to fit into a rectangle of given
--size and position.
------------------------------------
--Permission is freely granted for
--anyone to use this library as they
--see fit, save for misrepresenting
--it's origin.
------------------------------------
--Thanks to: Pete Lomax for his
--binary search, Derek Parnell for
--win32lib.
------------------------------------
include win32lib.ew
without warning
constant win = create(Window, "Text scaling", 0, Default, Default, 400, 340, 0)
constant text = "This is a test of the automatic\ntext sizing system.\nChange
this text in the source code."
constant TABSIZE = 6
constant TAB = 9
atom dwin
--returns a sequence with the x,y size of the lines of text submitted
global function getMlTextExtent(integer win, sequence mtext)
integer lnum, maxw
lnum = length(mtext)
maxw = 0
for a = 1 to lnum do
if getTextWidth(win, mtext[a]) > maxw then
maxw = getTextWidth(win, mtext[a])
end if
end for
return {maxw , lnum*getTextHeight(win, "T")}
end function
--Will automatically size and draw the string itext (which may have '\n') to the
desired window.
--It will scale and position to fit inside the rectangle defined by {ulx, uly}
-> {lrx, lry}
--Font is a two-element sequence of the form { "Font name", Style }
global procedure drawText(integer win, sequence itext, integer ulx, integer uly,
integer lrx, integer lry, sequence font )
sequence text, tsize, wsize, pos
integer bsize, ssize, fsize
atom ctr
--Tokenize the text into lines.
--*****************************
if not length(itext) then --if no text, then don't bother
return
elsif itext[length(itext)] = '\n' then --if the last char is a '\n' then get
rid of it.
itext = itext[1..length(itext) - 1]
end if
text = {{}}
ctr = 1
for a = 1 to length(itext) do --step through every letter, building up the
lines
if itext[a] = TAB then
text[ctr] &= repeat(' ', remainder( TABSIZE * ( floor( length(text[ctr]) /
TABSIZE) + 1), length(text[ctr]) ) )
elsif itext[a] = '\n' then
text &= {{}}
ctr += 1
elsif itext[a] = '\r' then
--ignore that character
else text[ctr] &= itext[a]
end if
end for
--Find the optimal font size for the window
--*****************************************
fsize = 8 --starting font size
ssize = 1
bsize = 0
wsize = {lrx - ulx, lry - uly}
while 1 do --Thanks to Pete Lomax for his binary search.
--find the size of that text
setFont(win, font[1], fsize, font[2])
tsize = getMlTextExtent(win, text)
--if it's bigger than the window...
if tsize[1] >= wsize[1] or tsize[2] >= wsize[2] then
bsize=fsize
fsize=ssize+floor((fsize-ssize)/2)
if fsize=ssize then
exit
end if
else
ssize=fsize
if bsize=0 then
fsize*=2
else
if fsize+1=bsize then exit end if
fsize+=floor((bsize-fsize)/2)
end if
end if
end while --At this point fsize is the optimal text size.
--Draw the text to the window
--***************************
pos = {ulx, uly}
--draw the text on the window.
setFont(win, font[1], fsize, font[2])
for a = 1 to length(text) do
wPuts({win, pos[1], pos[2]}, text[a])
pos[2] += getTextHeight(win, text[a])
end for
end procedure
-------------------------------------------------------------------
procedure display(integer ID, integer Event, sequence params)
sequence sz
sz = getClientRect(win)
drawText(win, text, 50, 50, sz[3] - 50, sz[4] - 50, {"Times New Roman", Normal}
)
drawRectangle(win, 0, 50, 50, sz[3] - 50, sz[4] - 50)
end procedure
setHandler(win, w32HPaint, routine_id("display") )
-------------------------------------------------------------------
procedure c(integer ID, integer Event, sequence params)
sequence sz
if params[1] != 27 then
sz = getClientRect(win)
setClientRect(win, sz[3]+5, sz[4]+5)
else
closeWindow(win)
end if
end procedure
setHandler(win, w32HKeyDown, routine_id("c") )
-------------------------------------------------------------------
procedure resized(integer ID, integer Event, sequence params)
repaintWindow(win)
end procedure
setHandler(win, w32HResize, routine_id("resized") )
-------------------------------------------------------------------
WinMain(win, Normal)
<<textscaletest.exw>>
***********************************************************************
***********************************************************************
------_=_NextPart_000_01C2C71C.A1201040
Content-Type: application/octet-stream;
name="textscaletest.exw"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="textscaletest.exw"
------------------------------------
--Title: Automatic text sizing demo
--Author: Patrick Barnes
--Date: 28 / 1 / 2003
------------------------------------
--This demo revolves around the
--procedure drawText. It will
--tokenize a given string into lines
--and add tabs to it, then size it
--to fit into a rectangle of given
--size and position.
------------------------------------
--Permission is freely granted for=20
--anyone to use this library as they=20
--see fit, save for misrepresenting=20
--it's origin.
------------------------------------
--Thanks to: Pete Lomax for his
--binary search, Derek Parnell for
--win32lib.
------------------------------------
include win32lib.ew
without warning
constant win =3D create(Window, "Text scaling", 0, Default, Default, =
400, 340, 0)
constant text =3D "This is a test of the automatic\ntext sizing =
system.\nChange this text in the source code."
constant TABSIZE =3D 6
constant TAB =3D 9
atom dwin
--returns a sequence with the x,y size of the lines of text submitted
global function getMlTextExtent(integer win, sequence mtext)
integer lnum, maxw
lnum =3D length(mtext)
maxw =3D 0
for a =3D 1 to lnum do
if getTextWidth(win, mtext[a]) > maxw then
maxw =3D getTextWidth(win, mtext[a])
end if
end for
return {maxw , lnum*getTextHeight(win, "T")}
end function
--Will automatically size and draw the string itext (which may have =
'\n') to the desired window.
--It will scale and position to fit inside the rectangle defined by =
{ulx, uly} -> {lrx, lry}
--Font is a two-element sequence of the form { "Font name", Style }
global procedure drawText(integer win, sequence itext, integer ulx, =
integer uly, integer lrx, integer lry, sequence font )
sequence text, tsize, wsize, pos
integer bsize, ssize, fsize
atom ctr
--Tokenize the text into lines.
--*****************************
if not length(itext) then --if no text, then don't bother
return
elsif itext[length(itext)] =3D '\n' then --if the last char is a =
'\n' then get rid of it.
itext =3D itext[1..length(itext) - 1]
end if
text =3D {{}}
ctr =3D 1
for a =3D 1 to length(itext) do --step through every letter, =
building up the lines
if itext[a] =3D TAB then
text[ctr] &=3D repeat(' ', remainder( TABSIZE * ( floor( =
length(text[ctr]) / TABSIZE) + 1), length(text[ctr]) ) )
elsif itext[a] =3D '\n' then
text &=3D {{}}
ctr +=3D 1
elsif itext[a] =3D '\r' then
--ignore that character
else text[ctr] &=3D itext[a]
end if
end for
--Find the optimal font size for the window
--*****************************************
fsize =3D 8 --starting font size
ssize =3D 1
bsize =3D 0
wsize =3D {lrx - ulx, lry - uly}
while 1 do --Thanks to Pete Lomax for his binary search.
--find the size of that text
setFont(win, font[1], fsize, font[2]) =20
tsize =3D getMlTextExtent(win, text)
--if it's bigger than the window...
if tsize[1] >=3D wsize[1] or tsize[2] >=3D wsize[2] then
bsize=3Dfsize
fsize=3Dssize+floor((fsize-ssize)/2)
if fsize=3Dssize then
exit
end if
else
ssize=3Dfsize
if bsize=3D0 then
fsize*=3D2
else
if fsize+1=3Dbsize then exit end if
fsize+=3Dfloor((bsize-fsize)/2)
end if
end if
end while --At this point fsize is the optimal text size.
--Draw the text to the window
--***************************
pos =3D {ulx, uly}
--draw the text on the window.
setFont(win, font[1], fsize, font[2]) =20
for a =3D 1 to length(text) do
wPuts({win, pos[1], pos[2]}, text[a])
pos[2] +=3D getTextHeight(win, text[a])
end for
end procedure
-------------------------------------------------------------------
procedure display(integer ID, integer Event, sequence params)
sequence sz
sz =3D getClientRect(win)
drawText(win, text, 50, 50, sz[3] - 50, sz[4] - 50, {"Times New =
Roman", Normal} )
drawRectangle(win, 0, 50, 50, sz[3] - 50, sz[4] - 50)
end procedure
setHandler(win, w32HPaint, routine_id("display") )
-------------------------------------------------------------------
procedure c(integer ID, integer Event, sequence params)
sequence sz
if params[1] !=3D 27 then
sz =3D getClientRect(win)
setClientRect(win, sz[3]+5, sz[4]+5)
else
closeWindow(win)
end if
end procedure
setHandler(win, w32HKeyDown, routine_id("c") )
-------------------------------------------------------------------
procedure resized(integer ID, integer Event, sequence params)
repaintWindow(win)
end procedure
setHandler(win, w32HResize, routine_id("resized") )
-------------------------------------------------------------------
WinMain(win, Normal)
------_=_NextPart_000_01C2C71C.A1201040--
|
Not Categorized, Please Help
|
|
