Rectangular Text

Archives Forums/BlitzPlus Programming/Rectangular Text

Arem(Posted 2005) [#1]
This is a little function I wrote to make a string of text be displayed at a certain location at a certain width. I have already chopped 9 lines off the code and was wondering if anybody could shorten it more.

Graphics 800,600,32,2

SetBuffer BackBuffer()
textsquare("This is the test of the new textsquare function and I need to ramble to make sure it works, so that is what I am doing. I hope it works well. Yeah. This is getting old. Yup. It is. Ok. That ought to be long enough now.",100,20,400)
Flip
WaitKey
End

Function textsquare(incoming$,x,y,width)
word$=""
tempx=x
tempy=y

While incoming$<>""
word$=""
While Right$(word$,1)<>" " And incoming$<>""
word$=word$+Left$(incoming$,1)
incoming$=Right$(incoming$,Len(incoming$)-1)
Wend

If tempx+StringWidth(word$)<width+x
Text(tempx,tempy,word$)
tempx=tempx+StringWidth(word$)
Else
tempx=x
tempy=tempy+FontHeight()
Text(tempx,tempy,word$)
tempx=tempx+StringWidth(word$)
End If
Wend
End Function

Good luck!


WolRon(Posted 2005) [#2]
faq_link('2')


Arem(Posted 2005) [#3]
You misunderstand me, fool. I don't want to put code in a box for the forums. I want to do it in a graphics mode. I am currently writing a function that does it fully justified.


DredPirateRoberts(Posted 2005) [#4]
not al that shorter line wise but its more efficient

format_codebox('
;======================================================================
;
;======================================================================
Function TextSquare2 ( txt$, ix, iy, width )
Local offset
Local offset2
Local word$
Local x

While ( 1 )

offset2 = Instr ( txt$, " ", offset )
word$ = Mid$ ( txt$, offset, offset2-offset )

Text ( x+ix, iy, word )

If ( offset2 = 0 ) Then Exit

x = x + StringWidth(word$) + StringWidth(" ")

If ( x + StringWidth(word$) >= width )
x = 0
iy = iy + FontHeight()
End If

offset = offset2 + 1

Wend

End Function
')


Arem(Posted 2005) [#5]
This code will justify it too!

format_codebox('Graphics 800,600,32,2

Type word
Field content$
End Type

SetBuffer BackBuffer()
squaretext("This is a really long string to test my function. I hope it works. But it may not. It ought to be long enough soon. Like now. That's probably good. Ok. Stopping the rambling. Yup. Ok. I'm really done now.",0,0,100)
Flip
WaitKey
End

Function squaretext(incoming$,x,y,width)
While incoming$<>""
If StringWidth(incoming$)>width
temp$=""
tempnum=1

While StringWidth(temp$)<width
temp$=temp$+Mid$(incoming$,tempnum,1)
tempnum=tempnum+1
Wend

While Not Right$(temp$,1)=" "
temp$=Left$(temp$,Len(temp$)-1)
Wend

incoming$=Right$(incoming$,Len(incoming$)-Len(temp$))

If Left$(incoming$,1)=" "
incoming$=Right$(incoming$,Len(incoming$)-1)
End If

While Right$(temp$,1)=" "
temp$=Left$(temp$,Len(temp$)-1)
Wend

justifiedtext(temp$,x,y,width)
Else
Text(x,y,incoming$)
incoming$=""
End If
y=y+FontHeight()
Wend
End Function

Function justifiedtext(curline$,x,y,width)
tempx#=x
spacing#=Float#(width)/Float#(Len(curline$))

For a=1 To Len(curline$)
Text(tempx,y,Mid$(curline$,a,1))
tempx#=tempx#+spacing#
Next
End Function')

If you can shorten it, please do.


Arem(Posted 2005) [#6]
Ok. This is as good as I can get it.

format_codebox('Function squaretext(incoming$,x,y,width)
While incoming$<>""
If StringWidth(incoming$)>width
curline$=""

While StringWidth(curline$)<width
curline$=curline$+Mid$(incoming$,Len(curline$)+1,1)
Wend

While Not Right$(curline$,1)=" "
curline$=Left$(curline$,Len(curline$)-1)
Wend

incoming$=Trim$(Right$(incoming$,Len(incoming$)-Len(curline$)))
curline$=Trim$(curline$)
spacing#=Float#(width)/Float#(Len(curline$))

For a=0 To Len(curline$)
Text(x+Float(spacing#)*a,y,Mid$(curline$,a+1,1))
Next
Else
Text(x,y,incoming$)
incoming$=""
End If
y=y+FontHeight()
Wend
End Function')

22 lines of bliss. Shorten it. Please.