Журнал о программированнии на языках Blitz3D, BlitzPlus, BlitzMax

Blitz3D-код:LineCutter.bb

Материал из Blitz Et Cetera

Перейти к: навигация, поиск
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)
        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)
        ;=
        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

SetFont LoadFont("Arial",16)
im=Text2Image("вот как так можно,а? я спросил у яндекса, генератор случайных слов, а он мне предлагает скачать песни укупника!")
DrawImage im,0,0
Flip

WaitKey()

Другие

Друзья