AnimatePalette 
Author Message
 AnimatePalette

Does anyone know how to use the "AnimatePalette" function?

I mean I passed the handle of the PictureBox.Image.hPal in which
I painted some stuff and I want to animate it..but nothing happens.
Do I need to create a palette and asign it to the PictureBox?
or can I use the default current one?

any help apriciated.



Fri, 05 Oct 2001 03:00:00 GMT  
 AnimatePalette
ok this is what Icam doing simply I draw some fractals in a PictureBox
control
then simply I want to animate the colors in it, I saw about 3 4 years ago an
example by Daniel appleman using 16 bit Vb and it was very easy as a matter
of fact I played with it and stuff, well I have the new 32 bit book byt
mister appleman
forgot to put the same example....so if you know how can I animate the
colors
in a picturebox please let me know..

    thanks.....

The Picturebox.Image.hPal is a logical palette pointer, I think
since it must be using a default palette I thought id did not have
to create one...but...



Sun, 07 Oct 2001 03:00:00 GMT  
 AnimatePalette


Quote:
> ok this is what Icam doing simply I draw some fractals in a PictureBox
> control
> then simply I want to animate the colors in it, I saw about 3 4 years ago an
> example by Daniel appleman using 16 bit Vb and it was very easy as a matter
> of fact I played with it and stuff, well I have the new 32 bit book byt
> mister appleman
> forgot to put the same example....so if you know how can I animate the
> colors
> in a picturebox please let me know..

>     thanks.....

> The Picturebox.Image.hPal is a logical palette pointer, I think
> since it must be using a default palette I thought id did not have
> to create one...but...

--
All right, here you go - I've pasted in the class I used for 32 bit palette
animation, along with all the API decs. There may be some extraneous APIs in
there that aren't necessary for the class.

Here is a brief example of how to use the class:
--------------------------------------------------------------------------
'Create new palette class
    Set m_cPalette = New CPalette
    Set m_cPalette.Canvas = Me

'set default palette colours:
'Create 64 shades of green/blue for background
    m_clrWashStart = RGB(0, 30, 25)
    m_clrWashEnd = RGB(0, 225, 210)
'Create 64 shades between Dark Green and Silver Grey for animation of text
    m_clrFadeStart = RGB(0, 30, 25)
    m_clrFadeEnd = RGB(225, 225, 225)

'select the palette into the form
    RefreshPalette
--------------------------------------------------------------------------
Then in the Timer event, you animate the palette:
--------------------------------------------------------------------------
'Each time the timer event is triggered, the color is
'cycled forward one palette entry, until this has been done 64X

    Dim sError$

    On Error GoTo tHandler

'Change current m_iQuad
    m_iQuad = (m_iQuad + 1)

    If m_iQuad > 63 Then   'end of colors has been reached
        Timer1.Enabled = False
        Set m_cPalette = Nothing
        Wait
        Unload Me
    Else
    'Get appropriate color from m_laRgbQuads
        m_laRgbQuads(100) = m_laRgbQuads(m_iQuad + 101) Or &H1000000
    'Animate into the palette
        m_cPalette.Animate 100, 1, m_laRgbQuads
    End If
--------------------------------------------------------------------------
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CPalette"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'In order for this class to function, global declarations in the PAL32.txt
file 'must be copied into a standard module This class only works if the
system palette 'contains 256 colors and the device is palette based - before
using this class the 'GetDeviceCaps API should be used to determine if the
RC_PALETTE flag is set '(If GetDeviceCaps(hDC, RASTERCAPS) And RC_PALETTE
Then ...)

'PaintBackground constants - direction
Private Const pbLeft = 0
Private Const pbRight = 1
Private Const pbTop = 2
Private Const pbBottom = 3

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As
Any, src As Any, ByVal SIZE As Long)

Private m_hPal As Long              'handle to the palette
Private m_logPalette As LOGPALETTE  'logical palette structure
Private m_frmCanvas As Form         'form to use as a canvas for graphics
methods

Public Property Set Canvas(frm As Form)
'the canvas must be an object with an hDC or an hWnd property
'and a ScaleWidth property. I'm using Form here, but it could be picturebox
    Set m_frmCanvas = frm
