Fade to black...

[cwm]

well, there's a mac screensaver that does a really nice and smooth fade to black (my friend runs his at 24 bit color, 1280 x 1024)
now tell me, why is it i've never seen one for windows? anyone know how to do it?
i tried using the alphablending stuff but that's just too slow..

any ideas?

Why don't you try this?

Private Shade As Long 'Put in General Declarations

Private Form_Click()
 Shade = 255
 Do
  DoEvents
  Me.BackColor = RGB(Shade, Shade, Shade)
  Shade = Shade - 1 'subtract anything larger to speed up fade.
 Loop Until Shade <= 0
End Sub

Or were you wanting something else?

Sub FormFade(frm As Form)
' Makes Form Fade To Black
' Example: FormFade(Form1)

For icolVal% = 255 To 0 Step -1
frm.BackColor = RGB(icolVal%, icolVal%, icolVal%)
Next icolVal%
End Sub

Is that it?

this is a little better than dreamlax's example
its a little slower, and it looks a little smoother

Private Sub Form_Click()
 Shade = 200
 Do
  Me.BackColor = RGB(Shade, Shade, Shade)
  For i = 0 To 50000
  Next
  DoEvents
  Shade = Shade - 1 'subtract anything larger to speed up fade.
 Loop Until Shade <= 0
End Sub

you could also use Matthews code with the delay
they work the same, but Matthews code is a little shorter

Sub FormFade(frm As Form)
' Makes Form Fade To Black
' Example: FormFade(Form1)

For icolVal% = 255 To 0 Step -1
For i = 0 To 50000
Next
DoEvents
frm.BackColor = RGB(icolVal%, icolVal%, icolVal%)
Next icolVal%
End Sub

[kedaman]

Well you could use this function to get a greycolor:

Function Greyfade(percent) As Long
    Greyfade = Int(percent * 168430,08)
End Function

[Edited by kedaman on 07-06-2000 at 02:25 AM]

[cwm]

heh, i shoulda been more clear:
the screen fades to black, his desktop fades from the picture that is there to black...

so, how would one go about fading a picture to black in a nice smooth way

There is probably a better way, but you can use the GetPixel API to get the Pixel, then convert it to RGB and decrease the Colour Value by a little then use the SetPixel API to draw the new coloured Pixel.

[Paul282]

Challenging the Guru

Private Sub Form_Click()

    Dim ShadeR As Integer
    Dim ShadeG As Integer
    Dim ShadeB As Integer
    
    ShadeR = 255
    ShadeG = 255
    ShadeB = 255

  
  For i = 0 To 254
    ShadeR = ShadeR - 1
    Me.BackColor = RGB(ShadeR, ShadeG, ShadeB)
    Me.Refresh
    ShadeG = ShadeG - 1
    Me.BackColor = RGB(ShadeR, ShadeG, ShadeB)
    Me.Refresh
    ShadeB = ShadeB - 1
    Me.BackColor = RGB(ShadeR, ShadeG, ShadeB)
    Me.Refresh
    DoEvents
  Next

End Sub

[kedaman]

use BITBLT API with VBSRCAND flag and blitt a picture with &H10101 color in other words color next to black, which should fade your screen softly enogh into black if you loop it up to 256 times

[cwm]

Originally posted by kedaman
use BITBLT API with VBSRCAND flag and blitt a picture with &H10101 color in other words color next to black, which should fade your screen softly enogh into black if you loop it up to 256 times

great, everyone that didn't know what i was talking about gave me code, but you didn't... went pretty much over my head...

and remember, the picture will probably be 1024 x 768... imagine going a get/setpixel 786,432 times to change the shade of a pic by one step =P

[Paul282]

Do you mean make the desktop fade to black?

