Pöyrivä teksti-Uusi versio

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
M.R
Active Member
Posts: 102
Joined: Sat Dec 22, 2007 3:05 pm

Pöyrivä teksti-Uusi versio

Post by M.R »

Löysin CoolBasic koodikirjastosta function jolla voi laittaa tekstiä vinoon.
Linkki:http://cbkk.systec.fi/koodi.php?id=142
Värkkäsin koodin kanssa ja tein pyörivän tekstin.Elikkä tässä on functiot format_rotate_text,rotate_text.

rotate_text:

Kuvaus:
Tekee pyörivän tekstin.

Käyttö:
rotate_text(x,y,txt$="",speed=1)

x=Tekstin x sijaintiy=Tekstin y sijaintitxt$=Pyörivä teksti
speed=nopeus oletus on 1(hidas)

Tarvittavat määrittelyt:
Liitä nämä koodin alkuun:

Code: Select all

Type Text360Img
    Field id    'numero, jolla tekstiin voidaan viitata
    Field img   'kuva, johon teksti on piirretty oikeassa kulmassa
    Field x     '|koordinaatit, joihin kuvan keskipisteen tulee osua
    Field y     '|
End Type

Global luku
luku=0
Functio:

Code: Select all

Function rotate_text(x,y,txt$="",speed=1)

//Päivitetään kääntyvyys
luku=luku+speed
angle=luku

//Itse teksti
     If y=0 And txt="" And angle=0.0 Then 'tarkistetaan, syöttääkö käyttäjä jo luodun tekstin id:n vaiko kokonaan uuden tekstin
        t.Text360Img = ConvertToType(x)
        DrawImage t\img, t\x,t\y 'piirretään vanha teksti
    Else
        t.Text360Img = New(Text360Img) 'luodaan uusi teksti
        w = TextWidth(txt)
        h = TextHeight(txt)
        img = MakeImage(w,h)
        DrawToImage img 'teksti piirretään ensin kuvaan, joka...
        Text 0,0, txt
        DrawToScreen
        RotateImage img, angle '...käännetään oikeaan kulmaan
        t\id = ConvertToInteger(t)
        t\img = img
        t\x = x+Cos(angle)*ImageWidth(img)/2    '|lasketaan koordinaatit, joihin kuvan keskipisteen
        t\y = y+Sin(angle)*ImageHeight(img)/2   '|tulee osua.
        DrawImage img, t\x,t\y
        EndIf
        
EndFunction //Lopetetaan functio
Esimerkki:

Code: Select all


//Type ja muuttuja määrittelyt
Type Text360Img
    Field id    'numero, jolla tekstiin voidaan viitata
    Field img   'kuva, johon teksti on piirretty oikeassa kulmassa
    Field x     '|koordinaatit, joihin kuvan keskipisteen tulee osua
    Field y     '|
End Type

Global luku
luku=0


//Esimerkkiohjelma
FrameLimit 15
big=LoadFont("arial black",40)
lit=LoadFont("arial black",25)
format_rotate_text()
Color 255,0,0
nopeus=0
Repeat
nopeus+1
SetFont big
rotate_text(ScreenWidth()/2,ScreenHeight()/2,"Testi1",nopeus)
SetFont lit
rotate_text(75,75,"Testi2",nopeus/3)
DrawScreen
Until nopeus=85


Function format_rotate_text(soft=1)
If soft=1 Then Smooth2D ON
If soft=0 Then Smooth2D OFF
EndFunction


Function rotate_text(x,y,txt$="",speed=1)

//Päivitetään kääntuvyys
luku=luku+speed
angle=luku

