Fade In & Out Tests

[bplus]

I have 3 ideas I'm testing for an effect of having a background image over which I want to Fade In and then Fade Out a Loaded Image.

Here is what @Cobalt  suggested, I probably did something wrong in applying the procedure but don't know what:

Code: QB64: [Select]

1. _Title "Fade In-Out Tests Cobalts suggestion" 'b+ 2021-10-04
2. ' Steve suggest: _SetAlpha alphaLevel255& [, color1&][ TO color2&] [, iHdl&]
3. ' bplus idea random fill overlapping at low to middle transparencey using Point probably very lumpy image
4. Screen _NewImage(120 * 8, 30 * 16, 32) ' current screen size for Halloween Crypt-O-Gram
5. fio& = _LoadImage("haunted heads.jpg", 32)
6. '_PutImage , fio&, 0 ' OK image works
7.  
8. ' make sample image
9. snap& = _NewImage(_Width, _Height, 32)
10. Cls
11. For i = 1 To _Width * _Height * .00035
12.     Line (Rnd * _Width, Rnd * _Height)-Step(Rnd * 50, Rnd * 50), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 255), BF
13. Next
14. _PutImage , 0, snap&
15. _Delay 2
16.  
17. '  Test Cobalt's suggestion
18. Dim Shared Layer(0 To 100) As Long ' <<<< Cobalt didn't mention this
19. 'Layer(0) = snap&  ' <<<<  un comment and just get background, comment and get back ground then only fade in of heads
20. Fade_In fio& ' where's my background image???
21.  
22.  
23. ' Fade_In, Fade_Out, DarkenImage From Cobalt 2021-10-04  https://www.qb64.org/forum/index.php?topic=4254.msg136319#msg136319
24. Sub Fade_Out (L&)
25.     For n! = 1 To 0.00 Step -0.05
26.         i2& = _CopyImage(L&)
27.         DarkenImage i2&, n!
28.         _PutImage (0, 0), i2&, Layer(0)
29.         _FreeImage i2&
30.         _Delay .06
31.     Next
32. End Sub
33.  
34. Sub Fade_In (L&)
35.     For n! = 0.01 To 1 Step 0.05
36.         i2& = _CopyImage(L&)
37.         DarkenImage i2&, n!
38.         _PutImage (0, 0), i2&, Layer(0)
39.         _FreeImage i2&
40.         _Delay .06
41.     Next
42. End Sub
43.  
44. Sub DarkenImage (Image As Long, Value_From_0_To_1 As Single)
45.     If Value_From_0_To_1 <= 0 Or Value_From_0_To_1 >= 1 Or _PixelSize(Image) <> 4 Then Exit Sub
46.     Dim Buffer As _MEM: Buffer = _MemImage(Image) 'Get a memory reference to our image
47.     Dim Frac_Value As Long: Frac_Value = Value_From_0_To_1 * 65536 'Used to avoid slow floating point calculations
48.     Dim O As _Offset, O_Last As _Offset
49.     O = Buffer.OFFSET 'We start at this offset
50.     O_Last = Buffer.OFFSET + _Width(Image) * _Height(Image) * 4 'We stop when we get to this offset
51.     'use on error free code ONLY!
52.     $Checking:Off
53.     Do
54.         _MemPut Buffer, O, _MemGet(Buffer, O, _Unsigned _Byte) * Frac_Value \ 65536 As _UNSIGNED _BYTE
55.         _MemPut Buffer, O + 1, _MemGet(Buffer, O + 1, _Unsigned _Byte) * Frac_Value \ 65536 As _UNSIGNED _BYTE
56.         _MemPut Buffer, O + 2, _MemGet(Buffer, O + 2, _Unsigned _Byte) * Frac_Value \ 65536 As _UNSIGNED _BYTE
57.         O = O + 4
58.     Loop Until O = O_Last
59.     'turn checking back on when done!
60.     $Checking:On
61.     _MemFree Buffer
62. End Sub
63.  
64.  
65.  
66.  

I either just get all background Or all background until Fade_IN applied then ONLY image fade in very fast.

[bplus]

