Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для компьютеров > Blitz3D > Полезные функции

Полезные функции Выкладываем полезные функции, чтоб не изобретать велосипед заново...

Ответ
 
Опции темы
Старый 25.12.2007, 16:39   #1
impersonalis
Зануда с интернетом
 
Аватар для impersonalis
 
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений
(для 20,935 пользователей)
Text2Image

Скрытый текст (вы должны войти под своим логином или зарегистрироваться и иметь 5 сообщение(ий)):
У вас нет прав, чтобы видеть скрытый текст, содержащийся здесь.
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
Chuma (06.01.2008)
Старый 05.01.2008, 21:06   #2
impersonalis
Зануда с интернетом
 
Аватар для impersonalis
 
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений
(для 20,935 пользователей)
Переделал с нуля (в том числе учёл нелюбовь Б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()
Теперь функции нарезки сторки и формирования из нарезки картинки - разнесены
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
(Offline)
 
Ответить с цитированием
Старый 11.02.2008, 01:09   #3
impersonalis
Зануда с интернетом
 
Аватар для impersonalis
 
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений
(для 20,935 пользователей)
Ответ: 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 не нужно)
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?

Последний раз редактировалось impersonalis, 19.02.2008 в 19:24.
(Offline)
 
Ответить с цитированием
Старый 15.02.2008, 22:25   #4
FrankH
Разработчик
 
Регистрация: 09.12.2007
Сообщений: 376
Написано 83 полезных сообщений
(для 122 пользователей)
Ответ: Text2Image

Если будет следующее обновление, можно ли добавить перенос строки с помощью неиспользуемого символа(например тильды или вертикальной черты), я пытался сделать это во второй версии, но не вышло.. Было бы полезно!
(Offline)
 
Ответить с цитированием
Старый 12.09.2010, 03:08   #5
Crayzi
ПроЭктировщик
 
Регистрация: 26.06.2007
Сообщений: 194
Написано 21 полезных сообщений
(для 25 пользователей)
Ответ: Text2Image

Это функции для написания текста на картинках? А можно писать на текстурах? Надо бы разобратся)))
(Offline)
 
Ответить с цитированием
Старый 12.09.2010, 03:22   #6
impersonalis
Зануда с интернетом
 
Аватар для impersonalis
 
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений
(для 20,935 пользователей)
Ответ: Text2Image

писать в граф. буфер (картинку, текстуру, буфер экрана) можно и штатными способами. Библиотека предназначена для разбивки длинной строки на подстроки по критерию; а куда Вы направите вывод - дело Ваше.
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
Crayzi (12.09.2010)
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


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


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com