?
Solved

Change Label.Font.Color without flashing

Posted on 1997-09-10
4
Medium Priority
?
302 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
[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

Accepted Solution

by:
mirek071497 earned 200 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

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

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

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…
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…
This tutorial will teach you the special effect of super speed similar to the fictional character Wally West aka "The Flash" After Shake : http://www.videocopilot.net/presets/after_shake/ All lightning effects with instructions : http://www.mediaf…
In this video, Percona Director of Solution Engineering Jon Tobin discusses the function and features of Percona Server for MongoDB. How Percona can help Percona can help you determine if Percona Server for MongoDB is the right solution for …
Suggested Courses
Course of the Month10 days, 23 hours left to enroll

770 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