Solved

Color Palette Animation

Posted on 1997-07-02
4
412 Views
Last Modified: 2012-05-04
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.
0
Comment
Question by:Lonny070297
  • 3
4 Comments
 
LVL 3

Expert Comment

by:mirek071497
Comment Utility
for which delphi ? ( i have only 1 and 2)
0
 
LVL 3

Accepted Solution

by:
mirek071497 earned 100 total points
Comment Utility
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
 
LVL 3

Expert Comment

by:mirek071497
Comment Utility
I write it now and i see so you must add some DeleteObject
but it's easy.
0
 

Author Comment

by:Lonny070297
Comment Utility
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

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now