Fade in and Fade out images???
Well, ya know, it was probably _your_ post that got me thinking about
this....
Here's what I came up with. It takes a 16-color bitmap from a hidden
picturebox, which has only three actual colors in it, white, blue, and
black. The black it leaves alone but the other two it fades up from black.
Picpal has a 256-color bitmap with a palette containing alot of grays and
blues so it works OK on a 256-color system.
It does the fade-in in five groups of steps, and by timing the first group
it can adjust the increment so that the fade will happen at the same speed
on any machine. It's all done in a tight loop so it will be smooth (a
DoEvents seems to prevent the form from unloading if you try to do it
during the loop!).
I'll bet there's some unclear stuff here. Work on it a bit and if you
can't figure something out give a holler.
Jim Deutch
MS Dev MVP
Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPel{*filter*}eter As Long
biYPel{*filter*}eter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO_4
bmiHeader As BITMAPINFOHEADER
bmiColors(15) As RGBQUAD
End Type
Private Const PIXEL As Integer = 3
Private Const DIB_RGB_COLORS As Long = 0
Private Declare Function GetDIBits4 Lib "gdi32" Alias "GetDIBits" _
(ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _
ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO_4, _
ByVal wUsage As Long) As Long
Private Declare Function SetDIBits4 Lib "gdi32" Alias "SetDIBits" (ByVal
hdc As Long, _
ByVal hBitmap As Long, ByVal nStartScan As Long, _
ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO_4, _
ByVal wUsage As Long) As Long
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)
Static SaveBits() As Byte
Static SaveBitmapInfo_4 As BITMAPINFO_4
Static nLen As Long
Static Start As Single
Static SubIters As Long
Static nName As Long
Static y As Long
Dim BufferSize As Long
Dim retval As Long
Dim i As Long
Dim cFace As Long
Dim R As Long, G As Long, B As Long
Static x As Long
Static j As Single
Dim Level As Long
Static picSrcDC As Long
Static frmDC As Long
Static picSrcLeft As Long
Static picSrcTop As Long
Static picSrcWidth As Long
Static picSrcHeight As Long
'realize the palette
picpal.ZOrder
'size a buffer for the pixel data
BufferSize = ((picSrc.ScaleWidth / 2 + 3) And &HFFFC) *
picSrc.ScaleHeight
ReDim SaveBits(0 To BufferSize - 1) 'As Byte
'fill the header info for the save copy
With SaveBitmapInfo_4.bmiHeader
.biSize = 40
.biWidth = picSrc.ScaleWidth
.biHeight = picSrc.ScaleHeight
.biPlanes = 1
.biBitCount = 4
.biCompression = 0
.biClrUsed = 0
.biClrImportant = 0
.biSizeImage = BufferSize
End With
nLen = Len(SaveBitmapInfo_4)
'get the bitmap from the picturebox
retval = GetDIBits4(picSrc.hdc, picSrc.Image, 0, _
SaveBitmapInfo_4.bmiHeader.biHeight, SaveBits(0),
SaveBitmapInfo_4, DIB_RGB_COLORS)
'cache stuff
picSrcDC = picSrc.hdc
frmDC = Me.hdc
picSrcLeft = picSrc.Left ' / Screen.TwipsPerPixelX
picSrcTop = picSrc.Top ' / Screen.TwipsPerPixelY
picSrcWidth = picSrc.ScaleWidth
picSrcHeight = picSrc.ScaleHeight
'fade in the logo
For i = 0 To 4
Start = Timer
'change the palette
j = 0
Do
j = j + Incr
Level = i * 51 + j
If Level > 255 Then Exit Do
SaveBitmapInfo_4.bmiColors(4).rgbBlue = Level / 2
SaveBitmapInfo_4.bmiColors(15).rgbBlue = Level
SaveBitmapInfo_4.bmiColors(15).rgbRed = Level
SaveBitmapInfo_4.bmiColors(15).rgbGreen = Level
'blast it back into the picturebox
retval = SetDIBits4(picSrcDC, picSrc.Image.handle, 0, _
SaveBitmapInfo_4.bmiHeader.biHeight, SaveBits(0),
SaveBitmapInfo_4, DIB_RGB_COLORS)
'transfer it to the form
retval = BitBlt(frmDC, picSrcLeft, picSrcTop, _
picSrcWidth, picSrcHeight, picSrcDC, 0, 0, SRCCOPY)
Loop While j < 52
If Timer - Start = 0 Then
Incr = Incr / 2
Else
Incr = Incr / (SECONDS_FADE_LOGO / 5 / (Timer - Start))
End If
Next i
Quote:
> I'm still looking for a routine to fade-in images from black, and
fade-out
> images to black with either the picture control or the image control.
When
> several images are shown consecutively, it will look like a 'slide show'.
> It need to work with all supported image file types.
> If anyone has any ideas, please let me know.
> Dave Wilhelm
> Wild Studio
