CoolBasic Forums

Posted: **Sat Nov 08, 2008 11:11 am**

On toi Atomimallin viivahärpäke hieno. Tollasen ku sais näytönsäästäjäks. :)

Etkös saa siitä näytönsäästäjän, kun buildaat exeksi ja vaihdat tiedostopäätteeksi .scr?

Posted: **Sat Nov 08, 2008 12:24 pm**

Grandi wrote:Etkös saa siitä näytönsäästäjän, kun buildaat exeksi ja vaihdat tiedostopäätteeksi .scr?

Pitäähän se laittaa kokoruudulle ja tehä sulkeutuminen kun jotain tapahtuu?

Näin:

SCREEN 640,480,32,0
Repeat
    aika=Timer()/20
    For x=1 To 60
        For y= 1 To 50
            Color Cos(aika+y*2.5+x*2.5)*127+127,Sin(aika+y*5)*127+127,Sin(aika+x*5)*127+127
            Line x*10+Sin(aika+y*5)*20,y*10+Sin(aika+x*5)*20,x*10+Sin(aika+y*5)*20+Sin(aika+x*5)*10,y*10+Sin(aika+x*5)*20+Sin(aika+y*5)*10
        Next y
    Next x
  If MouseMoveX() Or MouseMoveY() Or MouseMoveZ() Or GetKey() Or GetMouse() Then End 
    DrawScreen
Forever

Igr0 wrote:On toi Atomimallin viivahärpäke hieno. Tollasen ku sais näytönsäästäjäks.

Ole hyvä vaan!

Posted: **Sat Nov 08, 2008 1:57 pm**

Miten sen exe:n muka saa .scr:ksi

Posted: **Sat Nov 08, 2008 2:11 pm**

phons wrote:Miten sen exe:n muka saa .scr:ksi

Kirjoittamalla uuden tiedostopäätteen. Sinun luultavasti pitää muuttaa kansion asetuksista kohta "piilota tunnettujen tiedostotyyppien tunnisteet" pois käytöstä.

Posted: **Sat Nov 08, 2008 3:55 pm**

nevssons wrote:
Igr0 wrote:On toi Atomimallin viivahärpäke hieno. Tollasen ku sais näytönsäästäjäks.
Ole hyvä vaan!

No kiitos kiitos, mutta mitenkäs tuon sitten saa toimimaan näytönsäästäjän tavoin? Se kun ei luo kauheasti näytönsäästäjä fiilistä, jos ite pitää se painaa päälle...

(Mulla on sitte käyttiksenä Vista)

Posted: **Sat Nov 08, 2008 3:59 pm**

no laita se vain näytönsäästäjäksi ehkä sieltä asetuksista (en ole mikään paras tässä asiassa neuvomaan...)

Posted: **Sat Nov 08, 2008 4:01 pm**

Igr0 wrote:
nevssons wrote:
Igr0 wrote:On toi Atomimallin viivahärpäke hieno. Tollasen ku sais näytönsäästäjäks.
Ole hyvä vaan!
No kiitos kiitos, mutta mitenkäs tuon sitten saa toimimaan näytönsäästäjän tavoin? Se kun ei luo kauheasti näytönsäästäjä fiilistä, jos ite pitää se painaa päälle...
(Mulla on sitte käyttiksenä Vista)

Klikkaat sitä oikealla hiirennäppäimellä ja valitse asenna. Sitten valitse se tyhjä kohta "ei mitään" alapuolella ja valitse käytä.

Posted: **Sat Nov 08, 2008 4:08 pm**

nevssons wrote:Klikkaat sitä oikealla hiirennäppäimellä ja valitse asenna. Sitten valitse se tyhjä kohta "ei mitään" alapuolella ja valitse käytä.

Kiitoksia neuvosta, nyt toimii, FPS on kyllä aluks aika low, mut se kyl tasottuu ku odottaa hetken.

Posted: **Tue Nov 11, 2008 5:24 pm**

Tein tässä tällasen bpm counterin, joka laskee bpm:n käyttäjän välilyöntien perusteella. Ihan kätevä käyttää jonkun efektin manuaalisynkkaukseen. Pistin esim. ton flashefektin kanssa niin, että käyttäjä saa ensin antaa bpm:n ja ohjelma jatkaa sitten välilyöntien loppuessa annetulla bpm:llä.

Olen aika uusi tulokas CoolBasicin pariin, joten koodi on mitä on. Koodasin viimeks joskus neljä vuotta sitten, ennen teologian opiskelujen alkua :p. Kiva päästä taas vääntämään. :p

Code: Select all

Dim Bpm As Float                     
Dim OldBpm As Float 
Dim Väli As Float

OldBpm = 0
Count = 0

WaitKey
Record = Timer()
Repeat
  
If KeyHit(cbKeySpace) Then      
  Väli = Timer() - Record        
  Record = Timer()             
  Bpm = 60000/Väli          
  Count + 1 
  Bpm = ((Count-1)*OldBpm+Bpm)/Count
  OldBpm = Bpm
