Change Label.Font.Color without flashing

I have several overlapping, transparent
(dynamicly created) labels.
To be specific,
This means
1 Label[2].Left > Label[1].Left
  Label[3].Left > Label[2].Left
2 Label[2].Left + Label[2].Width > Label[3].Left
3 Label[1].Left + Label[1].Width > Label[2].Left
.Top and .Height are the same, .width varies.

I want to change the Label[2].Font.Color (e.g. from clWhite
to clNavy).
Suppose I do only this: Label[2].Font.Color:=clNavy
Normally this will lead to 'flashing'. For a short moment
you will see a disruption on your screen. I hate that.

So I tried this:
Adding a procedure DOESNTWORK the form redirecting
  message WM_ERASEBKGND
And in DOESNTWORK is stated
 IF SCREWUP THEN inherited.

When I change the color of Label[2]
I state that SCREWUP:=FALSE
             Label[2].Font.Color:=clNavy
             Label[2].Repaint
             SCREWUP:=TRUE

Result: the flashing/flickering is gone,
but there are clWhite pixels visible around the
new clNavy pixels. I do not want that.
I can't just e.g. enlarge the font before changing
the color (because unwised pixels will be changed too).

Is there a solution to this?
  message WM_ERASEBKGND
fritsveeAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
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:
When You change color, font, caption and other of label then the label must readraw so you can't do this without flashing. However you can do color change without flashing with palette animation but this is rather more complicated (of course if you really need this i can submit here example).

Regards Mirek.
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
fritsveeAuthor Commented:
Thanks Mirek.

You CAN do this without flashing as I write in my question
by redirecting the message WM_ERASEBKGND and only
use 'inherited' when not redrawing the label. This doesn't
flash, not even a little: I tried.
The only things is: you will see some white pixels
remaining after changing to blue (99% is ok though).

But OK, if there is no way around it (isn't there?), please do
give me an example of palette animation.
Make it a simple one please, with e.g. 20 labels,
changing their colors individually.

Confided that you will post an example (I've red some really
good experts answers of you) I grant you the points.

Frits, with regards,
0
mirek071497Commented:
Hi
Sorry for the long time but i can't submit comment here for last four days.
0
mirek071497Commented:
OK i have simple example for you.

unit My_Roll;

interface

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

Const
  MaxCount = 50;

type
  TMyRoll = class( TLabel )
  private {}
  protected
    procedure   Paint; override;
  public
    RollCount   : integer;
    ItemNo      : byte;
    procedure   Animate;
  published {}
  end;

implementation

var
  SaveExit : Pointer;
  MyPal    : HPalette;
  MyLPal   : PLogPalette;

procedure TMyRoll.Animate;
var
  dColor : integer;
begin
  with MyLPal^.palPalEntry[ItemNo] do
  begin
    if RollCount<255 then
      dColor := RollCount
    else
      dColor := 511-RollCount;
    peBlue  := dColor;
    peGreen := dColor;
    peRed   := dColor;
    if RollCount<507 then
      inc(RollCount,4)
    else
      RollCount := 0;
  end;
  AnimatePalette( MyPal, ItemNo, 1, @(MyLPal^.palPalEntry[ItemNo]) );
end;

procedure TMyRoll.Paint;
var
  Rect: TRect;
  DC : HDC;
begin
  DC := GetDC( Parent.Handle );
  SelectPalette( DC,MyPal,false);
  RealizePalette( DC );
  SetBkMode( DC, integer(TRANSPARENT) );
  Rect := ClientRect;
  SetTextColor( DC, PaletteIndex(ItemNo) );
  TextOut( DC, Left, Top, PChar(Caption), Length(Caption) );
  ReleaseDC( Parent.Handle, DC );
end;

procedure LibExit;
begin
 DeleteObject(MyPal);
 FreeMem(MyLPal, (SizeOf(TLogPalette) + SizeOf(TPaletteEntry)*256));
 ExitProc := SaveExit;
end;

var
  i : integer;

initialization
  GetMem(MyLPal, (SizeOf(TLogPalette) + SizeOf(TPaletteEntry)*256));
  MyLPal^.PalVersion := $0300;
  MyLPal^.palNumEntries:=MaxCount;
  for i:=0 to MaxCount-1 do
  begin
    MyLPal^.palPalEntry[i].peRed   := 0;
    MyLPal^.palPalEntry[i].peGreen := 0;
    MyLPal^.palPalEntry[i].peBlue  := 0;
    MyLPal^.palPalEntry[i].peFlags := PC_Reserved;
    MyPal := CreatePalette(MyLPal^);
  end;
  SaveExit := ExitProc;
  ExitProc := @LibExit;
end.

and the secon unit (form) which use this unit.

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;  { set the time of the timer to 100ms }
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    RollArray : array[0..50] of TMyRoll;
  public {}
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var x,y : integer;
begin
  Randomize;
  for x := 1 to 10 do
  for y:= 1 to 5 do
  begin
    RollArray[ (x-1)+(y-1)*10 ] := TMyRoll.Create(Self);
    RollArray[ (x-1)+(y-1)*10 ].Parent := self;
    RollArray[ (x-1)+(y-1)*10 ].RollCount := Random(512);
    RollArray[ (x-1)+(y-1)*10 ].ItemNo := (x-1)+(y-1)*10;
    RollArray[ (x-1)+(y-1)*10 ].Caption := 'No '+IntToStr((x-1)+(y-1)*10);
    RollArray[ (x-1)+(y-1)*10 ].Left := x*60;
    RollArray[ (x-1)+(y-1)*10 ].Top  := y*20;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i : integer;
begin
  for i:=0 to 49 do
    RollArray[i].Animate;
end;

end.
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.