Dark Bit Factory & Gravity

PROGRAMMING => Freebasic => Topic started by: Clyde on October 04, 2007

Title: Gradient Backdrop
Post by: Clyde on October 04, 2007

Heres an example of how you can do gradient backdrops.

Code: [Select]

'
' Gradient Backdrop.
'

Option Static
Option Explicit

#Include Once "Tinyptc.bi"
#Include Once "Windows.bi"

Const XRES=640
Const YRES=480

Const XRES2=XRES/2
Const YRES2=YRES/2

Const PI = 3.141593
Const R2D=(PI/180)

Const ARES=XRES*YRES

Dim Shared ScreenBuffer( ARES )


Declare Sub InitializeExample()

Declare Sub Rect( ByVal xpos  As Integer,_
                  ByVal ypos  As Integer,_
                  ByVal SizeX As Integer,_
                  ByVal SizeY As Integer,_
                  ByVal Col   As integer=&HFFFFFF )

Declare Sub RunExample()



InitializeExample()
RunExample()
Ptc_Close()


Sub InitializeExample()
   
    If( ptc_open( "Gradient Backdrop", XRES, YRES ) = 0 ) Then
End -1                                   
End if

End Sub


Sub Rect( ByVal xpos As Integer, ByVal ypos As Integer, ByVal SizeX As Integer, ByVal SizeY As Integer, ByVal Col As integer=&HFFFFFF )
   
    Dim x,y
   
    For y=0 to SizeY-1
        for x=0 to SizeX-1
       
            ScreenBuffer( ( y+(ypos*SizeY)) * XRES + ( x+(Xpos*SizeX) ) ) = col
     
        Next
    Next
           
End Sub


Sub RunExample()

    Dim Key As String
   
    Dim x, y, Red, Grn, Blu, Col
   
    While Key<>Chr(27)
       
        For Y = 0 To YRES-1
       
            Red=Y*255/XRES
            Grn=0
            Blu=Y*128/XRES
       
            Col=( Red Shl 16 ) Or ( Grn Shl 8 ) Or ( Blu Shl 0 )
       
            Rect ( 0, Y, XRES, 1, Col )

        Next
       
        Ptc_Update @ScreenBuffer(0)
       
        Erase ScreenBuffer
       
        Key=Inkey()
       
    Wend
   
End Sub


Title: Re: Gradient Backdrop
Post by: DrewPee on October 05, 2007

Lovely - nice and fast - wicked Clyde!

Drew

Title: Re: Gradient Backdrop
Post by: Shockwave on October 05, 2007

K+ for the nice gradient colours mate :)

Had you thought of using pointers to do this? It can be implimented very quickly and runs a lot faster... Hope you don't mind, I only altered a few lines of code.

Code: [Select]

'
' Gradient Backdrop.
'

Option Static
Option Explicit

#Include Once "Tinyptc.bi"
#Include Once "Windows.bi"

Const XRES=640
Const YRES=480

Const XRES2=XRES/2
Const YRES2=YRES/2

Const PI = 3.141593
Const R2D=(PI/180)

Const ARES=XRES*YRES

Dim Shared ScreenBuffer( ARES )


Declare Sub InitializeExample()

Declare Sub Rect( ByVal xpos  As Integer,_
                  ByVal ypos  As Integer,_
                  ByVal SizeX As Integer,_
                  ByVal SizeY As Integer,_
                  ByVal Col   As integer=&HFFFFFF )

Declare Sub RunExample()



InitializeExample()
RunExample()
Ptc_Close()


Sub InitializeExample()
   
    If( ptc_open( "Gradient Backdrop", XRES, YRES ) = 0 ) Then
End -1                                   
End if

End Sub


Sub Rect( ByVal xpos As Integer, ByVal ypos As Integer, ByVal SizeX As Integer, ByVal SizeY As Integer, ByVal Col As integer=&HFFFFFF )
   
    Dim x,y
    dim as uinteger ptr pp1
   
    For y=0 to SizeY-1
       
        pp1=@screenbuffer( ( y+(ypos*SizeY)) * XRES + ( x+(Xpos*SizeX) ) )
       
        for x=0 to SizeX-1
           
            *pp1 = col
             pp1+=1   
             
        Next
    Next
           
End Sub


Sub RunExample()

    Dim Key As String
   
    Dim x, y, Red, Grn, Blu, Col
   
    While Key<>Chr(27)
       
        For Y = 0 To YRES-1
       
            Red=Y*255/XRES
            Grn=0
            Blu=Y*128/XRES
       
            Col=( Red Shl 16 ) Or ( Grn Shl 8 ) Or ( Blu Shl 0 )
       
            Rect ( 0, Y, XRES, 1, Col )

        Next
       
        Ptc_Update @ScreenBuffer(0)
       
        Erase ScreenBuffer
       
        Key=Inkey()
       
    Wend
   
End Sub


Title: Re: Gradient Backdrop
Post by: Clyde on October 05, 2007

Thanks DrewPee and Shockwave :)