//Itse teksti
     If y=0 And txt="" And angle=0.0 Then 'tarkistetaan, syöttääkö käyttäjä jo luodun tekstin id:n vaiko kokonaan uuden tekstin
        t.Text360Img = ConvertToType(x)
        DrawImage t\img, t\x,t\y 'piirretään vanha teksti
    Else
        t.Text360Img = New(Text360Img) 'luodaan uusi teksti
        w = TextWidth(txt)
        h = TextHeight(txt)
        img = MakeImage(w,h)
        DrawToImage img 'teksti piirretään ensin kuvaan, joka...
        Text 0,0, txt
        DrawToScreen
        RotateImage img, angle '...käännetään oikeaan kulmaan
        t\id = ConvertToInteger(t)
        t\img = img
        t\x = x+Cos(angle)*ImageWidth(img)/2    '|lasketaan koordinaatit, joihin kuvan keskipisteen
        t\y = y+Sin(angle)*ImageHeight(img)/2   '|tulee osua.
        DrawImage img, t\x,t\y
        EndIf
        
EndFunction //Lopetetaan functio


format_rotate_text:

Kuvaus:
Alustaa Pyöritettävät tekstit
Kannattaa käyttää muuten tekstistä tulee huonolaatuista

Käyttö:
format_rotate_text(soft=1)

soft=Pehmennetäänkö tekstiä jos 1 niin pehmennetään(oletus)(suositus) jos 0 ei pehmennetä

Functio:

Code: Select all

Function format_rotate_text(soft=1)
If soft=1 Then Smooth2D ON
If soft=0 Then Smooth2D OFF
EndFunction
Esimerkki

katso rotate_text function esimerkki
EDIT:

Uutta versiota ollaan tekemässä.

EDIT:

Uusi versio on valmis.Ohjeet löytyvät koodista.

Code: Select all

Const MaxRotateTexts=10 //Maksimissaan pyöriviä tekstejä(huom yksi enemmän kuin vakio on).Muuta tarpeen mukaan.
Dim RotateTexts(360,MaxRotateTexts) //Taulukko muhin pyörivät tekstit tallennetaan.
Dim RotateTextsData(MaxRotateTexts,1) //Taulukko mihin tallenneetaan tiedot pyörivistä teksteistä.

//Tämä funktio luo pyörivän tekstin.Tekstin väriksi tulee nykyinen piirtoväri.
//HUOM BUGI!Jos tekstistä jää osa pois niin pane perään välilyöntejä.
//Parametrit:
//id=ID jolle teksti halutaan luoda.ID:n pitää olla nollan ja vakion MaxRotateText välillä(tai jompi kumpi).
//_text$=Teksti.Merkkijono.
//speed=Oletus nopeus.
//offset=Kohta mistä teksti lähtee pyörimään.Oletuksena 0.
//br,bg,bb=Tausta värin RGB komponentit(tai värivakio).Oletuksena on musta(0,0,0).
//mr,mg,mb=Maskivärin RGB komponentit(tai värivakio).Oletuksena on musta(0,0,0).


Function CreateRotateText(id,_text$,speed,offset=0,br=0,bg=0,bb=0,mr=0,mg=0,mb=0)
    img=MakeImage(TextWidth(_text$),TextHeight(_text$))
    DrawToImage img
    oldr=getRGB(RED)
    oldg=getRGB(GREEN)
    oldb=getRGB(BLUE)
    Color br,bg,bb
    Box 0,0,TextWidth(_text$),TextHeight(_text$)
    Color oldr,oldg,oldb
    Text 0,0,_text$
    DrawToScreen
    MaskImage img,mr,mg,mb
    HotSpot img,TextWidth(_text$)/2,TextHeight(_text$)/2
    RotateTexts(0,id)=img
    RotateTextsData(id,0)=speed
    RotateTextsData(id,1)=offset
    For i=1 To 360
        RotateTexts(i,id)=CloneImage(img)
        angle#=i
        If angle#=90 Or 180 Or 270 Then angle#=angle#+0.1
        RotateImage RotateTexts(i,id),angle#
        MaskImage RotateTexts(i,id),mr,mg,mb
    Next i
EndFunction


//Tämä funktio päivittää pyörivän tekstin(ja piirtää).
//Parametrit:
//id=Tekstin id.
//x,y=X ja Y koordinaatit.
//speed=Nopeus.Jos on 0 niin käytetään funktiolle annettua(oletuksena on).