EndIf

Text 0,0, "Bpm = " +(Int(Bpm))

DrawScreen
Forever

Posted: **Sat Nov 15, 2008 11:45 am**

Reaaliaikainen ja simppeli vesiefekti, jossa kolme erilaista toimintatilaa (joiden lisääminenkin on helppoa).

Code: Select all

SCREEN 640,480
SetWindow "Fluids"

// Luodaan nurmikko
grass=MakeObjectFloor()
lawn=LoadImage("Media\grass.bmp")
PaintObject grass,lawn

guy = LoadObject("Media\guy.bmp",40)

// Efektien palikkamaisuus
Const Grid = 15

intensity = 3

Repeat

    angle# = angle# + 10

    DrawGame

    // Päivitetään efektit
    Fluidize(angle,intensity,mode)

    // Ukon kontrollointi
    If LeftKey() Then TurnObject guy,4
    If RightKey() Then TurnObject guy,-4
    If UpKey() Then MoveObject guy,3
    If DownKey() Then MoveObject guy,-3
    
    // Efektien kontrollointi
    If KeyHit(cbkeyspace) Then mode + 1
    If mode > 2 Then mode = 0
    If KeyHit(cbkeyq) Then intensity + 1
    If KeyHit(cbkeya) Then intensity - 1
    
    Text 20,20,"FPS: "+FPS()
    
    Text 10,ScreenHeight() - 20,"Intensity (Q/A) : "+intensity
    Text 10,ScreenHeight() - 36,"Effect (space)  : "+mode

DrawScreen
Forever