Well this works so dang nice I don't even want to try the idea I had!

Code: QB64: [Select]

1. _Title "Fade In-Out Tests per Steve Test _SetAplpha" ' b+ 2021-10-04
2. ' Steve suggest: _SetAlpha alphaLevel255& [, color1&][ TO color2&] [, iHdl&]
3. ' bplus idea random fill overlapping at low to middle transparencey using Point probably very lumpy image
4. Screen _NewImage(120 * 8, 30 * 16, 32) ' current screen size for Halloween Crypt-O-Gram
5. fio& = _LoadImage("haunted heads.jpg", 32)
6. _PutImage , fio&, 0 ' OK image works
7. Print "Here is Image to Fade In-Out, zzz... press any"
8. Sleep
9.  
10. ' make sample image
11. snap& = _NewImage(_Width, _Height, 32)
12. Cls
13. For i = 1 To _Width * _Height * .00035
14.     Line (Rnd * _Width, Rnd * _Height)-Step(Rnd * 50, Rnd * 50), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 255), BF
15. Next
16. _PutImage , 0, snap&
17. Print "Here is background I want to Fade-In Image over, zzz... press any"
18. Sleep
19. Cls
20. FadeIn snap&, fio&, 7 ' well that works nicely
21. FadeOut snap&, fio&, 15
22.  
23. Sub FadeIn (BackHdl&, Img&, secs)
24.     'Here is Wiki on _SetAlpha
25.     'Syntax
26.     '_SETALPHA alpha&[, color1&][ TO colour2&] [, imageHandle&]
27.  
28.     'Parameters
29.     'alpha& is the new alpha level to set, ranging from 0 (transparent) to 255 (opaque).
30.     'color1& designates the 32-bit LONG color value or range of color values color1& TO colour2& to set the transparency.
31.     'If no color value or range of colors is given, the entire image's alpha is changed, including any _CLEARCOLOR settings.
32.     'If imageHandle& is omitted, it is assumed to be the current write page or destination image.
33.  
34.     'timing
35.     tf = Int(255 / secs) ' 255 image transparencies from 0 to 255 in secs seconds
36.     t = Timer(.001)
37.     For al& = 1 To 255
38.         _PutImage , BackHdl&, 0
39.         _SetAlpha al&, , Img&
40.         _PutImage , Img&, 0
41.         Locate 1, 1: Print Timer(1) - t
42.         _Display
43.         _Limit tf
44.     Next
45. End Sub
46.  
47. Sub FadeOut (BackHdl&, Img&, secs)
48.     tf = Int(255 / secs) ' 255 image transparencies from 0 to 255 in secs seconds
49.     t = Timer(.001)
50.     For al& = 254 To 0 Step -1
51.         _PutImage , BackHdl&, 0
52.         _SetAlpha al&, , Img&
53.         _PutImage , Img&, 0
54.         Locate 1, 1: Print Timer(1) - t
55.         _Display
56.         _Limit tf
57.     Next
58. End Sub
59.  
60.  

I think I have it!

[SMcNeill]

A simple set of routines to FadeIn an image and then FadeBack to the original screen:

Code: QB64: [Select]

1. Dim Shared Background
2.  
3. Screen _NewImage(1024, 720, 32)
4. 'draw a pretty screen
5. For i = 0 To 100
6.     Line (Rnd * 1024, Rnd * 720)-(Rnd * 1024, Rnd * 720), _RGB(Rnd * 256, Rnd * 256, Rnd * 256), BF
7. Next
8.  
9. 'now, create an image to fade in and out.  to keep it simple, I'm going to work with just a circle so I don't need external files
10. image = _NewImage(600, 600, 32)
11. _Dest image
12. Cls , 0
13. For i = 0 To 200 Step .25
14.     Circle (300, 300), i, _RGB32(255, 255, 0)
15. Next
16. _Dest 0
17.  
18.  
19. FadeIn 212, 60, image
20. FadeBack
21.  
22. Sub FadeIn (x, y, image)
23.     Background = _CopyImage(0) 'the background before we alter it with a fade in effect.
24.     PCopy 0, 1
25.     For i = 1 To 10 'ten steps, 1 per second for slowly visible fade in effect
26.         PCopy 1, 0
27.         temp = _CopyImage(image)
28.         _SetAlpha i * 25.5, &HFF000000&& To &HFFFFFFFF&&, temp
29.         _PutImage (x, y), temp
30.         _FreeImage temp
31.         _Display
32.         _Limit 1
33.     Next
34. End Sub
35.  
36. Sub FadeBack
37.     PCopy 0, 1
38.     For i = 1 To 10 'ten steps, 1 per second for slowly visible fade in effect
39.         PCopy 1, 0
40.         temp = _CopyImage(Background)
41.         _SetAlpha i * 25.5, &HFF000000&& To &HFFFFFFFF&&, temp
42.         _PutImage (x, y), temp
43.         _FreeImage temp
44.         _Display
45.         _Limit 1
46.     Next
47. End Sub
48.  

