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:=clNav y
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:=clNav y
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
(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:=clNav
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:=clNav
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Hi
Sorry for the long time but i can't submit comment here for last four days.
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[Item No]) );
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:=Max Count;
for i:=0 to MaxCount-1 do
begin
MyLPal^.palPalEntry[i].peR ed := 0;
MyLPal^.palPalEntry[i].peG reen := 0;
MyLPal^.palPalEntry[i].peB lue := 0;
MyLPal^.palPalEntry[i].peF lags := 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.
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
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[Item
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:=Max
for i:=0 to MaxCount-1 do
begin
MyLPal^.palPalEntry[i].peR
MyLPal^.palPalEntry[i].peG
MyLPal^.palPalEntry[i].peB
MyLPal^.palPalEntry[i].peF
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:
var i : integer;
begin
for i:=0 to 49 do
RollArray[i].Animate;
end;
end.
ASKER
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,