Efektit

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Koodiapina
Forum Veteran
Posts: 2396
Joined: Tue Aug 28, 2007 4:20 pm

Re: Efektit

Post by Koodiapina »

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?
nevssons
Devoted Member
Posts: 503
Joined: Sun Jan 13, 2008 5:02 pm

Re: Efektit

Post by nevssons »

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:

Code: Select all

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! :)
Attachments
ss.rar
(585.82 KiB) Downloaded 425 times
Last edited by nevssons on Sat Nov 08, 2008 2:04 pm, edited 1 time in total.
Koodarina kohtalainen, henkilönä vittumainen
Image
phons
Guru
Posts: 1056
Joined: Wed May 14, 2008 10:11 am

Re: Efektit

Post by phons »

Miten sen exe:n muka saa .scr:ksi
Image
TheFish
Developer
Developer
Posts: 477
Joined: Mon Aug 27, 2007 9:28 pm
Location: Joensuu

Re: Efektit

Post by TheFish »

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ä.
CoolBasic henkilökuntaa
Kehittäjä
Igr0
Active Member
Posts: 110
Joined: Thu Oct 02, 2008 8:04 pm
Location: Helsinki, Finland

Re: Efektit

Post by Igr0 »

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... :roll:
(Mulla on sitte käyttiksenä Vista)
lukutoukka
Active Member
Posts: 111
Joined: Fri Jun 13, 2008 9:06 pm

Re: Efektit

Post by lukutoukka »

no laita se vain näytönsäästäjäksi ehkä sieltä asetuksista (en ole mikään paras tässä asiassa neuvomaan...)
nevssons
Devoted Member
Posts: 503
Joined: Sun Jan 13, 2008 5:02 pm

Re: Efektit

Post by nevssons »

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... :roll:
(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ä.
Koodarina kohtalainen, henkilönä vittumainen
Image
Igr0
Active Member
Posts: 110
Joined: Thu Oct 02, 2008 8:04 pm
Location: Helsinki, Finland

Re: Efektit

Post by Igr0 »

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. :)
LarpaZ
Newcomer
Posts: 2
Joined: Tue Nov 11, 2008 5:08 pm

Re: Efektit

Post by LarpaZ »

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    
User avatar
Ruuttu
Devoted Member
Posts: 688
Joined: Thu Aug 30, 2007 5:11 pm
Location: Finland, Sipoo

Re: Efektit

Post by Ruuttu »

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.

Last edited by Ruuttu on Fri Jul 24, 2009 3:37 pm, edited 2 times in total.
KilledWhale
Tech Developer
Tech Developer
Posts: 545
Joined: Sun Aug 26, 2007 2:43 pm
Location: Liminka

Re: Efektit

Post by KilledWhale »

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ä :shock:
CoolBasic henkilökuntaa
Kehittäjä

cbFUN Kello
cbSDL
Whale.dy.fi

<@cce> miltäs tuntuu olla suomen paras
JATothrim
Tech Developer
Tech Developer
Posts: 606
Joined: Tue Aug 28, 2007 6:46 pm
Location: Kuopio

Re: Efektit

Post by JATothrim »

:shock: 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.
-On selkeästi impulsiivinen koodaaja joka...
ohjelmoi C++:lla rekursiivisesti instantioidun templaten, jonka jokainen instantiaatio instantioi sekundäärisen singleton-template-luokan, jonka jokainen instanssi käynistää säikeen tulostakseen 'jea'.
=Joku=
Active Member
Posts: 184
Joined: Mon Aug 04, 2008 2:26 am

Re: Efektit

Post by =Joku= »

Ef.1 oli niin aito että!
Sinertävyyttä niin vois lisää vaikka jophonkin gta1 kopioon.
*Poistunut foorumilta*
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Efektit

Post by DatsuniG »

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 
Hengität nyt manuaalisesti.
User avatar
Ruuttu
Devoted Member
Posts: 688
Joined: Thu Aug 30, 2007 5:11 pm
Location: Finland, Sipoo

Re: Efektit

Post by Ruuttu »

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". :D 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"...
Last edited by Ruuttu on Fri Jul 23, 2010 9:51 pm, edited 1 time in total.
User avatar
Substance
Active Member
Posts: 234
Joined: Fri Mar 14, 2008 5:48 pm

Re: Efektit

Post by Substance »

Wau! Tuota vesiefektiä voisin käyttää bullet-timessä uusimmassa FurySoldier pelissäni, joka on kohta valmis.
Substance aka LittleGreen
Red Encounter - shoot'em uppia - lataus
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Efektit

Post by MaGetzUb »

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

Jaah nyt toimii..

Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.
nevssons
Devoted Member
Posts: 503
Joined: Sun Jan 13, 2008 5:02 pm

Re: Efektit

Post by nevssons »

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 
Koodarina kohtalainen, henkilönä vittumainen
Image
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Efektit

Post by DatsuniG »

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 
    
    
    
Last edited by DatsuniG on Tue Dec 02, 2008 5:22 pm, edited 1 time in total.
Hengität nyt manuaalisesti.
nevssons
Devoted Member
Posts: 503
Joined: Sun Jan 13, 2008 5:02 pm

Re: Efektit

Post by nevssons »

DatsuniG wrote:Ascii räjähdyksiä : P

Code: Select all

koodia 
    
Pätkii ärsyttävästi
Koodarina kohtalainen, henkilönä vittumainen
Image
Post Reply