Screensaver

[Dr_Davenstein]

This is very similar to something I made in QB. I just made a version in FB to test the speed. Needless to say, FB is awesome.

Code:

#Include "Fbgfx.bi"
Randomize Timer
Using FB


Const False As Integer = 0
Const True As Integer = Not False
Const Cir_Cnt As Integer = 150
Const SCR_WIDTH As Integer = 320
Const SCR_HEIGHT As Integer = 240
Const BPP As Integer = 32

Screenres SCR_WIDTH, SCR_HEIGHT, BPP,2', 1
Screenset 0,1

Setmouse 0,0,0

Type Point2D
    X As Integer
    Y As Integer
End Type


Type Circles
    P As Point2d
    Rad As Integer
    Hill_Hole As Byte
End Type

Type Colors
    As Integer R, G, B
End Type

Declare Function Vec_2D_Dist( Byval vA As Point2D, Byval vB As Point2D) As Integer
Declare Sub Blur_Buffer( Byval Buffer As Colors Ptr Ptr, Byref tBuffer As Colors Ptr Ptr, Byval Strength As Integer )

Dim As Circles Cir(CIR_CNT)
Dim As Integer i, X, Y, R, G, B, All_Colors_Match, Dist, Work_Page
Dim As Colors Ptr Ptr Buffer, tBuffer, Scr_Buffer
Dim As Point2D tVec

Buffer  = Callocate(SCR_WIDTH * Sizeof(Colors) )
tBuffer = Callocate(SCR_WIDTH * Sizeof(Colors) )
Scr_Buffer = Callocate(SCR_WIDTH * Sizeof(Colors) )

For X = 0 To SCR_WIDTH-1
    Buffer[X]  = Callocate(SCR_Height * Sizeof(Colors) )
    tBuffer[X] = Callocate(SCR_Height * Sizeof(Colors) )
    Scr_Buffer[X] = Callocate(SCR_Height * Sizeof(Colors) )
Next


Do
    
    For i= 0 To Ubound(Cir)
        Cir(i).P.X = Rnd*SCR_WIDTH
        Cir(i).P.Y = Rnd*SCR_HEIGHT
        Cir(i).Rad = 25+(Rnd*150)
        Select Case Int(Rnd*2)
        Case 0
            Cir(i).Hill_Hole = 1
        Case 1
            Cir(i).Hill_Hole = -1
        End Select
    Next
    
    
    For Y = 0 To SCR_HEIGHT-1
        For X = 0 To SCR_WIDTH-1
            tVec.Y = Y
            tVec.X = X
            R = 0
            G = 128
            B = 0
            For i = 0 To Ubound(Cir)
                Dist = Vec_2D_Dist( Cir(i).P, tVec )
                If Dist<=Cir(i).Rad Then
                    G += (((Cir(i).Rad-Dist))*Cir(i).Hill_Hole)
                End If
            Next
            
            If G<0 Then G=0
            If G>255 Then G=255
            
            If G<=68 And G>=64 Then
                R = 128
                G = 128
                B = 255
            End If
            
            If G<64 Then
                B = G+Int(Rnd*64)
                R = 0
                G = 0
            End If
            
            If Int(Rnd*2)=0 Then
                If B<G Then
                    G\=1.75
                    R=G\2.042553191489362
                    B=G\5.05263157894737
                End If
            End If
            
            Scr_Buffer[X][Y].R = R
            Scr_Buffer[X][Y].G = G
            Scr_Buffer[X][Y].B = B
            If Multikey(Sc_Escape) Then End
        Next
    Next
    
    Blur_Buffer Scr_Buffer, tBuffer, 1
    
    
    
    Do
        Screenset Work_Page, Work_page Xor 1
        ScreenSync
        Screenlock
        All_Colors_Match = True
        For Y = 0 To SCR_HEIGHT-1
            For X = 0 To SCR_WIDTH-1
                
                Buffer[X][Y].R+=Sgn(tBuffer[X][Y].R-Buffer[X][Y].R)
                Buffer[X][Y].G+=Sgn(tBuffer[X][Y].G-Buffer[X][Y].G)
                Buffer[X][Y].B+=Sgn(tBuffer[X][Y].B-Buffer[X][Y].B)
                
                If tBuffer[X][Y].R<>Buffer[X][Y].R Or tBuffer[X][Y].G<>Buffer[X][Y].G Or tBuffer[X][Y].B<>Buffer[X][Y].B Then
                    All_Colors_Match = False
                End If
                
                Pset(X,Y), Rgb(Buffer[X][Y].R, Buffer[X][Y].G, Buffer[X][Y].B)
                If Multikey(Sc_Escape) Then End
            Next
        Next
        Screenunlock
        Work_Page Xor = 1
    Loop Until All_Colors_Match
Loop Until Multikey(Sc_Escape)





For X = 0 To SCR_WIDTH-1
    Deallocate Buffer[X]
    Deallocate tBuffer[X]
    Deallocate Scr_Buffer[X]
Next
Deallocate Buffer
Deallocate tBuffer
Deallocate Scr_Buffer

End



Private Sub Blur_Buffer( Byval Buffer As Colors Ptr Ptr, Byref tBuffer As Colors Ptr Ptr, Byval Strength As Integer )
    Dim As Integer X, Y, X1, Y1, XBeg, XFin, YBeg, YFin, Hits, R, G, B
    
    For Y = 0 To SCR_HEIGHT-1
        For X = 0 To SCR_WIDTH-1
            R=0
            G=0
            B=0
            Hits = 0
            XBeg = X-Strength
            If XBeg<0 Then XBeg=0
            YBeg = Y-Strength
            If YBeg<0 Then YBeg=0
            
            XFin = X+Strength
            If XFin>SCR_WIDTH-1 Then XFin=SCR_WIDTH-1
            YFin = Y+Strength
            If YFin>SCR_HEIGHT-1 Then YFin=SCR_HEIGHT-1
            Hits = (((XFin-XBeg)+1)*((YFin-YBeg)+1))
            
            For Y1 = YBeg To YFin
                For X1 = XBeg To XFin
                    R+= Buffer[X1][Y1].R
                    G+= Buffer[X1][Y1].G
                    B+= Buffer[X1][Y1].B
                Next
            Next
            If Hits=0 Then Hits=1
            R\=Hits
            G\=Hits
            B\=Hits
            tBuffer[X][Y].R = R
            tBuffer[X][Y].G = G
            tBuffer[X][Y].B = B
        Next
    Next
    
End Sub


Private Function Vec_2D_Dist(Byval vA As Point2D, Byval vB As Point2D) As Integer
    Dim DX As Integer, _
    DY As Integer ,_
    Dist As Integer, _
    tD As Integer
    
    DX = (Va.X - Vb.X)
    DY = (Va.Y - Vb.Y)
    tD = Dx*Dx+Dy*Dy
    
    Dist = Sqr(tD)
    Function = Dist
End Function

This one requires an image, so I put it in a zip. It actually does look lie a screensaver.
http://qbnz.com/dr_davenstein/flag.zip