End Property
Public Property Get Canvas() As Form
    Set Canvas = m_frmCanvas
End Property

Public Property Get hPal() As Long
'Returns the handle of the logical palette (m_logPalette)
   hPal = m_hPal
End Property
Public Property Let hPal(l As Long)
'l: handle to a palette whose colors are to be loaded into m_logPalette
'setting this property deletes the current palette if one exists
'the logical palette is then filled with entries 0 to 255 of the palette whose
handle is i
    If (m_hPal <> 0) Then
        DeleteObject (m_hPal)
    End If
'Initialize palette header
'set palette version
    m_logPalette.Version = &H300
'set # of palette entries
    m_logPalette.nEntries = 256
'Get color table from palette
    Call GetPalet{*filter*}tries(l, 0, 256, m_logPalette.aEntries(0))
'Create new palette using new colors
    m_hPal = CreatePalette(m_logPalette)
End Property

Public Property Let Colors(n As Integer)
'sets number of color entries in palette
   m_logPalette.nEntries = n
End Property
Public Property Get Colors() As Integer
   Colors = m_logPalette.nEntries
End Property

Public Function Clone() As CPalette
'creates an instance of Me (cPalette)  and loads it with current colors
    Dim rgbs(255) As Long
    Dim newpal As New CPalette

'Get colors from current palette
    Me.GetRgbColors 0, 256, rgbs()
'Set colors for new palette
    newpal.SetRgbColors 0, 256, rgbs()
'Return new palette
    Set Clone = newpal
    Set newpal = Nothing
End Function

Public Sub ReCreate()
'Deletes existing palette, and creates new one with current flags
'Delete old palette handle, if it exists
    If (m_hPal <> 0) Then
       DeleteObject (m_hPal)
    End If
'Create a new palette based on logical palette
    m_hPal = CreatePalette(m_logPalette)
End Sub

Public Sub Animate(iStartPos%, iNumColors%, laRgb() As Long)
'iStartPos:     # of first entry to change
'iNumColors:    # of entries to change
'laRGB:         1st entry in array of palet{*filter*}try structs (or RGB values)
'Calls AnimatePalette API, which replaces the values in the hardware palette
'with the values passed in the aRGB array
    AnimatePalette m_hPal, iStartPos, iNumColors, laRgb(iStartPos)
'Copies from laRGB array to the logical palette
    CopyMemory m_logPalette.aEntries(iStartPos), laRgb(iStartPos), 4 *
iNumColors
End Sub

Public Sub SetRgbColors(iStart As Integer, iColors As Integer, aRgb() As
Long) 'Copies color values from Long array into logical palette 'iStart:
first logical palette entry to be set, also starting point in aRgb array
'iColors:  number of logical palette entries to be set 'aRgb():  array of
values to assign in logical palette. (iColors) values will be copied from
(aRgb) to '  m_logPalette.aEntries, beginning with the (iStart)th element
Call SetPalet{*filter*}tries(m_hPal, iStart, iColors, aRgb(iStart))  CopyMemory
m_logPalette.aEntries(iStart), aRgb(iStart), 4 * iColors End Sub

Public Sub GetRgbColors(iStart, iColors As Integer, aRgb() As Long)
'Copies color values from logical palette into Long array
'iStart:    first entry to get
'iColors:   number of entries to get
'aRgb():    array to fill with colors. (iColors) entries will be copied from
m_logPalette.aEntries to
'           (aRgb), beginning with the (iStart)th element
   Call GetPalet{*filter*}tries(m_hPal, iStart, iColors, aRgb(iStart))
   CopyMemory aRgb(iStart), m_logPalette.aEntries(iStart), 4 * iColors

End Sub

