picture box

[HeSaidJoe]

anyone have a function for fade in and out for pictures loaded into a picture or image box...

[Aaron Young]

Here's some code I put together a while back:

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 FadeOut(ByRef picImage As PictureBox)
    Dim lDC As Long
    Dim lBMP As Long
    Dim W As Integer
    Dim H As Integer
    Dim lColor As Long
    
    W = ScaleX(picImage.Picture.Width, vbHimetric, vbPixels)
    H = ScaleY(picImage.Picture.Height, vbHimetric, vbPixels)
    lBMP = CreateCompatibleBitmap(picImage.hdc, W, H)
    lDC = CreateCompatibleDC(picImage.hdc)
    Call SelectObject(lDC, lBMP)
    BitBlt lDC, 0, 0, W, H, picImage.hdc, 0, 0, SRCCOPY
    picImage = LoadPicture("")
    
    For lColor = 255 To 0 Step -3
        picImage.BackColor = RGB(lColor, lColor, lColor)
        BitBlt picImage.hdc, 0, 0, W, H, lDC, 0, 0, SRCAND
        Sleep 10
    Next
    Call DeleteDC(lDC)
    Call DeleteObject(lBMP)
End Sub

Private Sub FadeIn(ByRef picImage As PictureBox, ByVal sPicture As String)
    Dim lDC As Long
    Dim lBMP As Long
    Dim W As Integer
    Dim H As Integer
    Dim lColor As Long
    
    picImage = LoadPicture(sPicture)
    W = ScaleX(picImage.Picture.Width, vbHimetric, vbPixels)
    H = ScaleY(picImage.Picture.Height, vbHimetric, vbPixels)
    lBMP = CreateCompatibleBitmap(picImage.hdc, W, H)
    lDC = CreateCompatibleDC(picImage.hdc)
    Call SelectObject(lDC, lBMP)
    BitBlt lDC, 0, 0, W, H, picImage.hdc, 0, 0, SRCCOPY
    picImage = LoadPicture("")
    For lColor = 0 To 255 Step 3
        picImage.BackColor = RGB(lColor, lColor, lColor)
        BitBlt picImage.hdc, 0, 0, W, H, lDC, 0, 0, SRCAND
        Sleep 10
    Next
    picImage = LoadPicture(sPicture)
    Call DeleteDC(lDC)
    Call DeleteObject(lBMP)
End Sub

Private Sub cmdFadeIn_Click()
    FadeIn Picture1, "E:\Photos\Bryce\Bryce1.jpg"
End Sub

Private Sub cmdFadeOut_Click()
    FadeOut Picture1
End Sub

[HeSaidJoe]

thanks Aaron...

[DaveG]

I've tried this code as well, but when I run the program, it highlights the "ScaleX" in the FadeIn Sub en says "Sub or Function Not Defined".

I've copied and pasted all code (except the code at the end) in a module and changed all privates into publics.

Can anyone tell me what I do wrong?

Dave.

[HeSaidJoe]

Use it as it was written...Private In Gen Declarations of Form...
Copy and paste the code
Use Picture1 as a picturebox
Use cmdFadeIn as Command Button
Use cmdFadeOut as Command Button

Change FadeIn Picture1, "E:\Photos\Bryce\Bryce1.jpg"
to reflect your path and picture..

The actual results are not quite up to par in my opinion but the
code does work.

Later