Now I'm not going for any smooth fade in and fade out effects here; I'm just shooting for something simple to showcase the _SETALPHA command.  All this does is take 10 seconds to slowly fade in a yellow circle onto the center of the screen, and then fadeout that circle over another 10 seconds.   It's one step of fading every second, so it's not a smooth transition here, but is instead one where you can visually watch each step along the way.  If I was going make this a smooth fade in and fade out, I'd probably do it with a much smoother FOR loop with a higher FPS limit, like so:

Code: QB64: [Select]

1. Dim Shared Background
2.  
3. Screen _NewImage(1024, 720, 32)
4. 'draw a pretty screen
5. For i = 0 To 100
6.     Line (Rnd * 1024, Rnd * 720)-(Rnd * 1024, Rnd * 720), _RGB(Rnd * 256, Rnd * 256, Rnd * 256), BF
7. Next
8.  
9. 'now, create an image to fade in and out.  to keep it simple, I'm going to work with just a circle so I don't need external files
10. image = _NewImage(600, 600, 32)
11. _Dest image
12. Cls , 0
13. For i = 0 To 200 Step .25
14.     Circle (300, 300), i, _RGB32(255, 255, 0)
15. Next
16. _Dest 0
17.  
18.  
19. FadeIn 212, 60, image
20. FadeBack
21.  
22. Sub FadeIn (x, y, image)
23.     Background = _CopyImage(0) 'the background before we alter it with a fade in effect.
24.     PCopy 0, 1
25.     For i = 1 To 255
26.         PCopy 1, 0
27.         temp = _CopyImage(image)
28.         _SetAlpha i, &HFF000000&& To &HFFFFFFFF&&, temp
29.         _PutImage (x, y), temp
30.         _FreeImage temp
31.         _Display
32.         _Limit 60
33.     Next
34. End Sub
35.  
36. Sub FadeBack
37.     PCopy 0, 1
38.     For i = 1 To 255
39.         PCopy 1, 0
40.         temp = _CopyImage(Background)
41.         _SetAlpha i, &HFF000000&& To &HFFFFFFFF&&, temp
42.         _PutImage (x, y), temp
43.         _FreeImage temp
44.         _Display
45.         _Limit 60
46.     Next
47. End Sub
48.  

Just be careful to free all your images so you don't get a memory leak anywhere in your program.  I really didn't shoot too hard to do this here (Background never frees itself anywhere, so multiple calls would generate an memory leak), but it's not an issue for a demo this simple.  Just don't let it catch you in your own code anywhere, if you're doing anything more than just fading in and out of a simple splash screen, for instance.  ;)


@bplus You posted while I was in the middle of making and editing my post.  Looks like what you have is very similar to this, but PBBTTTTTBBBTTT!!  I'm going to share this anyway, since I've already typed it all up and such.  :P

[bplus]

@bplus You posted while I was in the middle of making and editing my post.  Looks like what you have is very similar to this, but PBBTTTTTBBBTTT!!  I'm going to share this anyway, since I've already typed it all up and such.  :P

LOL just call us the Redundant Brother tonight!

[Dav]

Cool fade in & out routines.  Better than what I was using.  Thanks for sharing it.

- Dav