Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Color Palette Animation

Posted on 1997-07-02
4
Medium Priority
?
422 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
4 Comments
 
LVL 3

Expert Comment

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

Accepted Solution

by:
mirek071497 earned 300 total points
ID: 1338103
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
ID: 1338104
I write it now and i see so you must add some DeleteObject
but it's easy.
0
 

Author Comment

by:Lonny070297
ID: 1338105
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

On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
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…
How to fix incompatible JVM issue while installing Eclipse While installing Eclipse in windows, got one error like above and unable to proceed with the installation. This video describes how to successfully install Eclipse. How to solve incompa…
Want to learn how to record your desktop screen without having to use an outside camera. Click on this video and learn how to use the cool google extension called "Screencastify"! Step 1: Open a new google tab Step 2: Go to the left hand upper corn…
Suggested Courses

688 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