CoolBasic Forums

Posted: **Fri Jul 01, 2011 8:54 am**

Wingman wrote:

Kille wrote:Teinpä tällaisen ratasfunktion, jolla siis piirretään hammasrattaita. Tässä olisi funktio+esimerkki. Saa käyttää!

Code: Select all

//RATASEFEKTI by Ville "Kille" Valtiala
//saa käyttää vapaasti 

//Funktio + esimerkki

FrameLimit 40

SCREEN 400,300,0,1
Global sw
Global sh
sw=ScreenWidth()
sh=ScreenHeight()

Global kulma As Float
kulma=0



ClsColor 0,0,0


Repeat

maassa=0
Tormays=0

Color 50,50,50

gear(0,0,16,150,200,3,kulma/2)
gear(0+(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0+(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)

Color 100,100,100

gear(-100,-100,7,20,25,3,kulma*4)
gear(-100,-145,7,20,25,3,-1*kulma*4+22)
gear(-100+(Sin(45)*45),-100+(Sin(45)*45) ,7,20,25,3,-1*kulma*4+12)

Color 200,200,200

tormays=tormays+gear(0,0,8,40,60,3,kulma)
tormays=tormays+gear(100,0,8,40,60,3,-1*kulma)
tormays=tormays+gear(0,100,8,40,60,3,-1*kulma)




Text 1,1,FPS()


DrawScreen

ClearText 
kulma=kulma+1
If kulma>359 Then kulma=0




Forever



//Funktio:
//käyttö: gear(x, y, hampaiden määrä, sisäkehän säde, ulkokehän säde, hampaiden sivujen kulma, rattaan kulma)

Function gear(x,y,hammas#,minrad,maxrad,pres,ang#)
x=x+sw/2
y=y+sh/2
hammas=hammas*2
hammasväli#=360.00/hammas

For i=1 To hammas-1 Step 2

tormays=0

Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i+pres)*maxrad+x,Cos(ang-hammasväli*i+pres)*maxrad+y
Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-hammasväli)*minrad+x,Cos(ang-hammasväli*i-hammasväli)*minrad+y

Next i

For i=2 To hammas Step 2

Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y
Line Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y

Next i



End Function

joo ja on huonosti sisennetty

vielä kun saisit rattaiden sisäosat kokonaan mustiksi niin olisi hyvä, nyt rattaat näkyvät toistensa takaa

Ei mikään simppeli homma näin äkkiseltään ole ruveta noita rattaita fillaamaan värillä. Mutta kaikista keskimmäisen osanhan voisi täyttää Circlellä ja sitten hampaat voisi täyttää Trifillerillä

Posted: **Fri Jul 01, 2011 9:55 am**

Tulin tänne taas häriköimään.

Ratasefekti oli hieno ja aloin leikkiä sillä. Vahingossa huomasin tehneeni efektin. Kun sitä vähän hioi niin ihan mukavahan siitä tuli.

Code: Select all

    FrameLimit 40

    SCREEN 400,300,0,1

    ClsColor 0,0,0

    Repeat
    Color cbwhite
    Text 1,1,FPS()
    Color r,g,b
gear(200,150,10,50,100,kulma,kulma)
 r = r+1
  g = g+2
    b = b+3
If KeyHit(28) Then 
   If mode = 1 Then 
      mode = 0
   Else 
      mode = 1
   EndIf 
EndIf 
If mode = 0 Then 
    DrawScreen OFF 
   Else 
    DrawScreen 
EndIf 

    ClearText
    kulma=kulma+1
    If kulma>359 Then kulma=0

    Forever



   
    Function gear(x,y,hammas#,minrad,maxrad,pres,ang#)
    x=x+sw/2
    y=y+sh/2
    hammas=hammas*2
    hammasväli#=360.00/hammas

    For i=1 To hammas-1 Step 2

    tormays=0

    Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i+pres)*maxrad+x,Cos(ang-hammasväli*i+pres)*maxrad+y
    Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-hammasväli)*minrad+x,Cos(ang-hammasväli*i-hammasväli)*minrad+y

    Next i

    For i=2 To hammas Step 2

    Line Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y
    Line Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y

    Next i



    End Function

Kaksi moodia. Enteristä vaihtaa.

Posted: **Fri Jul 01, 2011 12:10 pm**

MaGetzUb wrote: Ei mikään simppeli homma näin äkkiseltään ole ruveta noita rattaita fillaamaan värillä. Mutta kaikista keskimmäisen osanhan voisi täyttää Circlellä ja sitten hampaat voisi täyttää Trifillerillä

Hyvä idea! Tässä olisi:

Code: Select all

//RATASEFEKTI by "Kille"
//saa käyttää vapaasti 

//Funktio + esimerkki

'FrameLimit 40
SCREEN 800,600,0,1
SCREEN 400,300,0,2
Global sw
Global sh
sw=ScreenWidth()
sh=ScreenHeight()

Global kulma As Float
kulma=0



ClsColor 0,0,0


Repeat



Color 50,50,50