Function UpdateRotateText(id,x,y,speed=0)
    If speed=0 Then speed=RotateTextsData(id,0)
    RotateTextsData(id,1)=Int(WrapAngle(RotateTextsData(id,1)+speed))
    DrawImage RotateTexts(RotateTextsData(id,1),id),x,y
EndFunction


//Esimerkki

Print "Ladataan"

SetFont LoadFont("arial",26,ON)
Color 0,255,0
CreateRotateText(0,"Tämä teksti pyörii.   ",3)
Color cbCyan
SetFont LoadFont("arial",16,ON)
CreateRotateText(1,"No kokeileppa saman tien hiiren rullaa.",1,0,0,0,255)
Repeat
    UpdateRotateText(0,200,150)
    UpdateRotateText(1,MouseX(),MouseY(),MouseZ())
    DrawScreen
Forever
[/edit]
Last edited by M.R on Sat Mar 08, 2008 5:34 pm, edited 6 times in total.
User avatar
valscion
Moderator
Moderator
Posts: 1599
Joined: Thu Dec 06, 2007 7:46 pm
Location: Espoo
Contact:

Re: Pöyrivä teksti

Post by valscion »

Voisitko tehdä yhden kokonaisen esimerkkiohjelman, jossa käytettäisiin noita molempia funktioita?
cbEnchanted, uudelleenkirjoitettu runtime. Uusin versio: 0.4.1 — Nyt myös sorsat GitHubissa!
NetMatch - se kunnon nettimättö-deathmatch! Avoimella lähdekoodilla varustettu
vesalaakso.com
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Pöyrivä teksti

Post by MaGetzUb »

En testannut koodia, mutta muodostin siitä mielikuvan. ROTATEIMAGE on aika turha komento koska se vie niin julmasti tehoja, en suosittele sitä käytettävän. Tee mieluummin joku oma funktio kuvan pyörittämiseen.
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Pöyrivä teksti

Post by koodaaja »

programmer of DSG wrote:En testannut koodia, mutta muodostin siitä mielikuvan. ROTATEIMAGE on aika turha komento koska se vie niin julmasti tehoja, en suosittele sitä käytettävän. Tee mieluummin joku oma funktio kuvan pyörittämiseen.
Oma, vielä puolet hitaampi funktio, tarkoittanet. Kyllä se paras tapa on taulukkoon laskea ohjelman alussa kaikki tällaiset. Ja jos joku keksii nopean tekstuurivenytys- ja pyöritystavan (parikymmentä venyvää ja vanuvaa sekä pyörivää kuvaa edes n. 30 FPS:llä), saisi kernaasti näyttää - mahdollistaisi vallan uusia asioita CB-rintamalla.
M.R
Active Member
Posts: 102
Joined: Sat Dec 22, 2007 3:05 pm

Re: Pöyrivä teksti

Post by M.R »

OonSuomesta wrote:Voisitko tehdä yhden kokonaisen esimerkkiohjelman, jossa käytettäisiin noita molempia funktioita?
rotate_text function esimerkki ohjelmassa käytetään functiota format_rotate_text.
format_rotate_text functio lähinnä helpottaa aloittelioita se vaan kytkee Smooth2D päälle tai pois.
koodaaja wrote:
programmer of DSG wrote:En testannut koodia, mutta muodostin siitä mielikuvan. ROTATEIMAGE on aika turha komento koska se vie niin julmasti tehoja, en suosittele sitä käytettävän. Tee mieluummin joku oma funktio kuvan pyörittämiseen.
Oma, vielä puolet hitaampi funktio, tarkoittanet. Kyllä se paras tapa on taulukkoon laskea ohjelman alussa kaikki tällaiset. Ja jos joku keksii nopean tekstuurivenytys- ja pyöritystavan (parikymmentä venyvää ja vanuvaa sekä pyörivää kuvaa edes n. 30 FPS:llä), saisi kernaasti näyttää - mahdollistaisi vallan uusia asioita CB-rintamalla.

