anyone have a function for fade in and out for pictures loaded into a picture or image box...
Printable View
anyone have a function for fade in and out for pictures loaded into a picture or image box...
Here's some code I put together a while back:Code: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
thanks Aaron...
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.
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