![](images/chestnut/misc/left.gif) |
Полезные функции Выкладываем полезные функции, чтоб не изобретать велосипед заново... |
25.12.2007, 16:39
|
#1
|
Зануда с интернетом
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений (для 20,935 пользователей)
|
Text2Image
Скрытый текст (вы должны войти под своим логином или зарегистрироваться и иметь 5 сообщение(ий)):
У вас нет прав, чтобы видеть скрытый текст, содержащийся здесь.
|
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
05.01.2008, 21:06
|
#2
|
Зануда с интернетом
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений (для 20,935 пользователей)
|
Переделал с нуля (в том числе учёл нелюбовь Б3д к кирилице)
![](images/chestnut/misc/code_html.gif)
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()
Теперь функции нарезки сторки и формирования из нарезки картинки - разнесены
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
|
(Offline)
|
|
11.02.2008, 01:09
|
#3
|
Зануда с интернетом
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений (для 20,935 пользователей)
|
Ответ: Text2Image
апд
![](images/chestnut/misc/code_html.gif)
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 не нужно)
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
Последний раз редактировалось impersonalis, 19.02.2008 в 19:24.
|
(Offline)
|
|
15.02.2008, 22:25
|
#4
|
Разработчик
Регистрация: 09.12.2007
Сообщений: 376
Написано 83 полезных сообщений (для 122 пользователей)
|
Ответ: Text2Image
Если будет следующее обновление, можно ли добавить перенос строки с помощью неиспользуемого символа(например тильды или вертикальной черты), я пытался сделать это во второй версии, но не вышло.. Было бы полезно! ![:)](images/smilies/smile.gif)
|
(Offline)
|
|
12.09.2010, 03:08
|
#5
|
ПроЭктировщик
Регистрация: 26.06.2007
Сообщений: 194
Написано 21 полезных сообщений (для 25 пользователей)
|
Ответ: Text2Image
Это функции для написания текста на картинках? А можно писать на текстурах? ![4to](images/smilies/4to.gif) Надо бы разобратся)))
|
(Offline)
|
|
12.09.2010, 03:22
|
#6
|
Зануда с интернетом
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений (для 20,935 пользователей)
|
Ответ: Text2Image
писать в граф. буфер (картинку, текстуру, буфер экрана) можно и штатными способами. Библиотека предназначена для разбивки длинной строки на подстроки по критерию; а куда Вы направите вывод - дело Ваше.
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 21:39.
|