Solved

Change Label.Font.Color without flashing

Posted on 1997-09-10
4
295 Views
Last Modified: 2010-04-04
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
0
Comment
Question by:fritsvee
  • 3
4 Comments
 
LVL 3

Accepted Solution

by:
mirek071497 earned 100 total points
ID: 1344589
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
 

Author Comment

by:fritsvee
ID: 1344590
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
 
LVL 3

Expert Comment

by:mirek071497
ID: 1344591
Hi
Sorry for the long time but i can't submit comment here for last four days.
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1344592
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

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

792 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