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

Dzirt · 10.09.2010, 18:02

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

; ************************************************************
; * 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

kostya261 · 14.04.2012, 23:35

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

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