Function Fluidize(ang#,amp#,id)
    sw = ScreenWidth()
    sh = ScreenHeight()
    halfsw = sw / 2
    halfsh = sh / 2
    randscale = amp/3
    
    For Y = 1 To sh Step Grid
        For X = 1 To sw Step Grid

            Select id
                Case 1
                    targetx = x + Cos(x+ang)*amp + Rand(-randscale,randscale)
                    targety = y - Sin(y+ang)*amp + Rand(-randscale,randscale)
                Case 2
                    targetx = x + Cos(x+ang)*amp
                    targety = y
                Default
                    targetx = x + Cos(y+ang)*amp
                    targety = y + Cos(x+ang)*amp
            End Select
            
            CopyBox x,y,grid,grid,targetx-halfsw,targety-halfsh
        
        Next X
    Next Y
    
End Function

EDIT:

Jep, jos haluat käyttää tätä funktiota omassa koodissasi, muista lätkäistä Const Grid = 15 rivi johonkin sopivaan paikkaan (sitä arvoahan saa tietty muuttaa)

EDIT:

Uudempi ja parempi versio löytyy cbkk:sta.

Posted: **Sat Nov 15, 2008 1:20 pm**

Ruuttu wrote:Reaaliaikainen ja simppeli vesiefekti, jossa kolme erilaista toimintatilaa (joiden lisääminenkin on helppoa).

Code: Select all

SCREEN 640,480
SetWindow "Fluids"

// Luodaan nurmikko
grass=MakeObjectFloor()
lawn=LoadImage("Media\grass.bmp")
PaintObject grass,lawn

guy = LoadObject("Media\guy.bmp",40)

// Efektien palikkamaisuus
Const Grid = 15

intensity = 3

Repeat

    angle# = angle# + 10

    DrawGame

    // Päivitetään efektit
    Fluidize(angle,intensity,mode)

    // Ukon kontrollointi
    If LeftKey() Then TurnObject guy,4
    If RightKey() Then TurnObject guy,-4
    If UpKey() Then MoveObject guy,3
    If DownKey() Then MoveObject guy,-3
    
    // Efektien kontrollointi
    If KeyHit(cbkeyspace) Then mode + 1
    If mode > 2 Then mode = 0
    If KeyHit(cbkeyq) Then intensity + 1
    If KeyHit(cbkeya) Then intensity - 1
    
    Text 20,20,"FPS: "+FPS()
    
    Text 10,ScreenHeight() - 20,"Intensity (Q/A) : "+intensity
    Text 10,ScreenHeight() - 36,"Effect (space)  : "+mode

DrawScreen
Forever

Function Fluidize(ang#,amp#,id)
    sw = ScreenWidth()
    sh = ScreenHeight()
    halfsw = sw / 2
    halfsh = sh / 2
    randscale = amp/3
    
    For Y = 1 To sh Step Grid
        For X = 1 To sw Step Grid

            Select id
                Case 1
                    targetx = x + Cos(x+ang)*amp + Rand(-randscale,randscale)
                    targety = y - Sin(y+ang)*amp + Rand(-randscale,randscale)
                Case 2
                    targetx = x + Cos(x+ang)*amp
                    targety = y
                Default
                    targetx = x + Cos(y+ang)*amp
                    targety = y + Cos(x+ang)*amp
            End Select
            
            CopyBox x,y,grid,grid,targetx-halfsw,targety-halfsh
        
        Next X
    Next Y
    
End Function

On kyllä hienon näköinen ja todella nopeakin vielä

Posted: **Sat Nov 15, 2008 7:19 pm**

Hieno !! toisella efektillä saa joko veden alaisen tunnun tai sitten ilman väreilyn kuumassa paikassa !! mikä parasta, efekti on nopea ! kokelin vaihtaa palikkakoon 20:een mutta laatu ei niinkään huonontunut.

1-2 amplitudilla tuota on hyvä käyttää, sillä muuten tulee liika häiriöitä yksityiskohtiin.

Posted: **Sat Nov 15, 2008 8:29 pm**

Ef.1 oli niin aito että!
Sinertävyyttä niin vois lisää vaikka jophonkin gta1 kopioon.

Posted: **Sun Nov 16, 2008 1:05 pm**

Randomia

Code: Select all

    SCREEN 800,800
    
    Repeat
    
    For a=0 To 360 Step 4
        For i=0 To 184 Step 4
                r=r+4
                If r>255 Then r=0 : g+4
                If g>255 Then b+4 : g=0
                If b>255 Then b=0

            Color r,g,b
                    
            Dot 400+Cos(a)*i,400-Sin(a)*i
        Next i
    Next a
    
    DrawScreen
    Forever

Posted: **Sun Nov 16, 2008 3:57 pm**

Tämä ei ole oikeastaan efekti, vaan ihan kokonainen näytönsäästäjä. Tässä ei ole mitään erikoista, eikä tämä ole edes erityisen näyttävä. Pistän tämän tänne oikeastaan vain, koska tämä on "valmis".

Ole kiltti ja jätä "quality" asetus rauhaan; alemmat laatutasot saavat systeemin pyörimään ripeämmin, mutta jostain syystä värien vaihtelut alkavat bugittaa. Jos homma pyörii hitaasti, laske mieluummin resoluutiota asetustiedostosta käsin.

Paina Enteriä tai F1:stä tuodaksesi asetusvalikon esiin.

Code: Select all

CMD$ = CommandLine()
If InStr(CMD$,"/p") > 0 Then End

// Jos asetustiedostoa ei ole, se luodaan.
If FileExists("HorizontalColors.ini")=0 Then
    F = OpenToWrite("HorizontalColors.ini")
    
            //Virheen sattuessa
            If F = 0 Then 
                BigErrorFont = LoadFont("arial",30)
                ErrorFont = LoadFont("courier New",20)
                SetFont ErrorFont
                Repeat
                    SetFont BigErrorFont
                    CenterText 200,50,"Error!"
                    
                    SetFont ErrorFont
                    CenterText 200,100,"The configuration file is missing"
                    CenterText 200,120,"a"+"nd it can't be created. The"
                    CenterText 200,140,"d"+"efault configuration will be"
                    CenterText 200,160,"used. Changes made won't be saved."
                    CenterText 200,200,"Press enter t"+"o continue."
                    Text 5,280,"Error code: C001"
                    
                DrawScreen
                Until KeyHit(cbkeyreturn)
                Goto DebugSettings
            End If
            
        WriteLine f,"Horizontal Colors"
        WriteLine f,""
        WriteLine f,"Contrast = 3"
        WriteLine f,"FlipDirection = 0"
        WriteLine f,"MouseSensitivity = 5"
        WriteLine f,"Width = 0"
        WriteLine f,"Height = 0"
        WriteLine f,"LowQuality = 0"
        WriteLine f,""
    CloseFile f
End If

// Luetaan asetustiedosto...
F = OpenToRead("HorizontalColors.ini")
    If F = 0 Then MakeError "File access error!"+Chr(10)+Chr(13)+"Error code: C002"
    Repeat
    
        Rivi$ = Replace(Lower(ReadLine(f))," ","")
        
        If GetWord(rivi$,1,"=")="contrast" Then
            contrast = GetWord(rivi$,2,"=")
        ElseIf GetWord(rivi$,1,"=")="flipdirection" Then
            dir = GetWord(rivi$,2,"=")
        ElseIf GetWord(rivi$,1,"=")="mousesensitivity" Then
            msensitivity = GetWord(rivi$,2,"=")
        ElseIf GetWord(rivi$,1,"=")="width" Then
            Xwidth = GetWord(rivi$,2,"=")
        ElseIf GetWord(rivi$,1,"=")="height" Then
            Xheight = GetWord(rivi$,2,"=")
        ElseIf GetWord(rivi$,1,"=")="lowquality" Then
            LowQ = GetWord(rivi$,2,"=")
        End If
        
    Until EOF(f)
CloseFile f

Goto Continue

DebugSettings:

contrast = 3
MouseSensitivity = 5

Continue:

// Etsitään paras mahdollinen ruututila.
If GFXModeExists(800,600,32)=1 Then width=800 : height=600 : depth=32
If GFXModeExists(1024,768,32)=1 Then width=1024 : height=768 : depth=32
If GFXModeExists(1152,864,32)=1 Then width=1152 : height=864 : depth=32
If GFXModeExists(1280,720,32)=1 Then width=1280 : height=720 : depth=32
If GFXModeExists(1280,768,32)=1 Then width=1280 : height=768 : depth=32
If GFXModeExists(1280,800,32)=1 Then width=1280 : height=800 : depth=32
If GFXModeExists(1280,960,32)=1 Then width=1280 : height=960 : depth=32
If GFXModeExists(1280,1024,32)=1 Then width=1280 : height=1024 : depth=32
If GFXModeExists(1440,1050,32)=1 Then width=1440 : height=1050 : depth=32
If GFXModeExists(1440,900,32)=1 Then width=1440 : height=900 : depth=32
If GFXModeExists(1680,1050,32)=1 Then width=1680 : height=1050 : depth=32
If GFXModeExists(1920,1080,32)=1 Then width=1920 : height=1080 : depth=32

// Jos paras mahdollinen ruututila on jo löytynyt, asetetaan se.
If depth > 0 Then Goto SetResolution

// Hyvää grafiikkatilaa ei löytynyt, joten etsitään huonommista.
If GFXModeExists(800,600,16)=1 Then width=800 : height=600 : depth=16
If GFXModeExists(1024,768,16)=1 Then width=1024 : height=768 : depth=16
If GFXModeExists(1152,864,16)=1 Then width=1152 : height=864 : depth=16
If GFXModeExists(1280,720,16)=1 Then width=1280 : height=720 : depth=16
If GFXModeExists(1280,768,16)=1 Then width=1280 : height=768 : depth=16
If GFXModeExists(1280,800,16)=1 Then width=1280 : height=800 : depth=16
If GFXModeExists(1280,960,16)=1 Then width=1280 : height=960 : depth=16
If GFXModeExists(1280,1024,16)=1 Then width=1280 : height=1024 : depth=16
If GFXModeExists(1440,1050,16)=1 Then width=1440 : height=1050 : depth=16
If GFXModeExists(1440,900,16)=1 Then width=1440 : height=900 : depth=16
If GFXModeExists(1680,1050,16)=1 Then width=1680 : height=1050 : depth=16
If GFXModeExists(1920,1080,16)=1 Then width=1920 : height=1080 : depth=16

SetResolution:

If Xwidth > 1 And Xheight > 1 Then width = Xwidth : height = Xheight

Screenmode = 0

If InStr(CMD$,"c:") > 0 Then
    XWidth = Width
    XHeight = Height
    Width = 800
    Height = 600
    Screenmode = 1
    Settings = 1
    Info = 1
    Select LowQ
            Case 0
                Quality$ = "3"
            Case 1
                Quality$ = "2"
            Case 2
                Quality$ = "1"
    End Select
    If dir = 0 Then direction$ = "/\"
    If dir = 1 Then direction$ = "\/"
    SetWindow "Horizontal Colors Configuration"
End If

// Virheen sattuessa
If settings = 0 And GFXModeExists(Width,Height,Depth)=0 Then

        If GFXModeExists(800,600,32)=1 Then
            Width = 800
            Height = 600
            Depth = 32
            Goto SetRes2
        End If

        BigErrorFont = LoadFont("arial",30)
        ErrorFont = LoadFont("Courier New",20)
                
        Repeat
           SetFont BigErrorFont
           CenterText 200,50,"Error!"
                            
           SetFont ErrorFont
           CenterText 200,100,"Your computer doesn't seem t"+"o"
           CenterText 200,120,"support the graphics mode required."
           CenterText 200,140,"The program will start in a window."
           CenterText 200,160,"We are sorry fo"+"r the inconvinience."
           CenterText 200,200,"Press enter t"+"o continue."
           Text 5,280,"Error code: B001"
                            
           DrawScreen
        Until KeyHit(cbkeyreturn)
        ScreenMode = 1
        Depth = 0
End If

SetRes2:

SCREEN width,height,depth,Screenmode
FrameLimit 60

Global g_frameTime As Float
g_frameTime = 0.0
Global g_tmpTime As Integer
g_tmpTime = 0

Function UnitPerSec(px#)
    Return px# * g_frameTime
End Function

Function UpdateFrameTimer()
    curTime = TIMER()
    If g_tmpTime = 0 Then g_tmpTime = curTime
    g_frameTime = (curTime - g_tmpTime) / 1000.0
    g_tmpTime = curTime
End Function

FontSmall = LoadFont("arial",height/40)
FontNormal = LoadFont("arial",height/25)
FontBig = LoadFont("arial",height/20)

Dim colors(height+1,2) As Float
Dim power(height+1,2) As Float

For i=0 To height+1
    colors(i,0)=180 + col1#
    colors(i,1)=180 + col2#
    colors(i,2)=180 + col3#
    
    col1# = col1# + Rnd(-contrast,contrast)
    col2# = col2# + Rnd(-contrast,contrast)
    col3# = col3# + Rnd(-contrast,contrast)
    
    If colors(i,0)>255 Then colors(i,0) = 255
    If colors(i,1)>255 Then colors(i,1) = 255
    If colors(i,2)>255 Then colors(i,2) = 255
    
    If colors(i,0)<0 Then colors(i,0) = 0
    If colors(i,1)<0 Then colors(i,1) = 0
    If colors(i,2)<0 Then colors(i,2) = 0
    
    power(i,0)=Rnd(-1.6,1.6)
    power(i,1)=Rnd(-1.6,1.6)
    power(i,2)=Rnd(-1.6,1.6)
Next i

Setline# = 0
setline2# = (-height/3) / Max(1,LowQ)
setline3# = -(height/3) * 2 / Max(1,LowQ)

MenuSel = 1
bgfade# = 1.0
Fade# = 0.0
Qrat = 1

ClearKeys

Repeat

    mousemov = unitpersec(Abs(MouseMoveX()) + Abs(MouseMoveY()))
    If Info = 0 And settings = 0 Then
        If mousemov>msensitivity Then End
        K = GetKey()
        If K > 0 And K <> 13 Then End
    End If

    PowerS# = Min(Contrast,3)

    If LowQ = 0 Then Gosub NormalQualityRender
    If LowQ > 0 Then Gosub LowQualityRender

    If info=1 Then
    
            If NoInfo = 1 Then
                If bgfade# < 1.0 Then bgfade# = bgfade# + UnitPerSec(4)
                If bgfade > 1.0 Then bgfade# = 1.0
                If bgfade = 1.0 Then 
                    NoInfo = 0
                    Info = 0
                    ClearKeys
                    If Settings = 1 Then End
                End If
            Else
                If bgfade# > 0.6 Then bgfade# = bgfade# - UnitPerSec(4)
                If bgfade < 0.6 Then bgfade# = 0.6
            End If

            If LowQ = 0 Then
                // Piirretään asetusboxi
                    For i=height/3 To height/1.5
                        Color colors(i,0)*bgfade#,colors(i,1)*bgfade#,colors(i,2)*bgfade#
                        Line width/3,i,width/1.5,i
                    Next i
            ElseIf LowQ > 0 Then
                // Piirretään asetusboxi
                    For i=(height/3)/Qrat To (height/1.5)/Qrat
                        Color colors(i,0)*bgfade#,colors(i,1)*bgfade#,colors(i,2)*bgfade#
                        Box width/3,i*Qrat,width/3,Qrat,1
                    Next i
            End If
            
            Color 255,255,255
            SetFont FontBig
            CenterText Width/2,height/3 + height/30,"Settings"
            
            SetFont FontNormal
            CenterText Width/2,Height/3 + height/24*3,"Contrast: "+contrast
            CenterText Width/2,Height/3 + height/24*4,"Direction: "+direction$
            CenterText Width/2,Height/3 + Height/24*5,"Quality: "+quality$
            
            Text Width/3 + Width/70,Height/1.5 - Height/20,"Apply"
            Text Width/1.5 - TextWidth("Cancel") - width/70, Height/1.5 - Height/20,"Cancel"

            Color 220,220,220
            
            If KeyHit(cbkeyf1) Then
                Contrast = ExContrast
                Dir = ExDirection
                NoInfo = 1
            End If

            Select MenuSel
                Case 1
                    Text Width/1.5 - TextWidth("Cancel") - width/70-1, Height/1.5 - Height/20,"Cancel"
                    Text Width/1.5 - TextWidth("Cancel") - width/70+1, Height/1.5 - Height/20,"Cancel"
                    Text Width/1.5 - TextWidth("Cancel") - width/70, Height/1.5 - Height/20-1,"Cancel"
                    Text Width/1.5 - TextWidth("Cancel") - width/70, Height/1.5 - Height/20+1,"Cancel"
                    Color 255,255,255
                    Text Width/1.5 - TextWidth("Cancel") - width/70, Height/1.5 - Height/20,"Cancel"
                    
                    If KeyHit(cbkeyleft) Or KeyHit(cbkeyright) Then MenuSel = 5
                    If KeyHit(cbkeyup) Then MenuSel = 4
                    If KeyHit(cbkeydown) Then MenuSel = 3
                    
                    If KeyHit(cbkeyreturn) Then
                        Contrast = ExContrast
                        Dir = ExDirection
                        LowQ = ExQuality
                        NoInfo = 1
                    End If
                    
                Case 2
                    CenterText Width/2-1,Height/3 + height/24*4,"< Direction: "+direction$+" >"
                    CenterText Width/2+1,Height/3 + height/24*4,"< Direction: "+direction$+" >"
                    CenterText Width/2,Height/3 + height/24*4-1,"< Direction: "+direction$+" >"
                    CenterText Width/2,Height/3 + height/24*4+1,"< Direction: "+direction$+" >"
                    Color 255,255,255
                    CenterText Width/2,Height/3 + height/24*4,"< Direction: "+direction$+" >"
                    
                    If KeyHit(cbkeyup) Then Menusel = 3
                    If KeyHit(cbkeydown) Then menusel = 4
                    
                    If KeyHit(cbkeyleft) Or KeyHit(cbkeyright) Or KeyHit(cbkeyreturn) Then 
                        dir = Not dir
                        If dir = 0 Then direction$ = "/\"
                        If dir = 1 Then direction$ = "\/"
                    End If
                    
                Case 3
                    CenterText Width/2-1,Height/3 + height/24*3,"< Contrast: "+contrast+" >"
                    CenterText Width/2+1,Height/3 + height/24*3,"< Contrast: "+contrast+" >"
                    CenterText Width/2,Height/3 + height/24*3-1,"< Contrast: "+contrast+" >"
                    CenterText Width/2,Height/3 + height/24*3+1,"< Contrast: "+contrast+" >"
                    Color 255,255,255
                    CenterText Width/2,Height/3 + height/24*3,"< Contrast: "+contrast+" >"
                    
                    If KeyHit(cbkeyup) Then menusel = 1
                    If KeyHit(cbkeydown) Then menusel = 2
                    If KeyHit(cbkeyleft) Then contrast - 1
                    If KeyHit(cbkeyright) Then contrast + 1
                    If KeyHit(cbkeyreturn) Then contrast + 1
                    If contrast < 1 Then contrast = 20
                    If contrast > 20 Then contrast = 1
                 Case 4
                    CenterText Width/2-1,Height/3 + Height/24*5,"< Quality: "+quality$+" >"
                    CenterText Width/2+1,Height/3 + Height/24*5,"< Quality: "+quality$+" >"
                    CenterText Width/2,Height/3 + Height/24*5-1,"< Quality: "+quality$+" >"
                    CenterText Width/2,Height/3 + Height/24*5+1,"< Quality: "+quality$+" >"
                    
                    If KeyHit(cbkeyup) Then menusel = 2
                    If KeyHit(cbkeydown) Then menusel = 1
                    
                    Keep = 0
                    If KeyHit(cbkeyleft) Then 
                        LowQ + 1
                    ElseIf KeyHit(cbkeyright) Then
                        LowQ - 1
                    ElseIf KeyHit(cbkeyreturn) Then 
                        LowQ - 1
                    Else
                        Keep = 1
                    End If

                    If LowQ < 0 Then LowQ = 2
                    If LowQ > 2 Then LowQ = 0
                    
                        Select LowQ
                            Case 0
                                Quality$ = "3"
                            Case 1
                                Quality$ = "2"
                            Case 2
                                Quality$ = "1"
                        End Select
                        
                    If Keep = 0 Then 
                        Setline# = 0
                        setline2# = (-height/3) / Max(1,LowQ)
                        setline3# = -(height/3) * 2 / Max(1,LowQ) 
                    End If

                Case 5
                    Text Width/3 + Width/70-1,Height/1.5 - Height/20,"Apply"
                    Text Width/3 + Width/70+1,Height/1.5 - Height/20,"Apply"
                    Text Width/3 + Width/70,Height/1.5 - Height/20-1,"Apply"
                    Text Width/3 + Width/70,Height/1.5 - Height/20+1,"Apply"
                    Color 255,255,255
                    Text Width/3 + Width/70,Height/1.5 - Height/20,"Apply"
                    
                    If KeyHit(cbkeyleft) Or KeyHit(cbkeyright) Then MenuSel = 1
                    If KeyHit(cbkeyup) Then MenuSel = 4
                    If KeyHit(cbkeydown) Then MenuSel = 3
                    
                    If KeyHit(cbkeyreturn) Or KeyHit(cbkeyspace) Then
                        f=OpenToWrite("HorizontalColors.ini")
                            If F = 0 Then MakeError "File access error!"+Chr(10)+Chr(13)+"Error code: C003"
                            WriteLine f,"Settings"
                            WriteLine f,""
                            WriteLine f,"Contrast = "+contrast
                            WriteLine f,"FlipDirection = "+dir
                            WriteLine f,"MouseSensitivity = "+msensitivity
                            WriteLine f,"Width = "+xwidth
                            WriteLine f,"Height = "+xheight
                            WriteLine f,"LowQuality = "+LowQ
                            WriteLine f,""
                        CloseFile f
                        
                        NoInfo = 1
                    End If
                    
            End Select

    End If

    If KeyHit(cbkeyf1) or KeyHit(cbkeyreturn) Then 
        info = 1
        If dir = 0 Then direction$ = "/\"
        If dir = 1 Then direction$ = "\/"
            ExContrast = Contrast
            ExDirection = Dir
            ExQuality = LowQ
        Select LowQ
            Case 0
                Quality$ = "3"
            Case 1
                Quality$ = "2"
            Case 2
                Quality$ = "1"
        End Select
    End If
    
    If Info = 1 Then
        SetFont FontSmall
        Color Colors(HEIGHT/Qrat-2,0)*bgfade,Colors(HEIGHT/Qrat-2,1)*bgfade,Colors(HEIGHT/Qrat-2,2)*bgfade
        Text 5,Height-TextHeight("Hg")-3,"Horizontal Colors - 1.0"
    End If

    UpdateFrameTimer()

DrawScreen ON, ON
Forever


NormalQualityRender:

If fade# < 1.0 Then fade# = fade# + UnitPerSec(1)
If fade# > 1.0 Then fade# = 1

    Select dir
        Case 0
            For i=1 To height
            
                If i = Int(setline#) Or i = Int(setline2#) Or i = Int(setline3#) Then 
                    power(i,0) = Rnd(-PowerS,PowerS)
                    power(i,1) = Rnd(-PowerS,PowerS)
                    power(i,2) = Rnd(-PowerS,PowerS)
                End If
                
                colors(i,0)=colors(i+1,0)+power(i,0)
                colors(i,1)=colors(i+1,1)+power(i,1)
                colors(i,2)=colors(i+1,2)+power(i,2)
                
                If colors(i,0) < 6 Then colors(i,0) = 6
                If colors(i,1) < 6 Then colors(i,1) = 6
                If colors(i,2) < 6 Then colors(i,2) = 6
                
                If colors(i,0) > 249 Then colors(i,0) = 249
                If colors(i,1) > 249 Then colors(i,1) = 249
                If colors(i,2) > 249 Then colors(i,2) = 249
                
                Color colors(i,0)*fade,colors(i,1)*fade,colors(i,2)*fade
                Line 0,i,width,i
            Next i
        Case 1
            For i=height To 1 Step -1
            
                If i = Int(setline#) Or i = Int(setline2#) Or i = Int(setline3#) Then 
                    power(i,0) = Rnd(-PowerS,PowerS)
                    power(i,1) = Rnd(-PowerS,PowerS)
                    power(i,2) = Rnd(-PowerS,PowerS)
                End If
                
                colors(i,0)=colors(i-1,0)+power(i,0)
                colors(i,1)=colors(i-1,1)+power(i,1)
                colors(i,2)=colors(i-1,2)+power(i,2)
                
                If colors(i,0) < 6 Then colors(i,0) = 6
                If colors(i,1) < 6 Then colors(i,1) = 6
                If colors(i,2) < 6 Then colors(i,2) = 6
                
                If colors(i,0) > 249 Then colors(i,0) = 249
                If colors(i,1) > 249 Then colors(i,1) = 249
                If colors(i,2) > 249 Then colors(i,2) = 249
                
                Color colors(i,0)*fade,colors(i,1)*fade,colors(i,2)*fade
                Line 0,i,width,i
            Next i
        End Select
        
        SetLine# = setline# + UnitPerSec(80)
        SetLine2# = setline2# + UnitPerSec(100)
        SetLine3# = setline3# + UnitPerSec(120)
        If setline# > height Then setline = 0
        If setline2# > height Then setline2 = 0
        If setline3# > height Then setline3 = 0
        
        Return
        
LowQualityRender:

    If fade# < 1.0 Then fade# = fade# + UnitPerSec(1)
    If fade# > 1.0 Then fade# = 1

    QRat = LowQ*2

    Select dir
            Case 0
                For i=1 To height/Qrat + 1
                
                    If i = Int(setline#) Or i = Int(setline2#) Or i = Int(setline3#) Then 
                        power(i,0) = Rnd(-PowerS,PowerS)
                        power(i,1) = Rnd(-PowerS,PowerS)
                        power(i,2) = Rnd(-PowerS,PowerS)
                    End If
                    
                    colors(i,0)=colors(i+1,0)+power(i,0)
                    colors(i,1)=colors(i+1,1)+power(i,1)
                    colors(i,2)=colors(i+1,2)+power(i,2)

                    If colors(i,0) < 6 Then colors(i,0) = 6
                    If colors(i,1) < 6 Then colors(i,1) = 6
                    If colors(i,2) < 6 Then colors(i,2) = 6
                    
                    If colors(i,0) > 249 Then colors(i,0) = 249
                    If colors(i,1) > 249 Then colors(i,1) = 249
                    If colors(i,2) > 249 Then colors(i,2) = 249
                    
                    Color colors(i,0)*fade,colors(i,1)*fade,colors(i,2)*fade
                    Box 0,i*Qrat,width,Qrat,1
                Next i
            Case 1
                For i = height/Qrat + 1 To 1 Step -1
                
                    If i = Int(setline#) Or i = Int(setline2#) Or i = Int(setline3#) Then 
                        power(i,0) = power(i,0) + Rnd(-PowerS,PowerS)
                        power(i,1) = power(i,1) + Rnd(-PowerS,PowerS)
                        power(i,2) = power(i,2) + Rnd(-PowerS,PowerS)
                    End If

                    colors(i,0)=colors(i-1,0)+power(i,0)
                    colors(i,1)=colors(i-1,1)+power(i,1)
                    colors(i,2)=colors(i-1,2)+power(i,2)

                    If colors(i,0) < 6 Then colors(i,0) = 6
                    If colors(i,1) < 6 Then colors(i,1) = 6
                    If colors(i,2) < 6 Then colors(i,2) = 6
                    
                    If colors(i,0) > 249 Then colors(i,0) = 249
                    If colors(i,1) > 249 Then colors(i,1) = 249
                    If colors(i,2) > 249 Then colors(i,2) = 249
                    
                    Color colors(i,0)*fade,colors(i,1)*fade,colors(i,2)*fade
                    Box 0,i*Qrat,width,Qrat,1
                Next i
            End Select
            
            SetLine# = setline# + UnitPerSec(80)
            SetLine2# = setline2# + UnitPerSec(100)
            SetLine3# = setline3# + UnitPerSec(120)
            If setline# > height / Qrat Then setline = 0
            If setline2# > height / Qrat Then setline2 = 0
            If setline3# > height / Qrat Then setline3 = 0
Return

Kyseessä on siis eräänlainen "horisontti efekti"...

Posted: **Sun Nov 16, 2008 5:32 pm**

Wau! Tuota vesiefektiä voisin käyttää bullet-timessä uusimmassa FurySoldier pelissäni, joka on kohta valmis.

Posted: **Mon Nov 17, 2008 6:26 pm**

Kun vaihdoin tuon funktion toiseen koodiin niin CB rupesi valittamaan ettei Step komennossa voi käyttää muuttujaa.

EDIT:

Jaah nyt toimii..

Posted: **Sun Nov 30, 2008 1:00 pm**

Oli tylsää joten tein tällaisen piikkipallo function:

Code: Select all

AddText "Q ja A muuttavat kokoa"
AddText "W ja S muuttavat piikkien kokoa"
AddText "E ja D vaihtavat piikkien määrää"
AddText "R ja F muuttavat kulmaa"

s=100
m=5
p=60
a=0

  Repeat
    SpikeBall(200,150,s,m,p,a)
    
    s=s+KeyDown(cbkeyq)-KeyDown(cbkeya)
    m=m+KeyUp(cbkeye)-KeyUp(cbkeyd)
    p=p+KeyDown(cbkeyw)-KeyDown(cbkeys)
    a=a+KeyDown(cbkeyr)-KeyDown(cbkeyf)
    
    DrawScreen
  Forever 

Function SpikeBall(x, y, s, m, p, a=0)
m=m*2
Al=s
Lo=s-p
   For i = 1 To m
      Line x + Cos(i * 360 / m + a) * Al, y - Sin(i * 360 / m + a) * Al, x + Cos((i + 1) * 360 / m + a) * Lo, y - Sin((i + 1) * 360 / m + a) * Lo
   
        If Al=s Then 
          Al=s-p
          Lo=s
        Else
          Al=s
          Lo=s-p
        EndIf 
   Next i
EndFunction

Posted: **Sun Nov 30, 2008 3:58 pm**

Ascii räjähdyksiä : P

Code: Select all

Type ASCII
    Field parletter$
    Field parx
    Field pary
    Field parangle
    Field ParDis#
    Field MaxDis#
    Field ParSpeed#
EndType 

Repeat

If MouseHit(1) Then CreateAsciiExplosion(MouseX(),MouseY(),200,20,23)
UpdateAsciiExplosions()

DrawScreen

Forever 


Function CreateAsciiExplosion(x,y,maxdistance,par,speed#,spread=0)
For i=1 To par
    uusi.ASCII = New(ASCII)
    uusi\parletter = Chr(Rand(35,38))
    uusi\parangle = Rand(359)
    uusi\Pardis=Rand(spread)
    uusi\parx = X
    uusi\pary = Y
    uusi\Maxdis = Maxdistance
    uusi\ParSpeed = Speed
Next i
EndFunction 

Function UpdateAsciiExplosions()
For uusi.ASCII = Each ASCII
    uusi\Pardis=CurveValue(uusi\Maxdis,uusi\Pardis,uusi\parspeed)
    If uusi\pardis>uusi\maxdis-1 Then Delete uusi
    Text uusi\parx+Cos(uusi\parangle)*uusi\Pardis,uusi\pary-Sin(uusi\parangle)*uusi\pardis,uusi\ParLetter
Next uusi
EndFunction

Posted: **Sun Nov 30, 2008 4:39 pm**

DatsuniG wrote:Ascii räjähdyksiä : P
Code: Select all
koodia 
    

Pätkii ärsyttävästi

CoolBasic Forums

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

Re: Efektit

Re: Efektit