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

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

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

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

Ответ
 
Опции темы
Старый 10.09.2010, 18:02   #1
Dzirt
Элита
 
Аватар для Dzirt
 
Регистрация: 16.01.2008
Сообщений: 1,800
Написано 958 полезных сообщений
(для 3,833 пользователей)
Перенос текста

Еще одна функция связанная с текстом: перенос текста по слову\букве в новый столбец + маленькое дополнение...возможность отображенния тени текста.

; ************************************************************
; * Project Name: Text Wrapp
; * Author:  Dzirt (Olexander Ponomariov)
; * Date Started: 24/04/2010
; * Last Updated: 24/04/2010
; * Website: -
; * Email: [email protected]
; * Version: 1.00
; * Product: Freeware
; ************************************************************

Graphics3D 800, 600,32,2
SetFont LoadFont("Arial Cyr", 18,0,0,0)

;Увеличте этот параметр для переноса больших текстов.
Dim FuncTextM$(100)

ClsColor 125,125,125
While Not KeyHit(1)
Cls
RenderWorld

;побуквенный перенос
TextWrapp("Привет дорогой и любимый монитор!",1,10,5,0,1)
;пословный перенос
TextWrapp("Привет дорогой и любимый монитор!",100,10,80,1,1)
;пословный перенос без тени
TextWrapp("Привет дорогой и любимый монитор!",250,10,180,1,0)

Flip
Wend
WaitKey()


;---------------------------------------------------------
;MText$ - ваш текст

;Х - начальная координата Х текста

;У - начальная координата У текста

;width - максимальная ширина текста, по достижении
;которой текст будет печататся  с новой строки

;WrappMode - 0. Для переноса побуквенно  
;                        1. Для переноса пословно(имейте введу что для коректной работы функции с 
;                           пословным переносом, параметр width - должен быть больше чем самое длинное
;                          слово в вашем тексте.)

;Shadow          - 0. Отрисовка текста без тени  
;                        1. Отрисовка текста с тенью
;---------------------------------------------------------

