Qbasicnews.com

I was bored again and decided to start messing around with FB's gfx. Here's a good fading routine.
Comments to make better please.
[syntax="FB"]

screen 19, 32
'===================Must Have Between '='s====================
Declare Function Screen_Copy(Screen_Val() As Any, X1, Y1, X2, Y2, Trans)
Declare Function Screen_Fade(Screen_Val() As Any, Func, Delay, Grad)
' --------------------Explain----------------------------------
'|Screen_Copy|
' -----------
' -A Function to copy an area of the screen and store it in the spec. array.
' Syntax:
' Screen_Copy Screen_Val(), X1, Y1, X2, Y2, Trans
' Screen_Val() is a 1D array of Screen_Type To store the info to
' X1, Y1 Is The First diagonal corner of the area to copy
' X2, Y2 Is The Second diagonal corner of the area to copy
' Trans let it = 0 to copy all pixels, non 0 (ie. 1) in order to skip
' pixel values that are 0 (Black)
' Notes:
' You use this in order to use the fade routines. The area corners can be any
' two opposite corners of an area. Basically your copying an area of the
' current work page to fade later on. Lettin trans = non 0 will make it so
' that the fading wont erase the existing pixels if the copied pixels = 0
' (Black). Also it makes the fading go faster.(Recommended unless you want
' All balck pixels to show).
' --------------------------------------------------------------
'|Screen_Fade|
' -----------
' -A Function to fade an array loaded by the Screen_Copy Fn
' Syntax:
' Screen_Fade Screen_Val(), Func, Delay, Grad
' Screen_Val() is a 1D array of Screen_Type that you copied from the
' screen using the Screen_Copy Fn which has the data stored that you
' want to use to fade with
' Func is an Integer value which has values 0 and non-0, 0 is to fade in
' the pixel data from the array starting with &h000000 (Black).
' Any non0 value (ie. 1) will cause it to fade out starting with
' putting the original color values to the screen and ending with
' &h000000 (Black).
' Delay is how long to pause the program between each fade loop. ie. Your
' Image will fade faster if you put a lower number. The unit is in
' Seconds. The accuracy is up to a millisecond (.001).
' Grad is how many fade loops to do. ie. a lower number will make the
' change take a shorter time but more choppier, and a higher number
' will make a more smoother fade but will take a longer time.
' Notes:
' Use this to fade in and out from the array that you copied from the
' Screen_Copy Fn. It will fade in the same location as where you copied it.
' The wider the area that you copied the slower it will take it. So change the
' Delay and the Grad according to how big of an area you took. I recommend
' coping only the area you want to be faded.
Type Screen_Type
flag As Integer
x As Integer
y As Integer
RR As Integer
GG As Integer
BB As Integer
RRv As Integer
GGv As Integer
BBv As Integer
End Type
Redim Screen_Val(0) As Screen_Type
'=========================================================
'--------------Test---------------------------------------
Color &hff00ff, &h0000ff: Locate 2, 3: Print "Good Night"
Color &hffffff, &h000000
Circle (399,299), 150, &hc0c0c0,,,,F
Line (0, 0) - (799, 599), RGB(Int(Rnd*(255-1+1)+1), Int(Rnd*(255-1+1)+1), Int(Rnd*(255-1+1)+1))
Line (799, 0) - (0, 599), RGB(Int(Rnd*(255-1+1)+1), Int(Rnd*(255-1+1)+1), Int(Rnd*(255-1+1)+1))
'------------Get Whole Screen-----------------------------
Screen_Copy Screen_Val(), 0, 0, 799, 599, 1
Sleep
Cls
'-----------Fade In At .005 Delay + 40 Grads-----------
Screen_Fade Screen_Val(), 0, .005, 40
'-----------Fade Out At Fastest Delay + 40 Grads-----
Screen_Fade Screen_Val(), 1, .001, 40
Sleep


