forum.boolean.name

forum.boolean.name (http://forum.boolean.name/index.php)
-   Полезные функции (http://forum.boolean.name/forumdisplay.php?f=17)
-   -   Text2Image (http://forum.boolean.name/showthread.php?t=5428)

impersonalis 25.12.2007 16:39

Text2Image
 
Вложений: 3
Скрытый текст (вы должны войти под своим логином или зарегистрироваться и иметь 5 сообщение(ий)):
У вас нет прав, чтобы видеть скрытый текст, содержащийся здесь.

impersonalis 05.01.2008 21:06

Переделал с нуля (в том числе учёл нелюбовь Б3д к кирилице)
Код:


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()

Теперь функции нарезки сторки и формирования из нарезки картинки - разнесены

impersonalis 11.02.2008 01:09

Ответ: Text2Image
 
апд
Код:

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 не нужно)

FrankH 15.02.2008 22:25

Ответ: Text2Image
 
Если будет следующее обновление, можно ли добавить перенос строки с помощью неиспользуемого символа(например тильды или вертикальной черты), я пытался сделать это во второй версии, но не вышло.. Было бы полезно! :)

Crayzi 12.09.2010 03:08

Ответ: Text2Image
 
Это функции для написания текста на картинках? А можно писать на текстурах? :4to: Надо бы разобратся)))

impersonalis 12.09.2010 03:22

Ответ: Text2Image
 
писать в граф. буфер (картинку, текстуру, буфер экрана) можно и штатными способами. Библиотека предназначена для разбивки длинной строки на подстроки по критерию; а куда Вы направите вывод - дело Ваше.


Часовой пояс GMT +4, время: 23:16.

vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot