апд
Dim Text2Image_buffer$(0)
Dim Text2Image_buffer2%(0)
Dim Text2Image_buffer3%(0)
Function AdaptText2Len$(InputString$,max%,SEP%)
Local Rstr$=InputString
Local P%=0
Local P2%
Local t%
While P<>Len(Rstr)
P2=Instr(Rstr,Chr(SEP),P+1)
If P2=0 P2=Len(Rstr)
If P2-P-1>max
Rstr=Left(RStr,P+max)+Chr(SEP)+Mid(Rstr,P+max+1,-1)
P2=P+max
EndIf
t=P2
P2=P
P=t
Wend
Return Rstr
End Function
Function TextSplit(InputString$,crt_%=0)
If Len(InputString$)=0
InputString$="зачем пытаться вставить пустую строку ?!"
EndIf
Local Separator%=32
Local Maxlen%=Len(InputString)
If crt_=0 crt_=Ceil(Sqr(Maxlen))
Local CRT%=crt_
;=
InputString$=AdaptText2Len$(InputString$,CRT,Separator)
Maxlen%=Len(InputString)
;=
If MaxLen=1
Dim Text2Image_buffer$(1)
Text2Image_buffer(0)=InputString
Text2Image_buffer(1)=""
Return
EndIf
Local Z%
Local Z0%
Dim Text2Image_buffer2(Maxlen)
Text2Image_buffer2(0)=Instr(InputString,Chr(Separator),1)
For i=1 To Maxlen
Text2Image_buffer2(i)=Instr(InputString,Chr(Separator),Text2Image_buffer2(i-1)+1)
If Text2Image_buffer2(i)=0
Exit
EndIf
Next
Dim Text2Image_buffer3(Maxlen)
Text2Image_buffer3(0)=0
Z=0
Z0=0
While Text2Image_buffer2(Z)<>0
While Text2Image_buffer2(Z)-Text2Image_buffer3(Z0)-1<=CRT And Text2Image_buffer2(Z)<>0
Z=Z+1
Wend
Z0=Z0+1
Text2Image_buffer3(Z0)=Text2Image_buffer2(Z-Sgn(Z))
Wend
Z0=Z0+1
Text2Image_buffer3(Z0)=Maxlen
Dim Text2Image_buffer$(Z0+1)
For i=0 To Z0
Text2Image_buffer(i)=Mid(InputString,Text2Image_buffer3(i)+1,Text2Image_buffer3(i+1)-Text2Image_buffer3(i))
Next
Text2Image_buffer(i)=""
Dim Text2Image_buffer2(0)
Dim Text2Image_buffer3(0)
End Function
Function Text2Image%(InputString$)
TextSplit(InputString$)
Local imX=0
Local imY=0
Local imXt=0
Local imYt=0
Local tt$
Local X
Local I
I=0
While Text2Image_buffer(i)<>""
imXt=StringWidth(Text2Image_buffer(i))
imYt=StringHeight(Text2Image_buffer(i))
If imXt>imX
imX=imXt
EndIf
imY=imY+imYt
I=I+1
Wend
Local image=CreateImage(imX,imY)
Local y=0
SetBuffer ImageBuffer(image)
Color 255,255,255
Rect 0,0,imX,imY
Color 0,0,0
I=0
While Text2Image_buffer(i)<>""
X=0
For iZ=1 To Len(Text2Image_buffer(i))
tt=Mid(Text2Image_buffer(i),iZ,1)
Text X,y,tt
X=X+StringWidth(tt)
Next
y=y+StringHeight(Text2Image_buffer(i))
I=I+1
Wend
SetBuffer BackBuffer()
Dim Text2Image_buffer(0)
Return image
End Function
Function TextReady()
Return Text2Image_buffer(0)<>""
End Function
Function FlushText()
Dim Text2Image_buffer2(0)
Dim Text2Image_buffer3(0)
Dim Text2Image_buffer(0)
End Function
Function Text2Image%(InputString$)
вернёт хендл созданной картинки, в которой будет содержаться текст InputString$ разрезанный на строки, по длине, равной корню из длины исходной строки (критерий рахбиения можно настроить в Function TextSplit(InputString$,crt_%=0) )
Function TextSplit(InputString$,crt_%=0)
заполняет массив Text2Image_buffer строками длиной crt_, составленными из InputString если, crt_ не задано - бертся корень длины исходной строки. Последняя строка массива Text2Image_buffer(i)=""
Function AdaptText2Len$(InputString$,max%,SEP%)
Подготавливает текст InputString$ к разбитию на строки длиной max% по разделителю SEP%. В случае если строку нельзя разбить, функция делает искусственные вставки по длине разделетиля.
Function TextReady()
Вернёт ИСТИНУ, если в массиве Text2Image_buffer уже хранится разбиение
Function FlushText()
Принудительно очистит все массивы (вызвать перед TextSplit или Text2Image не нужно)