fb:porticula NoPaste

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

Uploader:	DonStevone
Datum/Zeit:	28.09.2011 18:56:13
'Zum Kompilieren siehe http://www.freebasic-portal.de/tutorials/bildschirmschoner-programmieren-11.html

'RadMAX gibt die maximale Größe und Geschwindigkeit an

'StarMAX gibt die maximale Anzahl an Sternen an (Sollte vllt je nach Auflösung angepasst werden)



#Define RadMAX 5

#Define BackgroundCol 0

#Define StarMAX 400



TYPE TimeControlUDT

    DECLARE CONSTRUCTOR(FPS AS INTEGER)

    DECLARE SUB ControlTime()



    PRIVATE:

    Temp1 AS DOUBLE

    StartTime AS DOUBLE

    DurchlaeufeS AS INTEGER

END TYPE



CONSTRUCTOR TimeControlUDT(FPS AS INTEGER)

    DurchlaeufeS = FPS

END CONSTRUCTOR



SUB TimeControlUDT.ControlTime()

    IF StartTime > 0 THEN

        Temp1 = INT(1000 - (TIMER - StartTime) * DurchlaeufeS)

        Temp1 = Temp1 \ DurchlaeufeS

        IF Temp1 > 0 THEN SLEEP Temp1, 1

    ENDIF

    StartTime = TIMER

END SUB



'###############################################################################

Type StarUDT

    X as Integer

    Y as Integer

    Rad as Byte

    Col as UByte



    Declare Sub G()

    Declare Sub GClear()

End Type



Sub StarUDT.G()

    Circle (X, Y), Rad, Col,,,, F

End Sub



Sub StarUDT.GClear()

    Circle (X, Y), RadMAX + 2, BackgroundCol,,,, F

End Sub



'###############################################################################



Declare Sub NewStar(ByRef Star2Change as StarUDT, Modus as Byte)



Dim as TimeControlUDT TC = TimeControlUDT(60)

Dim as StarUDT Star(1 to StarMAX)



Dim as Integer a

Dim as Integer X, Y, LX, LY

Dim as Byte Flag



Dim Shared as Integer DeskWidth, DeskHeight



If Command(1) = "" then END 0

If MID(Command(1), 2, 1) = "s" then

    ScreenControl 3, DeskWidth, DeskHeight

    Screenres Deskwidth, Deskheight,,, &h08

    ScreenControl 100, 0, 0

    SetMouse Deskwidth / 2, Deskheight / 2, 0



    For a = 1 to StarMAX

        NewStar(Star(a), 0)

    Next a



    While(NOT Multikey(&h01))

        GetMouse LX, LY

        Screenlock

            'Clear Stars

            For a = 1 to StarMAX

                Star(a).GClear()

            Next a

            For a = 1 to StarMAX

                'Steuerung

                Star(a).X = Star(a).X - Star(a).Rad

                If Star(a).X < -RadMax - 1 then NewStar(Star(a), 1)

                'G

                Star(a).G()

            Next a

        Screenunlock



        TC.ControlTime()

        GetMouse X, Y

        If X > LX + 20 then END 0

        If X < LX - 20 then END 0

        If Y > LY + 20 then END 0

        If Y < LY - 20 then END 0

        If Flag = 0 then Sleep 25

        Flag = 1

    Wend

Endif







'###############################################################################

Sub NewStar(ByRef Star2Change as StarUDT, Modus as Byte)

    If Modus = 0 then

        Star2Change.X   = (INT(RND * DeskWidth * 2) + 1)

    Else

        Star2Change.X   = (INT(RND * DeskWidth    ) + 1) + DeskWidth

    Endif

    Star2Change.Y   = INT(RND * DeskHeight) + 1

    Star2Change.Col = INT(RND * 255) + 1

    Star2Change.Rad = INT(RND * RadMax) + 1

End Sub