Public Sub FadeEntries(rgbStart As Long, rgbStop As Long, firstEntry As
Integer, steps As Integer) 'Loads logical palette with gradated 'wash' of
values 'rgbStart:  lower bound of color range 'rgbStop:  upper bound of color
range 'firstEntry:  index of first palette entry to be modified 'steps:  # of
steps including start & stop  Dim i%  Dim rStep!  Dim gStep!  Dim bStep!  Dim
R!  Dim g!  Dim b! 'Calculate size of step for each of red, green, and blue
color components  rStep = ((rgbStop And &HFF&) - (rgbStart And &HFF&)) /
steps  gStep = (((rgbStop And &HFF00&) - (rgbStart And &HFF00&)) / steps) /
&H100&  bStep = (((rgbStop And &HFF0000) - (rgbStart And &HFF0000)) / steps)
/ &H10000 'Get starting red, green, and blue  R = CByte(rgbStart And &HFF)  g
= CByte(((rgbStart And &HFF00&) \ &H100&) And &HFF)  b = CByte(((rgbStart And
&HFF0000) \ &H10000) And &HFF) 'Fill palette entries  For i = 0 To steps - 1
m_logPalette.aEntries(firstEntry + i).peRed = CByte(R)
m_logPalette.aEntries(firstEntry + i).peGreen = CByte(g)
m_logPalette.aEntries(firstEntry + i).peBlue = CByte(b)  R = R + rStep  g = g
+ gStep  b = b + bStep  Next End Sub

Public Sub PaintBackground(iSteps As Integer, iDirection As Integer)
'this procedure paints the Canvas form with a gradient pattern
'the colors used for the wash effect are taken from the Canvas form's palette,
'beginning with the eleventh entry (the first 10 are reserved for system
colors)
'iSteps is the number of palette entries to use

    Dim i%
    Dim iStepWidth%

    Select Case iDirection
    Case pbLeft, pbRight
    'get width of a single color swath
        iStepWidth = m_frmCanvas.ScaleWidth / iSteps
    Case pbTop, pbBottom
    'get heoght of a swath
        iStepWidth = m_frmCanvas.ScaleHeight / iSteps
    End Select

'loop through (iSteps) palette entries
    For i = 0 To iSteps - 1
    'Use palette index color 10 + swath number (entries 0-9 are system colors)
        m_frmCanvas.ForeColor = &H100000A + i
    'draw swath on form
        Select Case iDirection
        Case pbLeft
            m_frmCanvas.Line (i * iStepWidth, 0)-(i * iStepWidth + iStepWidth,
m_frmCanvas.ScaleHeight), , BF
        Case pbRight
            m_frmCanvas.Line (m_frmCanvas.ScaleWidth - (i * iStepWidth),
0)-(m_frmCanvas.ScaleWidth - (i * iStepWidth) - (iStepWidth), _
            m_frmCanvas.ScaleHeight), , BF
        Case pbTop
            m_frmCanvas.Line (0, i * iStepWidth)-(m_frmCanvas.ScaleWidth, i *
iStepWidth + iStepWidth), , BF
        Case pbBottom
            m_frmCanvas.Line (0, m_frmCanvas.ScaleHeight - (i *
iStepWidth))-(m_frmCanvas.ScaleWidth, m_frmCanvas.ScaleHeight - _
            (i * iStepWidth) - iStepWidth), , BF
        End Select
    Next i

End Sub

Public Sub SetFlags(first As Integer, count As Integer, flags As Integer)
'Sets flags for ...

read more »



Sun, 07 Oct 2001 03:00:00 GMT  
 AnimatePalette
thanks a lot lets see if i get it to work, I am being honest when i say
in the VB-API 16 bit edition by appleguy was an example very
easy animating a palette


Mon, 08 Oct 2001 03:00:00 GMT  
 
 [ 5 post ] 

 Relevant Pages 

1. Using AnimatePalette, SetPalette.....etc...

2. AnimatePalette in VB Pro 3.0

3. AnimatePalette help in VBPro 3.0

4. VB3 ANIMATEPALETTE how?

5. AnimatePalette API

6. AnimatePalette

7. Visual Basic 5.0 and API AnimatePalette

8. AnimatePalette

9. VB5 and AnimatePalette

10. AnimatePalette trouble run-time

11. AnimatePalette could be fun ..... if I was smarter!!

 

 
Powered by phpBB® Forum Software