Fading A Bitmap / PictureBox

This short bit of code shows how to fade a picture inside a PictureBox using a few simple WinAPI methods.

Screen-shot

The code works by creating a memory compatible DC and Bitmap to that of the picture within the PictureBox. The PictureBox is then cleared and has it's background set to various shades of gray (eventually black) - the bitmap is then 'blitted' to the PictureBox and each pixel is 'AND'ed with the background colour to achieve the fade effect.


'
' Form1 with a PictureBox (picture1) and a command button (command1)
'
'
private 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
private Declare Function CreateCompatibleDC Lib "gdi32" _
    (byval hdc as Long) as Long
private Declare Function CreateCompatibleBitmap Lib "gdi32" _
    (byval hdc as Long, byval nWidth as Long, byval nHeight as Long) _
        as Long
private Declare Function DeleteDC Lib "gdi32" (byval hdc as Long) as Long
private Declare Function DeleteObject Lib "gdi32" _
    (byval hObject as Long) as Long
private Declare Function SelectObject Lib "gdi32" (byval hdc as Long, _
    byval hObject as Long) as Long
'
private Declare Sub Sleep Lib "kernel32" (byval dwMilliseconds as Long)
'
private Const SRCAND = &H8800C6
private Const SRCCOPY = &HCC0020
'
private Sub Command1_Click()
    Dim lDC as Long
    Dim lBMP as Long
    Dim W as Integer
    Dim H as Integer
    Dim lColor as Long
'    
    Screen.MousePointer = vbHourglass
'    
    W = ScaleX(Picture1.Picture.Width, vbHimetric, vbPixels)
    H = ScaleY(Picture1.Picture.Height, vbHimetric, vbPixels)
    '
    ' Create Memory Compatible Bitmap to that in Picture1
    '
    lBMP = CreateCompatibleBitmap(Picture1.hdc, W, H)
    '
    ' Create Compatible DC in memory
    '
    lDC = CreateCompatibleDC(Picture1.hdc)
    '
    ' Select the Bitmap into the memory DC
    '
    Call SelectObject(lDC, lBMP)
    BitBlt lDC, 0, 0, W, H, Picture1.hdc, 0, 0, SRCCOPY
    '
    ' Quickly clear the Picture in Picture1
    '
    Picture1 = LoadPicture("")
    
    for lColor = 255 to 0 step -3
        '
        ' set the backcolor to a gray scale -> black
        '
        Picture1.BackColor = RGB(lColor, lColor, lColor)
        '
        ' Copy the bitmap into the picturebox 'AND' with the backcolor
        '
        BitBlt Picture1.hdc, 0, 0, W, H, lDC, 0, 0, SRCAND
        '
        ' Pause for a bit
        '
        Sleep 15
    next
    '
    ' Clear up our DC's and Bitmaps
    '
    Call DeleteDC(lDC)
    Call DeleteObject(lBMP)
    Screen.MousePointer = vbDefault
'    
End Sub
'

Download Zipped Project Files (3k)



Comments

  • Question

    Posted by Legacy on 03/13/2003 12:00am

    Originally posted by: saeed

    Good STuff

    How would you go about gradually fading the forground to the color of back group ?

    Reply
  • cool code

    Posted by Legacy on 03/07/2003 12:00am

    Originally posted by: sadashiva

    any modification to the code so that the same effect can be obtained using img control

    Reply
  • nice and useful code

    Posted by Legacy on 07/04/2002 12:00am

    Originally posted by: Ranganath

    Very good and intresting code

    Reply
  • for image control

    Posted by Legacy on 12/01/2000 12:00am

    Originally posted by: vishal

    the demo is very interesting and can the effect be achieved on the image control and how?

    Reply
Leave a Comment
  • Your email address will not be published. All fields are required.

Top White Papers and Webcasts

  • Intelligent N+X Redundancy, Placement Affinities, & Future Proofing in the Virtualized Data Center Virtualization brought about the ability to simplify business continuity management in IT. Workload portability and data replication capabilities mean that physical infrastructure failures no longer need impact application services, and they can rapidly be recovered even in the event of complete site failure. However, Enterprises and Service Providers face new challenges ensuring they have enough compute …

  • Thanks to wide spread cloud hosting and innovations small businesses can meet and exceed the legacy systems of goliath corporations. Explore the freedom to work how you want, with a phone system that will adapt to your evolving needs and actually save you lots of expense—read Get an Enterprise Phone System without High Cost and Complexity. The article clearly illustrates: The only hardware you'll need is phone equipment for advanced voice and fax. How to join all your employees, mobile devices, …

Most Popular Programming Stories

More for Developers

RSS Feeds

Thanks for your registration, follow us on our social networks to keep up-to-date