Kätevää vaikkapa esim. peliin jossa kuvataan ufoja, jossa tämä olisi vain tehosteena, että voisi katsoa videopätkänsä
funkkareiden mukana myös pikku esimerkki
Code: Select all
Type RECORD
Field img
EndType
Dim enemy_x#(100)
Dim enemy_y#(100)
Dim enemy_plusx(100) As Float,enemy_plusy(100) As Float
Dim i As Integer
Dim angle As Integer
'First apply a random position for all enemies
For i=1 To 100
enemy_x(i)=Rand(390)
enemy_y(i)=Rand(290)
angle=Rand(360)
enemy_plusx(i)=Cos(angle)
enemy_plusy(i)=Sin(angle)
Next i
reload=15
'The main loop
Repeat
'update all enemies
For i=1 To 100
Color 0,255,0
'draw
Box enemy_x(i),enemy_y(i),10,10,OFF
'move
enemy_x(i)=enemy_x(i)+enemy_plusx(i)
enemy_y(i)=enemy_y(i)+enemy_plusy(i)
'bounce
If enemy_x(i)<0 Or enemy_x(i)>390 Then enemy_plusx(i)= -enemy_plusx(i)
If enemy_y(i)<0 Or enemy_y(i)>290 Then enemy_plusy(i)= -enemy_plusy(i)
Next i
Color cbRed
Box MouseX()-1,MouseY()-1,Min(MouseX()-1+100,400)-MouseX()+2,Min(MouseY()-1+70,300)-MouseY()+2,OFF
If MouseDown(1) Then VideoRecord(MouseX(),MouseY(),99,69)
If MouseDown(1) And reload>0 And g=0 Then Text 0,0,"Recording...":reload-1
If reload=0 Then g=1
If g Then reload+1
If reload=15 Then g=0
DrawScreen
Until KeyHit(28)
ClsColor cbSilver
rec.RECORD = First(RECORD)
play=1
Repeat
If TextBut(100,100,"Play",0,255,0,cbLightGreen) Then play=1
If TextBut(100,125,"Pause",0,255,0,cbLightGreen) Then play=0
If TextBut(100,150,"Stop",0,255,0,cbLightGreen) Then play=0:rec.RECORD = First(RECORD)
If rec.RECORD = Last(RECORD) And TextBut(100,100,"Play",0,255,0,cbLightGreen) Then rec.RECORD = First(RECORD)
DrawImage rec\img,0,0
If rec.RECORD<>Last(RECORD) And play=1 Then rec = After(rec)
DrawScreen
Forever
Function TextBut(x,y,txt$,r1,g1,b1,r2,g2,b2)
r=getRGB(RED)
g=getRGB(GREEN)
b=getRGB(BLUE)
x2=x-TextWidth(txt$)/2
y2=y-TextHeight(txt$)/2
If MouseX()>x2-1 And MouseX()<(x2+TextWidth(txt$))+1 And MouseY()>y2-1 And MouseY()<(y2+TextHeight(txt$))+1 Then
Color r2,g2,b2
gi=1
Else
Color r1,g1,b1
EndIf
CenterText x,y,txt$,2
If gi And MouseHit(1) Then Return 1
EndFunction
Function VideoRecord(x,y,w,h)
w = Min(x+w,ScreenWidth())-x
h = Min(y+h,ScreenHeight())-y
rec.RECORD = New(RECORD)
rec\img = MakeImage(w,h)
MaskImage rec\img,-255,-255,-255
CopyBox x,y,w,h,0,0,SCREEN(),Image(rec\img)
EndFunction EDIT:
muokkasin oletusikkunakokojen tilalle ikkunan nykyisen koon, nyt toimii myös omilla ikkunaleveyksillä 
<-- Outo päärynä ;/ Oikei ärsyttää
