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