Function TextWrapp(MText$,x#,y#,width,WrappMode,Shadow)

;string prepare to function
MText$=MText$+" "

;get current color
red = ColorRed()
green = ColorGreen()
blue = ColorBlue()
    
;dlina stroki
FuncWidth=StringWidth(MText$)

;esli stroka bolwe chem dopustimaja wurina....    
    If FuncWidth>width
        FuncText$=MText$
        
        Numm_of_pars=(StringWidth(MText)/width)+1
        
        If Numm_of_pars>1
                For i=Len(FuncText) To 1 Step  -1
                    FuncText$=Left(FuncText,i)
                    left_width=StringWidth(FuncText)
                    If WrappMode=1
                        If left_width<width And Mid(FuncText,i,1)=" " Exit    
                    Else
                        If left_width<width Exit    
                    EndIf                    
                Next    
            If Shadow=1     
                Color 0,0,0
                Text x +1.1, y+1.1, FuncText
                Color red, green, blue
                Text x,y,""+FuncText
            Else
                Text x,y,""+FuncText    
            EndIf
    
            FuncTextM(1)=FuncText

            minus=Len(FuncTextM(1))
                For c=2 To Numm_of_pars+1
                    FuncTextM(c)=Mid(MText,minus+1,(Len(MText)-minus))

                        For i=Len(FuncTextM(c)) To 1 Step  -1
                            FuncTextM(c)=Left(FuncTextM(c),i)
                            left_width=StringWidth(FuncTextM(c))
                                If WrappMode=1
                                    If left_width<width And Mid(FuncTextM(c),i,1)=" " Exit    
                                Else    
                                    If left_width<width  Exit
                                EndIf
                            proba$=Mid(FuncTextM(c),i,1)
                        Next    
                    
                    If c=2 
                        mnoj=1
                    Else
                        mnoj=c-1
                    EndIf
                    If Shadow=1     
                        Color 0,0,0
                        Text x+1.1,(y+StringHeight(FuncTextM(1))*mnoj)+1.1,""+FuncTextM(c)
                        Color red, green, blue
                        Text x,y+StringHeight(FuncTextM(1))*mnoj,""+FuncTextM(c)
                    Else
                        Text x,y+StringHeight(FuncTextM(1))*mnoj,""+FuncTextM(c)
                    EndIf
            
                    proba$=FuncTextM(c)
                    minus=minus+Len(FuncTextM(c))
                Next
            EndIf            
    
    Else
        functext$=MText
        If Shadow=1     
            Text x,y,""+FuncText
            Color 0,0,0
            Text x +1.1, y+1.1, FuncText
            Color red, green, blue
        Else
            Text x,y,""+FuncText    
        EndIf
    EndIf
    
End Function
(Offline)
 
Ответить с цитированием
Эти 5 пользователя(ей) сказали Спасибо Dzirt за это полезное сообщение:
kostya261 (14.04.2012), mr.DIMAS (15.04.2012), Nex (10.09.2010), Randomize (11.09.2010), Sora_Musoka (08.01.2011)
Старый 14.04.2012, 23:35   #2
kostya261
AnyKey`щик
 
Регистрация: 27.08.2007
Сообщений: 17
Написано одно полезное сообщение
Ответ: Перенос текста

А вот упрощенный вариант (так сказать - консольный)


Function Print_f (x = 0, y = 0, ln$ = "", width = 80)

old = 1: now = 1: temp = 1: i = 0
For counter = now To Len (ln$)
now = Instr (ln$, " ", temp)
If width < (now - old) Then
Locate x, y + i
Print Mid$(ln$, old, temp - old-1)
old = temp: i = i + FontHeight () + 1
Else
temp = now + 1
EndIf
Next
Locate x, y + i
Print Mid$(ln$, old, temp - old-1)
End Function
(Offline)
 
Ответить с цитированием
Старый 14.04.2012, 23:37   #3
kostya261
AnyKey`щик
 
Регистрация: 27.08.2007
Сообщений: 17
Написано одно полезное сообщение
Ответ: Перенос текста

кстати как решить проблемму, что Blitz режет длинные руские строки?
(Offline)
 
Ответить с цитированием
Старый 15.04.2012, 09:02   #4
Жека
Дэвелопер
 
Регистрация: 04.09.2005
Адрес: Красноярск
Сообщений: 1,376
Написано 491 полезных сообщений
(для 886 пользователей)
Ответ: Перенос текста

Можно рисовать их побуквенно. А вообще текст в блитце тормознутый, свой рисованый шрифт лучше использовать.
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
kostya261 (15.04.2012)
Старый 15.04.2012, 14:23   #5
tormoz
Гигант индустрии
 
Аватар для tormoz
 
Регистрация: 14.12.2005
Сообщений: 2,785
Написано 1,183 полезных сообщений
(для 4,437 пользователей)
Ответ: Перенос текста

Сообщение от kostya261 Посмотреть сообщение
кстати как решить проблемму, что Blitz режет длинные руские строки?
fasttext.dll
__________________
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
kostya261 (15.04.2012)
Старый 15.04.2012, 14:28   #6
Nex
Гигант индустрии
 
Аватар для Nex
 
Регистрация: 13.09.2008
Сообщений: 2,893
Написано 1,185 полезных сообщений
(для 3,298 пользователей)
Ответ: Перенос текста

Сообщение от kostya261 Посмотреть сообщение
кстати как решить проблемму, что Blitz режет длинные руские строки?
Еще Upper и Lower не действует на кириллицу.
(Offline)
 
Ответить с цитированием
Старый 15.04.2012, 20:01   #7
kostya261
AnyKey`щик
 
Регистрация: 27.08.2007
Сообщений: 17
Написано одно полезное сообщение
Ответ: Перенос текста

Сообщение от tormoz Посмотреть сообщение
fasttext.dll
Спасибо сейчас скачаю, попробую.

Сообщение от Nex Посмотреть сообщение
Еще Upper и Lower не действует на кириллицу.
Я в использовании этих команд ограничился только для командной строки и чтения ini файлов. Пока другого применения не нашел
(Offline)
 
Ответить с цитированием
Старый 19.06.2012, 17:59   #8
Alex__Noc
Нуждающийся
 
Регистрация: 14.06.2012
Сообщений: 66
Написано 6 полезных сообщений
(для 10 пользователей)
Ответ: Перенос текста

А у меня ничего не режет - дело в кривизне рук и мозгоф!
(Offline)
 
Ответить с цитированием
Старый 05.07.2012, 15:11   #9
Alex__Noc
Нуждающийся
 
Регистрация: 14.06.2012
Сообщений: 66
Написано 6 полезных сообщений
(для 10 пользователей)
Ответ: Перенос текста

"Еще Upper и Lower не действует на кириллицу." <--- У МЕНЯ ВСЕ ДЕЙСТВУЕТ!!!
ДУМАТЬ!!!
(Offline)
 
Ответить с цитированием
Ответ


Опции темы

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

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


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


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