AnimatePalette API 
Author Message
 AnimatePalette API

Can anyone help me with using the AnimatePalette API function in VB5? The
code below creates a smooth gradient in a DC (in this case a form but it
could be any DC) Blue to Black. I want to gradually change all blue to red
using the AnimatePalette, but I only get GPFs or worse!

    Dim pLogPal As LOGPALETTE
    Dim i As Integer, j As Integer
    Dim cliRect As RECT, newBrush As Long
    Dim WorkHeight As Long, StepSize As Single, c As Integer
    Dim WorkRect As RECT

    Dim strtColRed As Integer, strtColGreen As Integer, strtColBlue As
    Dim endColRed As Integer, endColGreen As Integer, endColBlue As Integer
    Dim WorkingRed As Integer, WorkingGreen As Integer, WorkingBlue As

    Dim RedDiff As Integer, GreenDiff As Integer, BlueDiff As Integer
    Dim RedAdd As Integer, GreenAdd As Integer, BlueAdd As Integer
    Dim UseSize As Integer, cIndex As Integer, cValue As OLE_COLOR

    strtColRed = 0: strtColGreen = 0: strtColBlue = 255
    endColRed = 0: endColGreen = 0: endColBlue = 0
    WorkingRed = strtColRed: WorkingGreen = strtColGreen: WorkingBlue =

    RedDiff = (endColRed - strtColRed)
    GreenDiff = (endColGreen - strtColGreen)
    BlueDiff = (endColBlue - strtColBlue)
    UseSize = Abs(RedDiff)
    If Abs(GreenDiff) > UseSize Then
        UseSize = Abs(GreenDiff)
    End If
    If Abs(BlueDiff) > UseSize Then
        UseSize = Abs(BlueDiff)
    End If
    RedAdd = RedDiff / UseSize
    GreenAdd = GreenDiff / UseSize
    BlueAdd = BlueDiff / UseSize

    pLogPal.palVersion = &H300
    pLogPal.palNumEntries = UseSize + 1
    ReDim pLogPal.palPalEntry(UseSize)
    For i = 0 To UseSize
        pLogPal.palPalEntry(i).peRed = CByte(WorkingRed)
        pLogPal.palPalEntry(i).peGreen = CByte(WorkingGreen)
        pLogPal.palPalEntry(i).peBlue = CByte(WorkingBlue)
        pLogPal.palPalEntry(i).peFlags = PC_RESERVED
        WorkingRed = WorkingRed + RedAdd
        WorkingGreen = WorkingGreen + GreenAdd
        WorkingBlue = WorkingBlue + BlueAdd
    Next i
    hPal = CreatePalette(pLogPal)

'This is being run directly on a form
    GetClientRect hWnd, cliRect
    SelectPalette hDC, hPal, False
    WorkHeight = cliRect.Bottom - cliRect.Top
    StepSize = WorkHeight / UseSize
    WorkRect = cliRect
    For i = cliRect.Top To cliRect.Bottom Step StepSize
        cIndex = i / StepSize
        GoSub GetColour
        newBrush = CreateSolidBrush(cValue)
        WorkRect.Top = i
        WorkRect.Bottom = i + StepSize
        FillRect hDC, WorkRect, newBrush
        DeleteObject newBrush
    Next i

'This bit doesn't work!
    For i = 0 To UseSize
        For j = 0 To UseSize
            With pLogPal.palPalEntry(j)
                If .peBlue > 0 Then
                    .peBlue = .peBlue - 1
                    .peRed = .peRed + 1
                End If
            End With
        Next j
        AnimatePalette hPal, 0, pLogPal.palNumEntries,
    Next i
    Exit Sub

    With pLogPal.palPalEntry(cIndex)
        cValue = RGB(.peRed, .peGreen, .peBlue)
    End With

Any help will be gratefully received, including improvements!

Thanks in advance

Mon, 03 Dec 2001 03:00:00 GMT  
 AnimatePalette API
As I understand it (and you should note that I've never actually animated a
palette animation involves cycling the palette color indices, not changing
their colors.
For example, you may swap palette color 10 for color 1 at the same time that
you swap 3 for 2, 4 for 3, etc.  Notice that no new colors are added to the

What you want to do is different: you want to simultaneously 1) realize a
new palette (with different colors from the old one) and 2) prevent the
automatic re-mapping of colors into this new palette, so the colors in your
bitmap, instead of staying as close to the same as possible, instead follow
the palette changes.

I've never done it that way, though the idea is intriguing.  It will sure
make any 256-color desktop wallpapers go crazy on 256-color machines,

I've achieved the same effect quite differently.  I start out with a palette
that has all the colors I'll need, and keep re-drawing a bitmap with
different colors in its palette (but I don't realize that palette!).  I use
SetDIBits() for this.  Here's a code snippet I've posted here before, but
probably not within the last month <g>:

Here's one way to do a fade.  It uses GetDIBits() to get a copy of the
picture in memory where you can manipulate the palette and SetDIBits() to
blast the result back to the screen: it's pretty fast for reasonable-size
bitmaps (not sure about fullscreen!).  This routine is intrinsically
16-color, but you could alter it to 256-color (roughly half as fast) or
24-bit color (_way_ slower).  Anyway, it may give you a starting point.

Note that it does not _realize_ the palette, so if you want it to run in
256-color video (forget it in 16-color) you'll have to realize an
appropriate palette yourself.  Also note that it was written to fade a
bitmap that had only three colors: black, white, and dark blue, so it
ignores the other colors.  The algorithm also assumes you know what the
final colors should be after the fade in (they're hard-coded).  You'll need
to fix it up for your own bitmap.

It's got a slightly clever method of making the fade speed somewhat
independent of the machine speed by doing the fade in four parts, timing
each one, and adjusting on the fly.

Jim Deutch

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
   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
        'size a buffer for the pixel data
        BufferSize = ((picSrc.ScaleWidth / 2 + 3) And &HFFFC) *
        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
                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
                Incr = Incr / (SECONDS_FADE_LOGO / 5 / (Timer - Start))
            End If
        Next i


>Can anyone help me with using the AnimatePalette API function in VB5? The
>code below creates a smooth gradient in a DC (in this case a form but it
>could be any DC) Blue to Black. I want to gradually change all blue to red
>using the AnimatePalette, but I only get GPFs or worse!

Mon, 03 Dec 2001 03:00:00 GMT  
 [ 2 post ] 

 Relevant Pages 

1. Visual Basic 5.0 and API AnimatePalette

2. Using AnimatePalette, SetPalette.....etc...

3. AnimatePalette in VB Pro 3.0

4. AnimatePalette help in VBPro 3.0


6. AnimatePalette

7. AnimatePalette

8. AnimatePalette

9. VB5 and AnimatePalette

10. AnimatePalette trouble run-time


12. API, API, Who's got the API


Powered by phpBB® Forum Software