Link to home
Start Free TrialLog in
Avatar of fritsvee
fritsvee

asked on

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
ASKER CERTIFIED SOLUTION
Avatar of mirek071497
mirek071497

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of fritsvee
fritsvee

ASKER

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,
Hi
Sorry for the long time but i can't submit comment here for last four days.
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.