fb:porticula NoPaste
schimmel2.bas
Uploader: | ThePuppetMaster |
Datum/Zeit: | 28.03.2009 15:10:36 |
Dim G_Width as UInteger = 640
Dim G_Height as UInteger = 480
Dim X as UInteger
Dim Y as UInteger
Dim XV as UInteger
Dim VR as UByte
Dim VG as UByte
Dim VB as UByte
Dim XTot as Double
Dim XNT as Double
Dim XMX as Integer
Dim XMY as Integer
Dim XMZ as Integer
Dim XMB as Integer
screenres G_Width, G_Height, 32
Dim G_SCImg as Any Ptr = ImageCreate(G_Width, G_Height)
Dim G_SCDat as Any Ptr
dim G_SCPitch as Integer
Imageinfo(G_SCImg , , , , G_SCPitch, G_SCDat)
Dim TRow As UInteger Ptr
line G_SCImg, (0, 0)-(G_Width,G_Height), RGB(255, 255, 255), BF
XTot = Timer() + 1
do
If XTot < Timer() Then
ScreenLock
For Y = 0 to G_Height - 1
TRow = G_SCDat + Y * G_SCPitch
For X = 0 to G_Width - 1
XV = &HFFFFFF and TRow[X]
VB = XV and 255
VG = (XV shr 8) and 255: XV shr= 16
VR = XV and 255
If VG < 255 Then
IF VG = 254 Then
If VR > 0 Then
VR -= 1
VB -= 1
Else: VG -= 1
End If
Else: If VG > 0 Then VG -= 1
End If
TRow[X] = RGB(VR, VG, VB) 'XV
If Int((Rnd * 50) + 1) = 1 Then
XMX = Int((Rnd * 7) + 1) + X - 3
XMY = Int((Rnd * 7) + 1) + Y - 3
If XMY < 0 Then XMY = 0
If XMY > G_Height Then XMY = G_Height
If XMX < 0 Then XMX = 0
If XMX > G_Width Then XMX = G_Width
If (&HFFFFFF and *Cast(UInteger Ptr, ((G_SCDat + XMY * G_SCPitch) + (XMX * 4)))) = &HFFFFFF Then
*Cast(UInteger Ptr, ((G_SCDat + XMY * G_SCPitch) + (XMX * 4))) = &HFFFEFF
End If
End If
End If
Next
Next
ScreenUnLock
XTot = Timer() + 0.02
End If
If GetMouse(XMX, XMY, XMZ, XMB) = 0 Then
If XMB > 0 Then
If XMY < 0 Then XMY = 0
If XMY > G_Height Then XMY = G_Height
If XMX < 0 Then XMX = 0
If XMX > G_Width Then XMX = G_Width
If (&HFFFFFF and *Cast(UInteger Ptr, ((G_SCDat + XMY * G_SCPitch) + (XMX * 4)))) = &HFFFFFF Then *Cast(UInteger Ptr, ((G_SCDat + XMY * G_SCPitch) + (XMX * 4))) = &HFFFEFF
End If
End If
Put (0, 0), G_SCImg, PSET
sleep 1, 1
Loop until InKey() = Chr(27)
screen 0