Itse teksti functio on alun perin muokattu Text360 functiosta jota en ole tehnyt vaan Jare.
Linkki:http://cbkk.systec.fi/koodi.php?id=142
M.R
Active Member
Posts: 102
Joined: Sat Dec 22, 2007 3:05 pm

Re: Pöyrivä teksti

Post by M.R »

Tein uuden version joka on paljon nopeampi mutta voi käyttää yhtä tekstiä kerrallaan.

Määrittelyt(laita ohjelman alkuun):

Code: Select all

Type Text360Img
    Field id    'numero, jolla tekstiin voidaan viitata
    Field img   'kuva, johon teksti on piirretty oikeassa kulmassa
    Field x     '|koordinaatit, joihin kuvan keskipisteen tulee osua
    Field y     '|
End Type
Global cangle
Global tx,ty,ts
cangle=0
Dim rotate_text(360)
creat_rotate_text:

Kuvaus:
Tämä functio luo tekstin muistiin.

Käyttö:
creat_rotate_text(x,y,txt$,speed=2)

x=tekstin x sijainti
y=tekstin y sijainti
txt$=teksti
speed=nopeus(astetta päivittämis kerralla) (oletus on 2)

Esimerkki:

Code: Select all

//Määrittelyt
Type Text360Img
    Field id    'numero, jolla tekstiin voidaan viitata
    Field img   'kuva, johon teksti on piirretty oikeassa kulmassa
    Field x     '|koordinaatit, joihin kuvan keskipisteen tulee osua
    Field y     '|
End Type
Global cangle
Global tx,ty,ts
cangle=0
Dim rotate_text(360)


