Color Palette Animation

My project requires that I create a copy of the system palette, modify a few (let's say 16) colors, paint with those 16 colors, then change the colors with animatepalette.

Here is where I am:

I can create a copy of the system palette, modify it, realize it, and display the colors. I am not modifying the first or last 10 colors of the palette.

I am using {$R-} while modifying the colors in the temporary dynamic array, then restoring {$R+}. I free the temporary array after creating my palette. I restore the previous palette and delete my created palette object before ending the program.

So at this point, I can create a modified palette and display it. As a test, I have set up a timer, and on the Timer1Timer event, I call Animatepalette as follows:

MyPal is my created and realized palette of type hPalette.

The colors I want to animate are entries 10..25 in MyPal, with peFlag set to PC_RESERVED (the flags of the other entries in the palette are left as copied from the system palette).

CurPal is an array[0..15] of TPaletteEntry, initially containing identical copies of MyPal entries 10..25.

My test rotates the colors in CurPal and calls:

AnimatePalette(MyPal, 10, 16, Curpal[0]);

But I do not get the expected results. I have had a palette animating before, but with the thin documentation on this, I am currently at a loss to explain why it isn't working.

What happens is that the wrong colors are displayed in MyPal entries 10..25, though the others are correct, and there is no movement as there should be as the 16 colors rotate with each Timer event.

When I run the program, RealizePalette returns 239. This is 255 minus 16. When I comment out AnimatePalette, the number increases to 255 and my modified colors display properly. But the palette is realized long before any call to AnimatePalette, so that should have no effect, and the number should be 256 according to the RealizePalette documentation.

What I really need is a complete working example for AnimatePalette. The only example I have found so far does not work as written, and I have already spent a LOT of time working on this because the documentation seems inadequate.
Lonny070297Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

mirek071497Commented:
for which delphi ? ( i have only 1 and 2)
0
mirek071497Commented:
this should work on all delphi..

unit My_Roll;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls;

type
  TMyRoll = class(TScrollingWinControl)
  private
    MyPal       : HPalette;
    MyLPal      : TLogPalette;
    MyTimer     : TTimer;
    fCanvas     : TControlCanvas;
    procedure   WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure   TimerProc(Sender: TObject) ;
  protected
    procedure   PaintWindow(DC: HDC); override;
    procedure   Paint; virtual;
  public
    constructor Create( AOwner : TComponent); override;
    destructor  Destroy;                      override;
    property    Canvas : TControlCanvas read fCanvas;
  published
    { Published declarations }
  end;

procedure Register;

implementation

const
  dColor = 10;

procedure Register;
begin
  RegisterComponents('Samples', [TMyRoll]);
end;

procedure TMyRoll.WMPaint(var Message: TWMPaint);
begin
  PaintHandler(Message);
end;

procedure TMyRoll.PaintWindow(DC: HDC);
begin
  FCanvas.Handle := DC;
  try
    Paint;
  finally
    FCanvas.Handle := 0;
  end;
end;

constructor TMyRoll.Create( AOwner : TComponent);
begin
  inherited Create( AOwner );
  Width := 16;
  Height := 16;
  fCanvas := TControlCanvas.Create;
  TControlCanvas(fCanvas).Control := Self;
  { create palette }
  MyLPal.PalVersion := $0300;
  MyLPal.palNumEntries:=1;
  MyLPal.palPalEntry[0].peRed   := 255;
  MyLPal.palPalEntry[0].peGreen := 255;
  MyLPal.palPalEntry[0].peBlue  := 255;
  MyLPal.palPalEntry[0].peFlags := PC_Reserved;
  MyPal := CreatePalette(MyLPal);
  MyTimer := TTimer.Create(self);
  MyTimer.Interval := 100;
  MyTimer.OnTimer := TimerProc;
  MyTimer.Enabled := true;
end;

destructor  TMyRoll.Destroy;
begin
  MyTimer.Free;
  DeleteObject(MyPal);
  fCanvas.Free;
  inherited Destroy;
end;

procedure TMyRoll.TimerProc(Sender: TObject) ;
begin
  with MyLPal.palPalEntry[0] do
    if peBlue>=dColor then Dec(peBlue,dColor)
      else if peGreen>=dColor then Dec(peGreen,dColor)
        else if peRed>=dColor then Dec(peRed,dColor)
          else
            begin
              peBlue := 255;
              peGreen := 255;
              peRed := 255;
            end;
  AnimatePalette( MyPal,0,1, @MyLPal.palPalEntry[0] );
  ReFresh;
end;

procedure TMyRoll.Paint;
var MyBrush : HBrush;
begin
  SelectPalette(Canvas.Handle,MyPal,false);
  RealizePalette(Canvas.Handle);
  MyBrush := CreateSolidBrush(PaletteIndex(0));
  FillRect( Canvas.Handle, ClientRect, MyBrush );
  DeleteObject(MyBrush);
end;

end.


Install this component and add to you'r form.
do you like it ?
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mirek071497Commented:
I write it now and i see so you must add some DeleteObject
but it's easy.
0
Lonny070297Author Commented:
I have discovered that AnimatePalette() is not supported under Windows using >256-color video. My alternative under Windows is to constantly repaint a large complex bitmap, which is already continually being drawn on-the-fly, so I have abandoned the Windows version of this program.

But DOS programs can animate the palette even in a Win 95 DOS box, and it works on all the hardware on which I have tried it. So I am keeping my DOS version of the program. Still, thanks for the answer.

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.