gear(0,0,16,150,200,3,kulma/2)
gear(0+(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0+(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)

Color 100,100,100

gear(-100,-100,7,20,25,3,kulma*4)
gear(-100,-145,7,20,25,3,-1*kulma*4+22)
gear(-100+(Sin(45)*45),-100+(Sin(45)*45) ,7,20,25,3,-1*kulma*4+12)

Color 200,200,200

gear(0,0,8,40,60,3,kulma)
gear(100,0,8,40,60,3,-1*kulma)
gear(0,100,8,40,60,3,-1*kulma)



Text 1,1,FPS()


DrawScreen

ClearText 
kulma=kulma+1
If kulma>359 Then kulma=0




Forever



//Funktio:
//käyttö: gear(x, y, hampaiden määrä, sisäkehän säde, ulkokehän säde, hampaiden sivujen kulma, rattaan kulma)

Function gear(x,y,hammas#,minrad,maxrad,pres,ang#)
x=x+sw/2
y=y+sh/2
hammas=hammas*2
hammasväli#=360.00/hammas

For i=1 To hammas-1 Step 2

Circle x-minrad,y-minrad,minrad*2+1,1

Next i

Lock

For i=2 To hammas Step 2

trifiller(Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-hammasväli)*minrad+x,Cos(ang-hammasväli*i-hammasväli)*minrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y)
trifiller(Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y,Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y)

Next i

Unlock

End Function 

//trifiller by Atomimalli
Function trifiller(x1,y1,x2,y2,x3,y3) 'kolmion kärkipisteet p1, p2, p3
   'järjestetään pisteet y koordinaatin perusteella
   If y2<y1 Then 'jos p2 on ylempänä kuin p1 vaihdetaan niiden paikkaa
       tmp=y1
       y1=y2
       y2=tmp
       
       tmp=x1
       x1=x2
       x2=tmp
   EndIf
   
   If y3<y1 Then 'jos p3 on ylempänä kuin p1 vaihdetaan niiden paikkaa
       tmp=y1
       y1=y3
       y3=tmp
       
       tmp=x1
       x1=x3
       x3=tmp
   EndIf
   
   If y3<y2 Then 'jos p3 on lempänä kuin p2 vaihdetaan niiden paikkaa
       tmp=y2
       y2=y3
       y3=tmp
       
       tmp=x2
       x2=x3
       x3=tmp
   EndIf
   
   'pisteet ovat nyt järjestyksessä
   'ylhäältä alas p1(x1,y1), p2(x2,y2), p3(x3,y3)
   
   dy1=y2-y1'pystysuora matka p1:sta p2:seen
   dx1=x2-x1'vaakasuora matka p1:sta p2:seen
   
   dy2=y3-y1'pystysuora matka p1:sta p3:meen
   dx2=x3-x1'vaakasuora matka p1:sta p3:meen
   
   If dy1 Then 'jos kolmion yläosa on pidempi kuin 0
       'käydään läpi kaikki vaakaviivat kolmion yläosassa(p1-p2)
       For i = y1 To y2
           'lasketaan seuraava x-koordinaatti p1:stä p2:seen
           ax=x1+((i-y1)*dx1)/dy1
           'lasketaan seuraava x-koordinaatti p1:stä p3:meen
           bx=x1+((i-y1)*dx2)/dy2
           
           Line ax,i,bx,i 'piirretään viiva kolmion reunojen välille
       Next i
   EndIf
   
   dy1=y3-y2'pystysuora matka p2:sta p3:meen
   dx1=x3-x2'vaakasuora matka p2:sta p3:meen
   
   If dy1 Then 'jos kolmion alaosa on pidempi kuin 0
       'käydään läpi kaikki vaakaviivat kolmion alaosassa(p2-p3)
       For i = y2 To y3
           'lasketaan seuraava x-koordinaatti p2:stä p3:meen
           ax=x2+((i-y2)*dx1)/dy1
           'lasketaan seuraava x-koordinaatti p1:stä p3:meen
           bx=x1+((i-y1)*dx2)/dy2
           
           Line ax,i,bx,i 'piirretään viiva kolmion reunojen välille
       Next i
   EndIf
End Function

Toimii siis atomimallin trifillerillä.

Posted: **Fri Jul 01, 2011 2:23 pm**

Kille wrote:Hyvä idea! Tässä olisi...

Pieni optimointi:

Code: Select all

//RATASEFEKTI by "Kille"
//saa käyttää vapaasti 

//Funktio + esimerkki

'FrameLimit 40
SCREEN 800,600,0,1
SCREEN 400,300,0,2
Global sw
Global sh
sw=ScreenWidth()
sh=ScreenHeight()

Global kulma As Float
kulma=0



ClsColor 0,0,0


Repeat



Color 50,50,50

gear(0,0,16,150,200,3,kulma/2)
gear(0+(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0+(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)

Color 100,100,100

gear(-100,-100,7,20,25,3,kulma*4)
gear(-100,-145,7,20,25,3,-1*kulma*4+22)
gear(-100+(Sin(45)*45),-100+(Sin(45)*45) ,7,20,25,3,-1*kulma*4+12)

Color 200,200,200

gear(0,0,8,40,60,3,kulma)
gear(100,0,8,40,60,3,-1*kulma)
gear(0,100,8,40,60,3,-1*kulma)



Text 1,1,FPS()


DrawScreen

ClearText 
kulma=kulma+1
If kulma>359 Then kulma=0




Forever



//Funktio:
//käyttö: gear(x, y, hampaiden määrä, sisäkehän säde, ulkokehän säde, hampaiden sivujen kulma, rattaan kulma)

Function gear(x,y,hammas#,minrad,maxrad,pres,ang#)
x=x+sw/2
y=y+sh/2
hammas=hammas*2
hammasväli#=360.00/hammas

Circle x-minrad,y-minrad,minrad*2+1,1


Lock

For i=2 To hammas Step 2

trifiller(Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-hammasväli)*minrad+x,Cos(ang-hammasväli*i-hammasväli)*minrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y)
trifiller(Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y,Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y)

Next i

Unlock

End Function 

//trifiller by Atomimalli
Function trifiller(x1,y1,x2,y2,x3,y3) 'kolmion kärkipisteet p1, p2, p3
   'järjestetään pisteet y koordinaatin perusteella
   If y2<y1 Then 'jos p2 on ylempänä kuin p1 vaihdetaan niiden paikkaa
       tmp=y1
       y1=y2
       y2=tmp
       
       tmp=x1
       x1=x2
       x2=tmp
   EndIf
   
   If y3<y1 Then 'jos p3 on ylempänä kuin p1 vaihdetaan niiden paikkaa
       tmp=y1
       y1=y3
       y3=tmp
       
       tmp=x1
       x1=x3
       x3=tmp
   EndIf
   
   If y3<y2 Then 'jos p3 on lempänä kuin p2 vaihdetaan niiden paikkaa
       tmp=y2
       y2=y3
       y3=tmp
       
       tmp=x2
       x2=x3
       x3=tmp
   EndIf
   
   'pisteet ovat nyt järjestyksessä
   'ylhäältä alas p1(x1,y1), p2(x2,y2), p3(x3,y3)
   
   dy1=y2-y1'pystysuora matka p1:sta p2:seen
   dx1=x2-x1'vaakasuora matka p1:sta p2:seen
   
   dy2=y3-y1'pystysuora matka p1:sta p3:meen
   dx2=x3-x1'vaakasuora matka p1:sta p3:meen
   
   If dy1 Then 'jos kolmion yläosa on pidempi kuin 0
       'käydään läpi kaikki vaakaviivat kolmion yläosassa(p1-p2)
       For i = y1 To y2
           'lasketaan seuraava x-koordinaatti p1:stä p2:seen
           ax=x1+((i-y1)*dx1)/dy1
           'lasketaan seuraava x-koordinaatti p1:stä p3:meen
           bx=x1+((i-y1)*dx2)/dy2
           
           Line ax,i,bx,i 'piirretään viiva kolmion reunojen välille
       Next i
   EndIf
   
   dy1=y3-y2'pystysuora matka p2:sta p3:meen
   dx1=x3-x2'vaakasuora matka p2:sta p3:meen
   
   If dy1 Then 'jos kolmion alaosa on pidempi kuin 0
       'käydään läpi kaikki vaakaviivat kolmion alaosassa(p2-p3)
       For i = y2 To y3
           'lasketaan seuraava x-koordinaatti p2:stä p3:meen
           ax=x2+((i-y2)*dx1)/dy1
           'lasketaan seuraava x-koordinaatti p1:stä p3:meen
           bx=x1+((i-y1)*dx2)/dy2
           
           Line ax,i,bx,i 'piirretään viiva kolmion reunojen välille
       Next i
   EndIf
End Function

Posted: **Fri Jul 01, 2011 6:56 pm**

Joo hyvä huomio, jäi tosiaan vahingossa ylimääräinen for...next-looppi tuonne

Posted: **Sat Jul 02, 2011 7:54 pm**

Kille wrote:

MaGetzUb wrote: Ei mikään simppeli homma näin äkkiseltään ole ruveta noita rattaita fillaamaan värillä. Mutta kaikista keskimmäisen osanhan voisi täyttää Circlellä ja sitten hampaat voisi täyttää Trifillerillä

Hyvä idea! Tässä olisi:

Code: Select all

//RATASEFEKTI by "Kille"
//saa käyttää vapaasti 

//Funktio + esimerkki

'FrameLimit 40
SCREEN 800,600,0,1
SCREEN 400,300,0,2
Global sw
Global sh
sw=ScreenWidth()
sh=ScreenHeight()

Global kulma As Float
kulma=0



ClsColor 0,0,0


Repeat



Color 50,50,50

gear(0,0,16,150,200,3,kulma/2)
gear(0+(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0+(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0+(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)
gear(0-(Sin(45)*350),0-(Sin(45)*350),16,150,200,3,-1*kulma/2)

Color 100,100,100

gear(-100,-100,7,20,25,3,kulma*4)
gear(-100,-145,7,20,25,3,-1*kulma*4+22)
gear(-100+(Sin(45)*45),-100+(Sin(45)*45) ,7,20,25,3,-1*kulma*4+12)

Color 200,200,200

gear(0,0,8,40,60,3,kulma)
gear(100,0,8,40,60,3,-1*kulma)
gear(0,100,8,40,60,3,-1*kulma)



Text 1,1,FPS()


DrawScreen

ClearText 
kulma=kulma+1
If kulma>359 Then kulma=0




Forever



//Funktio:
//käyttö: gear(x, y, hampaiden määrä, sisäkehän säde, ulkokehän säde, hampaiden sivujen kulma, rattaan kulma)

Function gear(x,y,hammas#,minrad,maxrad,pres,ang#)
x=x+sw/2
y=y+sh/2
hammas=hammas*2
hammasväli#=360.00/hammas

For i=1 To hammas-1 Step 2

Circle x-minrad,y-minrad,minrad*2+1,1

Next i

Lock

For i=2 To hammas Step 2

trifiller(Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y,Sin(ang-hammasväli*i-hammasväli)*minrad+x,Cos(ang-hammasväli*i-hammasväli)*minrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y)
trifiller(Sin(ang-hammasväli*i-pres)*maxrad+x,Cos(ang-hammasväli*i-pres)*maxrad+y,Sin(ang-hammasväli*i-hammasväli+pres)*maxrad+x,Cos(ang-hammasväli*i-hammasväli+pres)*maxrad+y,Sin(ang-hammasväli*i)*minrad+x,Cos(ang-hammasväli*i)*minrad+y)

Next i

Unlock

End Function 

//trifiller by Atomimalli
Function trifiller(x1,y1,x2,y2,x3,y3) 'kolmion kärkipisteet p1, p2, p3
   'järjestetään pisteet y koordinaatin perusteella
   If y2<y1 Then 'jos p2 on ylempänä kuin p1 vaihdetaan niiden paikkaa
       tmp=y1
       y1=y2
       y2=tmp
       
       tmp=x1
       x1=x2
       x2=tmp
   EndIf
   
   If y3<y1 Then 'jos p3 on ylempänä kuin p1 vaihdetaan niiden paikkaa
       tmp=y1
       y1=y3
       y3=tmp
       
       tmp=x1
       x1=x3
       x3=tmp
   EndIf
   
   If y3<y2 Then 'jos p3 on lempänä kuin p2 vaihdetaan niiden paikkaa
       tmp=y2
       y2=y3
       y3=tmp
       
       tmp=x2
       x2=x3
       x3=tmp
   EndIf
   
   'pisteet ovat nyt järjestyksessä
   'ylhäältä alas p1(x1,y1), p2(x2,y2), p3(x3,y3)
   
   dy1=y2-y1'pystysuora matka p1:sta p2:seen
   dx1=x2-x1'vaakasuora matka p1:sta p2:seen
   
   dy2=y3-y1'pystysuora matka p1:sta p3:meen
   dx2=x3-x1'vaakasuora matka p1:sta p3:meen
   
   If dy1 Then 'jos kolmion yläosa on pidempi kuin 0
       'käydään läpi kaikki vaakaviivat kolmion yläosassa(p1-p2)
       For i = y1 To y2
           'lasketaan seuraava x-koordinaatti p1:stä p2:seen
           ax=x1+((i-y1)*dx1)/dy1
           'lasketaan seuraava x-koordinaatti p1:stä p3:meen
           bx=x1+((i-y1)*dx2)/dy2
           
           Line ax,i,bx,i 'piirretään viiva kolmion reunojen välille
       Next i
   EndIf
   
   dy1=y3-y2'pystysuora matka p2:sta p3:meen
   dx1=x3-x2'vaakasuora matka p2:sta p3:meen
   
   If dy1 Then 'jos kolmion alaosa on pidempi kuin 0
       'käydään läpi kaikki vaakaviivat kolmion alaosassa(p2-p3)
       For i = y2 To y3
           'lasketaan seuraava x-koordinaatti p2:stä p3:meen
           ax=x2+((i-y2)*dx1)/dy1
           'lasketaan seuraava x-koordinaatti p1:stä p3:meen
           bx=x1+((i-y1)*dx2)/dy2
           
           Line ax,i,bx,i 'piirretään viiva kolmion reunojen välille
       Next i
   EndIf
End Function

Toimii siis atomimallin trifillerillä.

Hehe, se oli sittenkin aika simppeli homma.

Posted: **Mon Jul 04, 2011 6:51 pm**

Sori tuplaposti. Tein tämmöisen helpohkon tunneliefektin:

Code: Select all

Const SW = 640
Const SH = 480
SCREEN SW, SH

Repeat
    a = a + 2
    For i = 0 To 250
        s_z# = (1.0 / i)
        rad# = SW*s_z# 
        r# = 127+Sin(i*i+a)*127
        g# = 127+Sin(i*i+a+120)*127
        b# = 127+Sin(i*i+a+240)*127
        Color r#*s_z^0.15 , g*s_z^0.15 , b*s_z^0.15
        Circle SW/2 - rad, SH/2 - rad, rad*2
    Next i
DrawScreen
Forever

Parempi versio:

EDIT:

Code: Select all

Const SW = 640
Const SH = 480
SCREEN SW, SH

Repeat
    a = a + 5
    For i = 0 To 500
        s_z# = (1.0 / i)
        rad# = SW*s_z# 
        r# = 127+Sin(i*5+a)*127
        g# = 127+Sin(i*5+a+120)*127
        b# = 127+Sin(i*5+a+240)*127
        Color r#*s_z^0.15 , g*s_z^0.15 , b*s_z^0.15
        Circle SW/2 - rad, SH/2 - rad, rad*2
    Next i
DrawScreen
Forever

[/edit]

EDIT:

2.
Myös hauska käytävä:

Code: Select all

Const SW = 1920
Const SH = 1080
SCREEN SW, SH

Repeat
    a = a + 5
    For i = 0 To 500
        s_z# = (1.0 / i)
        rad# = SW*s_z# 
        r# = 127+Sin(i*5+a)*127
        g# = 127+Sin(i*5+a+120)*127
        b# = 127+Sin(i*5+a+240)*127
        Color r#, g# , b#
        Box SW/2 - rad, SH/2 - rad, rad*2, rad*2
    Next i
DrawScreen
Forever

[/edit]

Posted: **Thu Jul 07, 2011 6:12 pm**

Suomen lippu

Code: Select all

/////////////////////flag-taulukko
Dim flagt$(11)
flagt(0)="0,0,0,0,0,1,1,1"
flagt(1)="0,0,0,0,0,1,1,1"
flagt(2)="0,0,0,0,0,1,1,1"
flagt(3)="0,0,0,0,0,1,1,1"
flagt(4)="1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1"
flagt(5)="1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1"
flagt(6)="1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1"
flagt(7)="0,0,0,0,0,1,1,1"
flagt(8)="0,0,0,0,0,1,1,1"
flagt(9)="0,0,0,0,0,1,1,1"
flagt(10)="0,0,0,0,0,1,1,1"
////////////////////////
Repeat 
angle=angle+5 'lisätään kulmaa viidellä
flag(cbblue,cbwhite,angle)
DrawScreen
Until EscapeKey()

////////////flag-funktio
Function flag(r,g,b,r2,g2,b2,angle)
'käydään läpi lipun alue
For y=100 To 200 Step 10
For x=100 To 300 Step 10
'jos kohta flag-taulukossa on 1 niin väri 1 muuten väri 2
If GetWord(flagt((y-100)/10),(x-100)/10+1,",")="1" Then
    Color r,g,b
        Else
    Color r2,g2,b2
EndIf 
'piirretään laatikko laskettuihin kordinaatteihin sin ja cos antavat "aaltoilun"
Box x+Cos(angle+y)*5,y+Sin(angle+x)*15,10,10
Next x
Next y
EndFunction

Posted: **Mon Jul 11, 2011 5:08 pm**

Timpe muokkasin lippuasi hitusen.

Nyt ei näy enää mustia pikseleitä laatikoiden välistä.

Ja värejä muokkasin.

Code: Select all

/////////////////////flag-taulukko
Dim flagt$(11)
flagt(0)="0,0,0,0,0,1,1,1"
flagt(1)="0,0,0,0,0,1,1,1"
flagt(2)="0,0,0,0,0,1,1,1"
flagt(3)="0,0,0,0,0,1,1,1"
flagt(4)="1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1"
flagt(5)="1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1"
flagt(6)="1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1"
flagt(7)="0,0,0,0,0,1,1,1"
flagt(8)="0,0,0,0,0,1,1,1"
flagt(9)="0,0,0,0,0,1,1,1"
flagt(10)="0,0,0,0,0,1,1,1"
////////////////////////
Repeat 

    angle=angle+5 'lisätään kulmaa viidellä
    flag(cbdarkblue,cbwhite,angle)
    
    DrawScreen
    
Until EscapeKey()

////////////flag-funktio
Function flag(r,g,b,r2,g2,b2,angle)
    'käydään läpi lipun alue
    For y=100 To 200 Step 10
        For x=100 To 300 Step 10
            'jos kohta flag-taulukossa on 1 niin väri 1 muuten väri 2
            If GetWord(flagt((y-100)/10),(x-100)/10+1,",")="1" Then
                Color r/2+r/4+Cos(x+y+angle)*r/4, g/2+g/4+Cos(x+y+angle)*g/4, b/2+b/4+Cos(x+y+angle)*b/4
                    Else
                Color r2/2+r2/4+Cos(x+y+angle)*r2/4, g2/2+g2/4+Cos(x+y+angle)*g2/4, b2/2+b2/4+Cos(x+y+angle)*b2/4
            EndIf 
            'piirretään laatikko laskettuihin kordinaatteihin sin ja cos antavat "aaltoilun"
            Box x+Cos(angle+y)*5,y+Sin(angle+x)*15,12,12
        Next x
    Next y
End Function

Posted: **Fri Aug 12, 2011 4:56 pm**

Kirjottelin tämmösen joskus alkukesästä ajatellen että sille tulisi käyttöä johonkin mutta eipä tässä ole ollutkaan aikaa/intoa mitään kirjoitella niin elvytän sit hieman tätä ketjua :)

Code: Select all

Const ires# = 21.0
Const jres# = 21.0

Dim t(RoundDown(ires*jres*2-1),2,2) As Float

For jj = 0 To jres-1
    j = Int((jres+RoundDown((jj+1)/2)*(-1)^jj) Mod jres)
    For i = 0 To ires-1
        
        t(p,0,0) = Cos(i/ires*360.0)*(2-Cos(j/jres*360.0))
        t(p,0,1) = Sin(j/jres*360.0)
        t(p,0,2) =-Sin(i/ires*360.0)*(2-Cos(j/jres*360.0))
        
        t(p,1,0) = Cos((i+1)/ires*360.0)*(2-Cos(j/jres*360.0))
        t(p,1,1) = Sin(j/jres*360.0)
        t(p,1,2) =-Sin((i+1)/ires*360.0)*(2-Cos(j/jres*360.0))
        
        t(p,2,0) = Cos(i/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        t(p,2,1) = Sin((j+1)/jres*360.0)
        t(p,2,2) =-Sin(i/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        
        p = p + 1
        
        t(p,0,0) = Cos((i+1)/ires*360.0)*(2-Cos(j/jres*360.0))
        t(p,0,1) = Sin(j/jres*360.0)
        t(p,0,2) =-Sin((i+1)/ires*360.0)*(2-Cos(j/jres*360.0))
        
        t(p,2,0) = Cos(i/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        t(p,2,1) = Sin((j+1)/jres*360.0)
        t(p,2,2) =-Sin(i/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        
        t(p,1,0) = Cos((i+1)/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        t(p,1,1) = Sin((j+1)/jres*360.0)
        t(p,1,2) =-Sin((i+1)/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        
        p = p + 1
        
    Next i
Next jj

SCREEN 640, 480

Const dist# = 20.0

Function lerp#(a#,b#,c#)
    c = c*c*(3-2*c)
    Return a*c+b*(1-c)
EndFunction

Repeat
    ang1# = ang1 + .3
    ang2# = ang2 + .29
    cang# = cang + .9
    cosa1# = Cos(ang1)
    sina1# = Sin(ang1)
    cosa2# = Cos(ang2)
    sina2# = Sin(ang2)
    fcang# = cang - RoundDown(cang)
    c1 = lerp(80,lerp(220,160,()*.5+.5),Sin(cang)*.5+.5)
    c2 = lerp(160,lerp(160,220,Cos(cang)*.5+.5),Sin(cang)*.5+.5)
    c3 = lerp(220,lerp(80,80,Cos(cang)*.5+.5),Sin(cang)*.5+.5)
    Lock
        For i = 0 To ires*jres*2-1
            x1# = cosa2*t(i,0,0)+sina2*(cosa1*t(i,0,1)+sina1*t(i,0,2))
            y1# = cosa2*(cosa1*t(i,0,1)+sina1*t(i,0,2))-sina2*t(i,0,0)
            z1# = cosa1*t(i,0,2)-sina1*t(i,0,1)
            x2# = cosa2*t(i,1,0)+sina2*(cosa1*t(i,1,1)+sina1*t(i,1,2))
            y2# = cosa2*(cosa1*t(i,1,1)+sina1*t(i,1,2))-sina2*t(i,1,0)
            z2# = cosa1*t(i,1,2)-sina1*t(i,1,1)
            x3# = cosa2*t(i,2,0)+sina2*(cosa1*t(i,2,1)+sina1*t(i,2,2))
            y3# = cosa2*(cosa1*t(i,2,1)+sina1*t(i,2,2))-sina2*t(i,2,0)
            z3# = cosa1*t(i,2,2)-sina1*t(i,2,1)
            
            s1# = 1280.0/(z1+dist)
            s2# = 1280.0/(z2+dist)
            s3# = 1280.0/(z3+dist)
            
            If (s2*x2-s1*x1)*(s3*y3-s1*y1)-(s3*x3-s1*x1)*(s2*y2-s1*y1)>0 Then
                nz# = (x2-x1)*(y3-y1)-(x3-x1)*(y2-y1)
                c# = Max(.05,(1-nz/Sqrt(((y2-y1)*(z3-z1)-(y3-y1)*(z2-z1))^2+((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1))^2+nz*nz))^2)
                
                //Color c*c1, c*c2, c*c3
                Color c*220, c*160, c*80
                //Color c*160, c*220, c*80
                tx1#=320+RoundDown(s1*x1)
                ty1#=240+RoundDown(s1*y1)
                tx2#=320+RoundDown(s2*x2)
                ty2#=240+RoundDown(s2*y2)
                tx3#=320+RoundDown(s3*x3)
                ty3#=240+RoundDown(s3*y3)
                If (ty1>ty2) Then
                    tmpy = ty1
                    tmpx = tx1
                    ty1 = ty2
                    tx1 = tx2
                    ty2 = tmpy
                    tx2 = tmpx
                EndIf
                If (ty1>ty3) Then
                    tmpy = ty1
                    tmpx = tx1
                    ty1 = ty3
                    tx1 = tx3
                    ty3 = tmpy
                    tx3 = tmpx
                EndIf
                If (ty2>ty3) Then
                    tmpy = ty2
                    tmpx = tx2
                    ty2 = ty3
                    tx2 = tx3
                    ty3 = tmpy
                    tx3 = tmpx
                EndIf
                If(ty2=ty1) Then ty1-0.0001
                If(ty3=ty2) Then ty3+0.0001
                slp1# = (tx3-tx1)/(ty3-ty1)
                slp2# = (tx2-tx1)/(ty2-ty1)
                slp3# = (tx3-tx2)/(ty3-ty2)
                tx1# = tx1 - slp1*ty1
                tx2# = tx2 - slp2*ty2
                tx3# = tx3 - slp3*ty3
                For ii = ty1 To ty2
                    Line tx1+slp1*ii, ii, tx2+slp2*ii, ii
                Next ii
                For ii = ty2 To ty3
                    Line tx1+slp1*ii, ii, tx3+slp3*ii, ii
                Next ii
                i=i+1
                x4# = cosa2*t(i,1,0)+sina2*(cosa1*t(i,1,1)+sina1*t(i,1,2))
                y4# = cosa2*(cosa1*t(i,1,1)+sina1*t(i,1,2))-sina2*t(i,1,0)
                s4# = 1280.0/(cosa1*t(i,1,2)-sina1*t(i,1,1)+dist)
                x1=320+RoundDown(s4*x4)
                y1=240+RoundDown(s4*y4)
                x2=320+RoundDown(s2*x2)
                y2=240+RoundDown(s2*y2)
                x3=320+RoundDown(s3*x3)
                y3=240+RoundDown(s3*y3)
                If (y1>y2) Then
                    tmpy = y1
                    tmpx = x1
                    y1 = y2
                    x1 = x2
                    y2 = tmpy
                    x2 = tmpx
                EndIf
                If (y1>y3) Then
                    tmpy = y1
                    tmpx = x1
                    y1 = y3
                    x1 = x3
                    y3 = tmpy
                    x3 = tmpx
                EndIf
                If (y2>y3) Then
                    tmpy = y2
                    tmpx = x2
                    y2 = y3
                    x2 = x3
                    y3 = tmpy
                    x3 = tmpx
                EndIf
                If(y2=y1) Then y1-0.0001
                If(y3=y2) Then y3+0.0001
                slp1# = (x3-x1)/(y3-y1)
                slp2# = (x2-x1)/(y2-y1)
                slp3# = (x3-x2)/(y3-y2)
                x1 = x1 - slp1*y1
                x2 = x2 - slp2*y2
                x3 = x3 - slp3*y3
                For ii = y1 To y2
                    Line x1+slp1*ii, ii, x2+slp2*ii, ii
                Next ii
                For ii = y2 To y3
                    Line x1+slp1*ii, ii, x3+slp3*ii, ii
                Next ii
            Else
                i = i + 1
            EndIf
        Next i
    Unlock
    Color 255,255,255
    Text 10, 10, Str(FPS())
    DrawScreen
Forever

EDIT:

Lisähuomiona: alun ires- ja jres-vakioista voi säätää toruksen pehmeyttä.

Posted: **Fri Aug 12, 2011 5:20 pm**

koodaaja wrote:Kirjottelin tämmösen joskus alkukesästä ajatellen että sille tulisi käyttöä johonkin mutta eipä tässä ole ollutkaan aikaa/intoa mitään kirjoitella niin elvytän sit hieman tätä ketjua
Code: Select all
shnip
EDIT:
Lisähuomiona: alun ires- ja jres-vakioista voi säätää toruksen pehmeyttä.

Hienon näkönenhän tuo, ja sillä saa erinäköisiä monikulmioita muuttamalla tuota ires:ä. Huomasin, että jos jres on pieni (4), piirtojärjestys mokaa.

Posted: **Fri Aug 12, 2011 5:43 pm**

koodaaja wrote:Kirjottelin tämmösen joskus alkukesästä ajatellen että sille tulisi käyttöä johonkin mutta eipä tässä ole ollutkaan aikaa/intoa mitään kirjoitella niin elvytän sit hieman tätä ketjua
Code: Select all
Donitsi
EDIT:
Lisähuomiona: alun ires- ja jres-vakioista voi säätää toruksen pehmeyttä.

Nopeutta saisi puristettua lisää niin ettei piirrä kaikista tummimpia varjoja ollenkaan.

Rinkeli pyöriskeli 30-61FPS:n välissä riippuen asennosta.

EDIT:

Mutta se näyttäisi olevan vähän niinkuin pakko, nimittäin "taaimmainen" seinusta piirtyy donitsin rinkulan keskeltä, koska sen koodi laskee kirkkaammaksi kuin mitä tämä kaikista läheisin keskusta on. Sry huonoa selitystä.

EDIT:

2. Heh rinkula esiin:

Code: Select all

Const ires# = 21.0
Const jres# = 21.0

Dim t(RoundDown(ires*jres*2-1),2,2) As Float

For jj = 0 To jres-1
    j = Int((jres+RoundDown((jj+1)/2)*(-1)^jj) Mod jres)
    For i = 0 To ires-1
        
        t(p,0,0) = Cos(i/ires*360.0)*(2-Cos(j/jres*360.0))
        t(p,0,1) = Sin(j/jres*360.0)
        t(p,0,2) =-Sin(i/ires*360.0)*(2-Cos(j/jres*360.0))
        
        t(p,1,0) = Cos((i+1)/ires*360.0)*(2-Cos(j/jres*360.0))
        t(p,1,1) = Sin(j/jres*360.0)
        t(p,1,2) =-Sin((i+1)/ires*360.0)*(2-Cos(j/jres*360.0))
        
        t(p,2,0) = Cos(i/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        t(p,2,1) = Sin((j+1)/jres*360.0)
        t(p,2,2) =-Sin(i/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        
        p = p + 1
        
        t(p,0,0) = Cos((i+1)/ires*360.0)*(2-Cos(j/jres*360.0))
        t(p,0,1) = Sin(j/jres*360.0)
        t(p,0,2) =-Sin((i+1)/ires*360.0)*(2-Cos(j/jres*360.0))
        
        t(p,2,0) = Cos(i/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        t(p,2,1) = Sin((j+1)/jres*360.0)
        t(p,2,2) =-Sin(i/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        
        t(p,1,0) = Cos((i+1)/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        t(p,1,1) = Sin((j+1)/jres*360.0)
        t(p,1,2) =-Sin((i+1)/ires*360.0)*(2-Cos((j+1)/jres*360.0))
        
        p = p + 1
        
    Next i
Next jj

SCREEN 640, 480

Const dist# = 20.0

Function lerp#(a#,b#,c#)
    c = c*c*(3-2*c)
    Return a*c+b*(1-c)
EndFunction

Repeat
    ang1# = ang1 + .3
    ang2# = ang2 + .29
    cang# = cang + .9
    cosa1# = Cos(ang1)
    sina1# = Sin(ang1)
    cosa2# = Cos(ang2)
    sina2# = Sin(ang2)
    fcang# = cang - RoundDown(cang)
    c1 = lerp(80,lerp(220,160,()*.5+.5),Sin(cang)*.5+.5)
    c2 = lerp(160,lerp(160,220,Cos(cang)*.5+.5),Sin(cang)*.5+.5)
    c3 = lerp(220,lerp(80,80,Cos(cang)*.5+.5),Sin(cang)*.5+.5)
    Lock
        For i = 0 To ires*jres*2-1
            x1# = cosa2*t(i,0,0)+sina2*(cosa1*t(i,0,1)+sina1*t(i,0,2))
            y1# = cosa2*(cosa1*t(i,0,1)+sina1*t(i,0,2))-sina2*t(i,0,0)
            z1# = cosa1*t(i,0,2)-sina1*t(i,0,1)
            x2# = cosa2*t(i,1,0)+sina2*(cosa1*t(i,1,1)+sina1*t(i,1,2))
            y2# = cosa2*(cosa1*t(i,1,1)+sina1*t(i,1,2))-sina2*t(i,1,0)
            z2# = cosa1*t(i,1,2)-sina1*t(i,1,1)
            x3# = cosa2*t(i,2,0)+sina2*(cosa1*t(i,2,1)+sina1*t(i,2,2))
            y3# = cosa2*(cosa1*t(i,2,1)+sina1*t(i,2,2))-sina2*t(i,2,0)
            z3# = cosa1*t(i,2,2)-sina1*t(i,2,1)
            
            s1# = 1280.0/(z1+dist)
            s2# = 1280.0/(z2+dist)
            s3# = 1280.0/(z3+dist)
            
            If (s2*x2-s1*x1)*(s3*y3-s1*y1)-(s3*x3-s1*x1)*(s2*y2-s1*y1)>0 Then
                nz# = (x2-x1)*(y3-y1)-(x3-x1)*(y2-y1)
                c# = Max(.05,(1-nz/Sqrt(((y2-y1)*(z3-z1)-(y3-y1)*(z2-z1))^2+((x2-x1)*(z3-z1)-(x3-x1)*(z2-z1))^2+nz*nz))^2)
                
                //Color c*c1, c*c2, c*c3
                Color (1.0-c)*220, (1.0-c)*160, (1.0-c)*80
                //Color c*160, c*220, c*80
                tx1#=320+RoundDown(s1*x1)
                ty1#=240+RoundDown(s1*y1)
                tx2#=320+RoundDown(s2*x2)
                ty2#=240+RoundDown(s2*y2)
                tx3#=320+RoundDown(s3*x3)
                ty3#=240+RoundDown(s3*y3)
                If (ty1>ty2) Then
                    tmpy = ty1
                    tmpx = tx1
                    ty1 = ty2
                    tx1 = tx2
                    ty2 = tmpy
                    tx2 = tmpx
                EndIf
                If (ty1>ty3) Then
                    tmpy = ty1
                    tmpx = tx1
                    ty1 = ty3
                    tx1 = tx3
                    ty3 = tmpy
                    tx3 = tmpx
                EndIf
                If (ty2>ty3) Then
                    tmpy = ty2
                    tmpx = tx2
                    ty2 = ty3
                    tx2 = tx3
                    ty3 = tmpy
                    tx3 = tmpx
                EndIf
                If(ty2=ty1) Then ty1-0.0001
                If(ty3=ty2) Then ty3+0.0001
                slp1# = (tx3-tx1)/(ty3-ty1)
                slp2# = (tx2-tx1)/(ty2-ty1)
                slp3# = (tx3-tx2)/(ty3-ty2)
                tx1# = tx1 - slp1*ty1
                tx2# = tx2 - slp2*ty2
                tx3# = tx3 - slp3*ty3
                For ii = ty1 To ty2
                    Line tx1+slp1*ii, ii, tx2+slp2*ii, ii
                Next ii
                For ii = ty2 To ty3
                    Line tx1+slp1*ii, ii, tx3+slp3*ii, ii
                Next ii
                i=i+1
                x4# = cosa2*t(i,1,0)+sina2*(cosa1*t(i,1,1)+sina1*t(i,1,2))
                y4# = cosa2*(cosa1*t(i,1,1)+sina1*t(i,1,2))-sina2*t(i,1,0)
                s4# = 1280.0/(cosa1*t(i,1,2)-sina1*t(i,1,1)+dist)
                x1=320+RoundDown(s4*x4)
                y1=240+RoundDown(s4*y4)
                x2=320+RoundDown(s2*x2)
                y2=240+RoundDown(s2*y2)
                x3=320+RoundDown(s3*x3)
                y3=240+RoundDown(s3*y3)
                If (y1>y2) Then
                    tmpy = y1
                    tmpx = x1
                    y1 = y2
                    x1 = x2
                    y2 = tmpy
                    x2 = tmpx
                EndIf
                If (y1>y3) Then
                    tmpy = y1
                    tmpx = x1
                    y1 = y3
                    x1 = x3
                    y3 = tmpy
                    x3 = tmpx
                EndIf
                If (y2>y3) Then
                    tmpy = y2
                    tmpx = x2
                    y2 = y3
                    x2 = x3
                    y3 = tmpy
                    x3 = tmpx
                EndIf
                If(y2=y1) Then y1-0.0001
                If(y3=y2) Then y3+0.0001
                slp1# = (x3-x1)/(y3-y1)
                slp2# = (x2-x1)/(y2-y1)
                slp3# = (x3-x2)/(y3-y2)
                x1 = x1 - slp1*y1
                x2 = x2 - slp2*y2
                x3 = x3 - slp3*y3
                For ii = y1 To y2
                    Line x1+slp1*ii, ii, x2+slp2*ii, ii
                Next ii
                For ii = y2 To y3
                    Line x1+slp1*ii, ii, x3+slp3*ii, ii
                Next ii
            Else
                i = i + 1
            EndIf
        Next i
    Unlock
    Color 255,255,255
    Text 10, 10, Str(FPS())
    DrawScreen
Forever

[/edit]

Posted: **Sun Aug 14, 2011 11:20 pm**

MaGetzUb wrote:
koodaaja wrote:Kirjottelin tämmösen joskus alkukesästä ajatellen että sille tulisi käyttöä johonkin mutta eipä tässä ole ollutkaan aikaa/intoa mitään kirjoitella niin elvytän sit hieman tätä ketjua
Code: Select all
Donitsi
EDIT:
Lisähuomiona: alun ires- ja jres-vakioista voi säätää toruksen pehmeyttä.
Nopeutta saisi puristettua lisää niin ettei piirrä kaikista tummimpia varjoja ollenkaan. Rinkeli pyöriskeli 30-61FPS:n välissä riippuen asennosta.
EDIT:
Mutta se näyttäisi olevan vähän niinkuin pakko, nimittäin "taaimmainen" seinusta piirtyy donitsin rinkulan keskeltä, koska sen koodi laskee kirkkaammaksi kuin mitä tämä kaikista läheisin keskusta on. Sry huonoa selitystä.

EDIT:
2. Heh rinkula esiin:
Code: Select all
Ihan kiva koodi
[/edit]

Tahtoo näytönsäästäjäversion.

Posted: **Sun Aug 14, 2011 11:25 pm**

naputtelija wrote:Tahtoo näytönsäästäjäversion.

1. käännä
2. muuta päätteeksi .scr

EDIT:

No teknisesti ottaen pari hookkia pitäis toteuttaa mutta kyllä se noinkin käy jos SafeExit on päällä

Posted: **Wed Aug 17, 2011 9:25 pm**

esa94 wrote:
naputtelija wrote:Tahtoo näytönsäästäjäversion.
1. käännä
2. muuta päätteeksi .scr

EDIT:
No teknisesti ottaen pari hookkia pitäis toteuttaa mutta kyllä se noinkin käy jos SafeExit on päällä

Repeat silmukkaan:

Code: Select all

If MouseMovex() or MouseMovey() Then Quit = True
For i = 1 to 205 
      if Keyhit(i) Then Quit = True
Next i 
If Quit = True Then End

Posted: **Thu Aug 18, 2011 8:05 am**

MaGetzUb wrote:
esa94 wrote:
naputtelija wrote:Tahtoo näytönsäästäjäversion.
1. käännä
2. muuta päätteeksi .scr

EDIT:
No teknisesti ottaen pari hookkia pitäis toteuttaa mutta kyllä se noinkin käy jos SafeExit on päällä
Repeat silmukkaan:

Code: Select all

If MouseMoveX() Or MouseMoveY() Or GetKey() Then
    End
EndIf

Posted: **Thu Aug 18, 2011 6:01 pm**

Sly_Jack0 wrote:
MaGetzUb wrote: Repeat silmukkaan:

Code: Select all

If MouseMoveX() Or MouseMoveY() Or GetKey() Then End

Okei aika turha posti oli ny.

Posted: **Thu Aug 18, 2011 7:07 pm**

Ainoa ongelma tuossa lähestymistavassa on se, että se vie konetehoja. Hookilla se ei veisi tehoja.

Posted: **Thu Aug 18, 2011 7:25 pm**

Dimple wrote:Ainoa ongelma tuossa lähestymistavassa on se, että se vie konetehoja. Hookilla se ei veisi tehoja.

Ongelma lienee jokseenkin akateeminen kun on kuitenkin cb:stä kyse.

Posted: **Fri Aug 19, 2011 6:16 pm**

Dimple wrote:Ainoa ongelma tuossa lähestymistavassa on se, että se vie konetehoja. Hookilla se ei veisi tehoja.

Käsittääkseni efekti veisi joka tapauksessa konetehoja, joten Sly_Jack0:n ehdotus on ihan toimiva.

Mikäli ohjelma näyttäisi vaan staattista kuvaa (joka voisi tosin olla tuhoisa näytönsäästäjä

), voisi cpu-aikaa vapauttaa helposti esim. odottamalla pääsilmukassa jonkin aikaa.

Code: Select all

Repeat
	frame + 1
	Text 5,5,"Frame numero " + frame
	If MouseMoveX() Or MouseMoveY() Or GetKey() Then
		End
	EndIf
	DrawScreen
	Wait 200
Forever

CoolBasic Forums

Efektit

Re: Efektit

Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit

Re: Efektit