//Esimerkki
SetFont LoadFont("arial",45,ON)
creat_rotate_text(ScreenWidth()/2,ScreenHeight()/2,"Testi")
nopeus#=0
Repeat
nopeus#+0.1
update_rotate_text(Int(nopeus#)/2)
DrawScreen
Until Int(nopeus#)=25


//Functiot
Function creat_rotate_text(x,y,txt$,speed=2)
        tx=x
        ty=y
        ts=speed
    
        For angle=0 To 360
        t.Text360Img = New(Text360Img) 'luodaan uusi teksti
        w = TextWidth(txt)
        h = TextHeight(txt)
        img = MakeImage(w,h)
        DrawToImage img 'teksti piirretään ensin kuvaan, joka...
        Text 0,0, txt
        DrawToScreen
        RotateImage img, angle '...käännetään oikeaan kulmaan
        t\id = ConvertToInteger(t)
        t\img = img
        t\x = x+Cos(angle)*ImageWidth(img)/2    '|lasketaan koordinaatit, joihin kuvan keskipisteen
        t\y = y+Sin(angle)*ImageHeight(img)/2   '|tulee osua.
        rotate_text(angle)=img
        Next angle

EndFunction//Lopetetaan functio

Function update_rotate_text(speed=1000)
If speed=1000 Then speed=ts
cangle+speed
If cangle>360 Then cangle=0
DrawImage rotate_text(cangle),tx,ty
EndFunction
Functio:

Code: Select all

Function creat_rotate_text(x,y,txt$,speed=2)
        tx=x
        ty=y
        ts=speed
    
        For angle=0 To 360
        t.Text360Img = New(Text360Img) 'luodaan uusi teksti
        w = TextWidth(txt)
        h = TextHeight(txt)
        img = MakeImage(w,h)
        DrawToImage img 'teksti piirretään ensin kuvaan, joka...
        Text 0,0, txt
        DrawToScreen
        RotateImage img, angle '...käännetään oikeaan kulmaan
        t\id = ConvertToInteger(t)
        t\img = img
        t\x = x+Cos(angle)*ImageWidth(img)/2    '|lasketaan koordinaatit, joihin kuvan keskipisteen
        t\y = y+Sin(angle)*ImageHeight(img)/2   '|tulee osua.
        rotate_text(angle)=img
        Next angle

EndFunction//Lopetetaan functio
update_rotate_text:

Kuvaus:

Päivittää pyörivän tekstin.
Teksti kääntyy niin monta astetta kuin nopeus on.

Käyttö:

update_rotate_text(speed=1000)

speed=nopeus(jos on 1000 niin käytetään oletus nopeutta joka annettiin tekstille creat_rotate_text functiolla)(oletus=1000)

Esimerkki:

Code: Select all

//Määrittelyt
Type Text360Img
    Field id    'numero, jolla tekstiin voidaan viitata
    Field img   'kuva, johon teksti on piirretty oikeassa kulmassa
    Field x     '|koordinaatit, joihin kuvan keskipisteen tulee osua
    Field y     '|
End Type
Global cangle
Global tx,ty,ts
cangle=0
Dim rotate_text(360)


//Esimerkki
SetFont LoadFont("arial",45,ON)
creat_rotate_text(ScreenWidth()/2,ScreenHeight()/2,"Testi")
nopeus#=0
Repeat
nopeus#+0.1
update_rotate_text(Int(nopeus#)/2)
DrawScreen
Until Int(nopeus#)=25



Function creat_rotate_text(x,y,txt$,speed=2)
        tx=x
        ty=y
        ts=speed
    
        For angle=0 To 360
        t.Text360Img = New(Text360Img) 'luodaan uusi teksti
        w = TextWidth(txt)
        h = TextHeight(txt)
        img = MakeImage(w,h)
        DrawToImage img 'teksti piirretään ensin kuvaan, joka...
        Text 0,0, txt
        DrawToScreen
        RotateImage img, angle '...käännetään oikeaan kulmaan
        t\id = ConvertToInteger(t)
        t\img = img
        t\x = x+Cos(angle)*ImageWidth(img)/2    '|lasketaan koordinaatit, joihin kuvan keskipisteen
        t\y = y+Sin(angle)*ImageHeight(img)/2   '|tulee osua.
        rotate_text(angle)=img
        Next angle

EndFunction//Lopetetaan functio

Function update_rotate_text(speed=1000)
If speed=1000 Then speed=ts
cangle+speed
If cangle>360 Then cangle=0
DrawImage rotate_text(cangle),tx,ty
EndFunction
Functio:

Code: Select all

Function update_rotate_text(speed=1000)
If speed=1000 Then speed=ts
cangle+speed
If cangle>360 Then cangle=0
DrawImage rotate_text(cangle),tx,ty
EndFunction
Marcoder
Active Member
Posts: 120
Joined: Tue Aug 28, 2007 8:21 am

Re: Pöyrivä teksti

Post by Marcoder »

Miksei ihan yksinkertaisesti vaikka näin?

Code: Select all

fnt = LoadFont("Arial", 40)
SetFont fnt
obj = CreateRotateText("Testi")

Repeat
    TurnObject obj, -5
    DrawScreen
Forever

Function CreateRotateText(_txt$)
    w = TextWidth(_txt)
    h = TextHeight(_txt)
    img = MakeImage(w, h)
    DrawToImage img
    Text 0, 0, _txt
    DrawToScreen
    obj = MakeObject(72)
    PaintObject obj, -img
    Return obj
EndFunction
M.R
Active Member
Posts: 102
Joined: Sat Dec 22, 2007 3:05 pm

Re: Pöyrivä teksti

Post by M.R »

Marcoder wrote:Miksei ihan yksinkertaisesti vaikka näin?

Code: Select all

koodia...
Kyllähän sen noinkin voi tehdä mutta sillä ei saa tekstiä tilekartan over kerroksen päälle...
M.R
Active Member
Posts: 102
Joined: Sat Dec 22, 2007 3:05 pm

Re: Pöyrivä teksti-Uusi versio

Post by M.R »

Uusi versio ulkona.Tarkempaa tietoa ensinmäisestä viestistä.
Post Reply