'---Put These functions as they are in your code-----
Function Screen_Copy (Screen_Val() As Screen_Type, X1, Y1, X2, Y2, Trans)
If X1 > X2 Then Swap X1, X2
If Y1 > Y2 Then Swap Y1, Y2
index% = 0
For i% = Y1 To Y2
For j% = X1 To X2
If Trans <> 0 Then If Point(j%, i%) <> 0 Then index% = index% + 1
If Trans = 0 Then index% = index% + 1
Next j%
Next i%
Redim Screen_Val(index%) As Screen_Type
index% = 0
Screen_Val(0).flag = 1
For i% = Y1 To Y2
For j% = X1 To X2
Value = Point(j%,i%)
If Trans <> 0 Then
If Value <> 0 Then
index% = index% + 1
Screen_Val(index%).x = j%
Screen_Val(index%).y = i%
Screen_Val(index%).RR = Int(Value / 65536)
Value = (Value Mod 65536)
Screen_Val(index%).GG = Int(Value / 256)
Value = (Value Mod 256)
Screen_Val(index%).BB = Value
End If
Else
index% = index% + 1
Screen_Val(index%).x = j%
Screen_Val(index%).y = i%
Screen_Val(index%).RR = Int(Value / 65536)
Value = (Value Mod 65536)
Screen_Val(index%).GG = Int(Value / 256)
Value = (Value Mod 256)
Screen_Val(index%).BB = Value
End If
Next j%
Next i%
End Function
Function Screen_Fade (Screen_Val() As Screen_Type, Func, Delay, Grad)
If Screen_Val(0).flag Then
For i% = 1 To Ubound(Screen_Val)
Screen_Val(i%).RRv = Int(Screen_Val(i%).RR / Grad)
Screen_Val(i%).GGv = Int(Screen_Val(i%).GG / Grad)
Screen_Val(i%).BBv = Int(Screen_Val(i%).BB / Grad)
Next i%
Dim Timei As Double
If Func = 0 Then j% = -1: Tway% = 1 Else j% = Grad + 1: Tway% = -1
Do
Timei = Timer
j% = j% + (1 * Tway%)
For i% = 1 To Ubound(Screen_Val)
Tx% = Screen_Val(i%).x
Ty% = Screen_Val(i%).y
TRR% = Screen_Val(i%).RRv * j%
TGG% = Screen_Val(i%).GGv * j%
TBB% = Screen_Val(i%).BBv * j%
Pset(Tx%, Ty%), RGB(TRR%, TGG%, TBB%)
Next i%
If Func = 0 Then If j% >= Grad Then Exit Do
If Func <> 0 Then If j% <= 0 Then Exit Do
Do: Loop While Timer - Timei < Delay
Loop
For i% = 1 To Ubound(Screen_Val)
Tx% = Screen_Val(i%).x
Ty% = Screen_Val(i%).y
If Func = 0 Then
TRR% = Screen_Val(i%).RR
TGG% = Screen_Val(i%).GG
TBB% = Screen_Val(i%).BB
End If
If Func <> 0 Then
TRR% = 0
TGG% = 0
TBB% = 0
End If
Pset(Tx%, Ty%), RGB(TRR%, TGG%, TBB%)
Next i%
End If
End Function

[/syntax]

Cool,.. can it fade out too?

Dude hey ya it can. Did you read it?

Screen_Fade Screen_Val(), 0, .005, 40 Fades it in at .005 delay and Grad 40.
Screen_Fade Screen_Val(), 1, .005, 40 Fades it out at .005 delay and Grad 40.

Yep. It does...heh, lol :lol:

To Mitth'raw'nuruodo:

Hello to you, and that 32-bit fade program of yours is some really cool work that can be so *pretty* useful for games and stuff, you know what I mean, man? !

The only one problem I had with your code was that I found out that it had an error in it on the final line of your program which was:

[syntax="FreeBASIC"]End[/syntax]

.....so, when I replaced it with...

[syntax="FreeBASIC"]End Function[/syntax]

.....then, when I compiled it, Mitth'raw'nuruodo, it *successfully* got done, and then the thing ran fine from there!

VERY NICE WORK ON THE ROUTINES, and talk to you again!! =b




- Adigun Azikiwe Polack
One of the Founders of “Aura Flow” ::: Continuing Developer of “Frantic Journey”
Current Developer of “Star Angelic Slugger” ::: Webmaster of the “AAP Official Projects Squad”
Original Creator of the “The New FreeBASIC 8-Bit Palette Machine”

thnx. :oops: That's what it should have been. 'End function'.

What I did was I used the built in converter from the FB's IDE to convert my code to BBcode and I just copied and pasted. I didn't noticed that it turned 'End Function' into 'End'...

Well, thnx. I was thinking that this could be good for making a title fade thing and even an RPG fade thing like when you switch screen's from like a top veiw walking thing to a side veiw talking to people thing and the other way around. Also I was thinking about using it for making a Menu thing. Could be cool.

If anyone could give any suggestions on how to make a better one so it can work well in certain situations please post it here.

fadegfx.bas(161) : error 40: Expected 'END SUB' or 'END FUNCTION'

Ok, thnx for pointing out my error again.

Here. On line 161 put a Funtion after the End on the same line So it says End Function and not End. :wink: