Перенос текста
Еще одна функция связанная с текстом: перенос текста по слову\букве в новый столбец + маленькое дополнение...возможность отображенния тени текста.
Код:
; ************************************************************
; * 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
|
