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

  • Live Event Date: December 11, 2014 @ 1:00 p.m. ET / 10:00 a.m. PT Market pressures to move more quickly and develop innovative applications are forcing organizations to rethink how they develop and release applications. The combination of public clouds and physical back-end infrastructures are a means to get applications out faster. However, these hybrid solutions complicate DevOps adoption, with application delivery pipelines that span across complex hybrid cloud and non-cloud environments. Check out this …

  • With the average hard drive now averaging one terabyte in size, the fallout from the explosion of user-created data has become an overwhelming volume of potential evidence that law-enforcement and corporate investigators spend countless hours examining. Join Us and SANS' Rob Lee for our 45-minute webinar, A Triage and Collection Strategy for Time-Sensitive Investigations, will demonstrate how to: Identify the folders and files that often contain key insights Reduce the time spent sifting through content by …

Most Popular Programming Stories

More for Developers

RSS Feeds