Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

schimmel2.bas

Uploader:MitgliedThePuppetMaster
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