Etkös saa siitä näytönsäästäjän, kun buildaat exeksi ja vaihdat tiedostopäätteeksi .scr?On toi Atomimallin viivahärpäke hieno. Tollasen ku sais näytönsäästäjäks. :)
Efektit
-
- Forum Veteran
- Posts: 2396
- Joined: Tue Aug 28, 2007 4:20 pm
Re: Efektit
Re: Efektit
Pitäähän se laittaa kokoruudulle ja tehä sulkeutuminen kun jotain tapahtuu?Grandi wrote:Etkös saa siitä näytönsäästäjän, kun buildaat exeksi ja vaihdat tiedostopäätteeksi .scr?
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
Ole hyvä vaan!Igr0 wrote:On toi Atomimallin viivahärpäke hieno. Tollasen ku sais näytönsäästäjäks.
- Attachments
-
- ss.rar
- (585.82 KiB) Downloaded 427 times
Last edited by nevssons on Sat Nov 08, 2008 2:04 pm, edited 1 time in total.
Koodarina kohtalainen, henkilönä vittumainen
Re: Efektit
Miten sen exe:n muka saa .scr:ksi
Re: Efektit
Kirjoittamalla uuden tiedostopäätteen. Sinun luultavasti pitää muuttaa kansion asetuksista kohta "piilota tunnettujen tiedostotyyppien tunnisteet" pois käytöstä.phons wrote:Miten sen exe:n muka saa .scr:ksi
CoolBasic henkilökuntaa
Kehittäjä
Kehittäjä
Re: Efektit
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...nevssons wrote:Ole hyvä vaan!Igr0 wrote:On toi Atomimallin viivahärpäke hieno. Tollasen ku sais näytönsäästäjäks.
(Mulla on sitte käyttiksenä Vista)
-
- Active Member
- Posts: 111
- Joined: Fri Jun 13, 2008 9:06 pm
Re: Efektit
no laita se vain näytönsäästäjäksi ehkä sieltä asetuksista (en ole mikään paras tässä asiassa neuvomaan...)
Re: Efektit
Klikkaat sitä oikealla hiirennäppäimellä ja valitse asenna. Sitten valitse se tyhjä kohta "ei mitään" alapuolella ja valitse käytä.Igr0 wrote: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...nevssons wrote:Ole hyvä vaan!Igr0 wrote:On toi Atomimallin viivahärpäke hieno. Tollasen ku sais näytönsäästäjäks.
(Mulla on sitte käyttiksenä Vista)
Koodarina kohtalainen, henkilönä vittumainen
Re: Efektit
Kiitoksia neuvosta, nyt toimii, FPS on kyllä aluks aika low, mut se kyl tasottuu ku odottaa hetken.nevssons wrote:Klikkaat sitä oikealla hiirennäppäimellä ja valitse asenna. Sitten valitse se tyhjä kohta "ei mitään" alapuolella ja valitse käytä.
Re: Efektit
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
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
Re: Efektit
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.
-
- Tech Developer
- Posts: 545
- Joined: Sun Aug 26, 2007 2:43 pm
- Location: Liminka
Re: Efektit
On kyllä hienon näköinen ja todella nopeakin vielä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
CoolBasic henkilökuntaa
Kehittäjä
cbFUN Kello
cbSDL
Whale.dy.fi
<@cce> miltäs tuntuu olla suomen paras
Kehittäjä
cbFUN Kello
cbSDL
Whale.dy.fi
<@cce> miltäs tuntuu olla suomen paras
Re: Efektit
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...
Re: Efektit
Ef.1 oli niin aito että!
Sinertävyyttä niin vois lisää vaikka jophonkin gta1 kopioon.
Sinertävyyttä niin vois lisää vaikka jophonkin gta1 kopioon.
*Poistunut foorumilta*
Re: Efektit
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.
Re: Efektit
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.Kyseessä on siis eräänlainen "horisontti efekti"...
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
Last edited by Ruuttu on Fri Jul 23, 2010 9:51 pm, edited 1 time in total.
Re: Efektit
Wau! Tuota vesiefektiä voisin käyttää bullet-timessä uusimmassa FurySoldier pelissäni, joka on kohta valmis.
Re: Efektit
Kun vaihdoin tuon funktion toiseen koodiin niin CB rupesi valittamaan ettei Step komennossa voi käyttää muuttujaa.
EDIT:
Jaah nyt toimii..
Solar Eclipse
We're in a simulation, and God is trying to debug us.
Re: Efektit
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
Re: Efektit
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.
Re: Efektit
Pätkii ärsyttävästiDatsuniG wrote:Ascii räjähdyksiä : PCode: Select all
koodia
Koodarina kohtalainen, henkilönä vittumainen