Well, you could use the API to grab the desktop and display it, then buggerize (that's the technical term ) with the pallatte!

[cwm]

thats all fine and dandy, but how you gonna mess with a 16 bit picture?
if it was 256 messing with the pallette would be no problem

[Edited by cwm on 07-07-2000 at 03:51 AM]

[Paul282]

It's a lot of code!

Shall I post you my "VB Graphics programming - Hands on applications and Advanced colour development" book?

I can email you the source for the chapter on advanced colour if you like? It's a lot of code but not too big an email zipped!

You could consider buying the book, it's very good. There is a review here somewhere on it "VB Graphics programming"

[cwm]

could you make a prograsm that just fades a small 16bit picture to black and email it to me?

man, i'll give you everything i own.. which would be nothing atm but still

could ya do that for me? i've been working on this thing for days, i'd almost lost hope

[cwm]

oh, and i'd love to have the chapter on advanced colour thing you were talking about!

[Paul282]

I don't think the email address in your profile "N/A" is valid!

Can I have another one please?

[cwm]

oops, my bad

[email protected]

thanks loads, man!

[DiGiTaIErRoR]

There is probably a better way, but you can use the GetPixel API to get the Pixel, then convert it to RGB and decrease the Colour Value by a little then use the SetPixel API to draw the new coloured Pixel.
-Megatron

I've used the APIs and then used .point and .pset of a picturebox and notice no difference in the speed.

[Paul282]

NO!!! you move things in blocks then manipulate the bytes directly or load to a tricolour type, which is slower but easier to use. and they are HEAPS faster that the pset methods. like 100 to 1 times faster, and offer the same amount of flexibilty if not more so.

Oh, and it's in the mail

I used this code:

Private Sub Form_Click()
Select Case Me.Tag
 Case Is = "NotFaded"
  For x = 255 To 1 Step -1
   DoEvents
   Me.BackColor = RGB(x, x, x)
   BitBlt Me.hDC, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, pctBase.hDC, 0, 0, SRCAND
  Next x
  Me.Tag = "Faded"
  Exit Sub
 Case Is = "Faded"
  For x = 1 To 255
   DoEvents
   Me.BackColor = RGB(x, x, x)
   BitBlt Me.hDC, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, pctBase.hDC, 0, 0, SRCAND
  Next x
  Me.Tag = "NotFaded"
  Exit Sub
End Select
End Sub

but I don't advise you use it. It's slow and it looks ugly. Rather than doing it in 255 steps, it looks more like 5 steps which take longer. What is the maximum depth BitBlt can do? I've currently got mine set to 1024x768x32.

[cwm]

1024x768x16 as to not waste resorces, cant be wasting my 256 megs...

but that shouldn't matter, like i said, my friend runs at a much higher resolution at 24bit, the mac screensaver has a very smooth fade...

[looking at your stuff now, paul, again, much thanks ]

[cwm]

dang.. still too slow...
*sigh*
ah well, back to the drawing board =\

[kedaman]

If found the same problem that it was slower than i thought, using this method with about 50 ticks takes 2 seconds on my comp, and well for fading out again you can use srcErase

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetTickCount Lib "kernel32" () As Long


Sub FadeDesktop(Frm As Form, Src As PictureBox, ticks&, Optional fadein As Boolean)
Dim w As Long, h As Long

    Frm.AutoRedraw = True 'Saves the blitted image as soon at it is drawn
    Src.AutoRedraw = True
    w = Screen.Width / Screen.TwipsPerPixelX: h = Screen.Height / Screen.TwipsPerPixelY 'get resolution
    Frm.Move 0, 0, Screen.Width, Screen.Height
    Src.Move 0, 0, Screen.Width, Screen.Height
    Frm.Visible = False
    Src.Visible = False
    BitBlt Src.hDC, 0, 0, w, h, GetDC(GetDesktopWindow), 0, 0, vbSrcCopy 'Capture desktop
    Frm.Visible = True
    
    For n = 0 To 255 Step 255 / ticks 'loop trough ticks times
        Frm.BackColor = &H10101 * Int(n) 'Set color to fade into(grey)
        BitBlt Frm.hDC, 0, 0, w, h, Src.hDC, 0, 0, vbSrcErase - fadein * (vbSrcAnd - vbSrcErase) 'Fade in or out
        DoEvents
        If Forms.Count = 0 Then Exit For 'emergency exit for doevents
    Next n
    
End Sub

[cwm]

Can't create auto redraw image?

[kedaman]

ARGH! well I guess you can't do this if you don't have enought memory since that's the only thing that could cause "Can't create auto redraw image", Well you may have to quit a lot of apps and try again, or try on another comp...

[cwm]

*chuckles*
funny you mention that, win98 has been running for a long time under some serious stress.. i'll reboot and try again

[cwm]

ok.. that fade is.. i dunno, sorta abrasive... ah well...

i went looking for that mac screen saver, i couldnt find that specific one but i found many that did a fade... turns out it fux0rz with the monitor..

looks like our trying to emmulate it via software will be in vein =(

[cwm]

are there better blending options to make it look more like a fade and not a disco tech flash?

[kedaman]

I guess you have to go for Alpha blending then, there's an ocx on planet source code but it will only work in Win98. Also there's an api for alphablending in win2k