Solved

TLabel.Colorize

Posted on 2001-07-22
23
180 Views
Last Modified: 2010-04-06
Hi,

has been a time, well i am trying to make an OnCreate event that will make all the TLabel(s) on my form change color onMouseOver !!

Any Ideas ??
0
Comment
Question by:neostudio
  • 9
  • 8
  • 3
  • +3
23 Comments
 
LVL 3

Expert Comment

by:nnbbb09
ID: 6306749

This is a simple custom component that gives you an OnMouseEnter and OnMouseExit event handler, just install it into a package. You can then attach code to change the font color

unit ExtLabel;

interface

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

type
  TExtLabel = class(TLabel)
  private
    FOnMouseExit: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  published
    property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit : TNotifyEvent read FOnMouseExit write FOnMouseExit;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Extended', [TExtLabel]);
end;

{ TExtLabel }

procedure TExtLabel.CMMouseEnter(var Message: TMessage);
begin
  if assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TExtLabel.CMMouseLeave(var Message: TMessage);
begin
  if assigned(FOnMouseExit) then
    FOnMouseExit(Self);
end;

Hope this helps

Jo
0
 
LVL 5

Expert Comment

by:alanwhincup
ID: 6306786
You could do it like this:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    procedure LabelMouseOver(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.LabelMouseOver(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  I : Integer;
begin
  for I := 0 to ControlCount - 1 do
    if (Controls[I] is TLabel) then
      TLabel(Controls[I]).Color := clRed;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I : Integer;
begin
  for I := 0 to ControlCount - 1 do
    if (Controls[I] is TLabel) then
      TLabel(Controls[I]).OnMouseMove := LabelMouseOver
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  I : Integer;
begin
  for I := 0 to ControlCount - 1 do
    if (Controls[I] is TLabel) then
      TLabel(Controls[I]).Color := clBtnFace;
end;

end.

For any other controls on the form you would have to point the OnMouseOver Event to FormMouseMove so that the labels color was put back to normal if the mouse went over them and not the form.

Cheers,

Alan.
0
 
LVL 3

Author Comment

by:neostudio
ID: 6306787
nope, sorry .
i do not want components !!
0
 
LVL 3

Author Comment

by:neostudio
ID: 6306868
ok...

seems i forgot to mention an important thing..

all labels are on a tabsheet and not direct on form...
so, it didnt work !!
0
 
LVL 6

Expert Comment

by:Stuart_Johnson
ID: 6307085
I dont think that is possible to do without components.  Using alanwhincup's method will only work if the laels are owned by the form (so, if you drop a label on a TPanel, it won't change back to the old colour.  You would need to enumerate each "container" object on the form.

I think you are going to be stuck with a component, or use nnbbb09's code and modify the TLabel component directly (not recommended!).
0
 
LVL 3

Author Comment

by:neostudio
ID: 6307109
don't really know but i have seen this...

i'll  be waiting...
0
 
LVL 6

Expert Comment

by:Stuart_Johnson
ID: 6307114
Hi,

Can you ellaborate on your last post?  I'm not sure what you mean.

Cheers!

Stu.
0
 
LVL 3

Author Comment

by:neostudio
ID: 6307121
i mean i have seen some people doing this in delphi
and i wonder wheather it is a real hard task ??!!!
so i will be waiting for mre ideas ..

that's all folks


......</br>
0
 
LVL 1

Expert Comment

by:SJohnson
ID: 6307154
Try this for size.  Just open a new project and paste this over all the existing code.  Don't change the form name.  Save, compile, run:

unit Unit1;

interface

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

type

TExtLabel = class(TLabel)
 private
   FOnMouseExit: TNotifyEvent;
   FOnMouseEnter: TNotifyEvent;
   procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
   procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
 published
   property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
   property OnMouseExit : TNotifyEvent read FOnMouseExit write FOnMouseExit;
 end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    procedure MouseEnter(Sender: TObject);
    procedure MouseExit(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  with TExtLabel.Create(Self) do
    begin
      Parent := Form1;
      Top := 100;
      Left := 100;
      Caption := 'Hi!';
      OnMouseEnter := MouseEnter;
      OnMouseExit := MouseExit;
    end;
end;

procedure TForm1.MouseEnter(Sender: TObject);
begin
  TExtLabel(Sender).Font.Color := clRed;
end;

procedure TForm1.MouseExit(Sender: TObject);
begin
  TExtLabel(Sender).Font.Color := clBtnText;
end;

{ TExtLabel }

procedure TExtLabel.CMMouseEnter(var Message: TMessage);
begin
  if assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TExtLabel.CMMouseLeave(var Message: TMessage);
begin
 if assigned(FOnMouseExit) then
   FOnMouseExit(Self);
end;

end.


The code nnbbb09 posted is generic, but he was the first to put it up, so he should be recognised if you go with this option.

Please note, that you will HAVE to dynamically create ALL your labels this way.  If you do NOT want to do it this way, you'll have to make a new label component.

Stu.
0
 
LVL 6

Expert Comment

by:Stuart_Johnson
ID: 6307169
Dammit... My alterego has surfaced :)
0
 
LVL 3

Author Comment

by:neostudio
ID: 6307175
i understand...

your code is nice and neat, but i will need to make every label by myself, what am i looking for is something like hottracking the mouse when it is over the TLabels in all my program !!
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 6

Expert Comment

by:Stuart_Johnson
ID: 6307185
Yeah, which is why I said you'll need a component.  You can either do it yourself as mentioned above, or do it with a component like nnbbb09 posted.

Can someone else back me on this please?
0
 
LVL 3

Author Comment

by:neostudio
ID: 6307202
Don't get mad....

didn't you say ".  Using alanwhincup's method will only work if
the laels are owned by the form (so, if you drop a label on a TPanel, it won't change back to the old
colour.  You would need to enumerate each "container" object on the form.
"

???
0
 
LVL 6

Accepted Solution

by:
Stuart_Johnson earned 50 total points
ID: 6307230
Doing it the way Alan (forgive me if this isn't your name) suggested will cause problems.  Each component will need to have an OnMouseMove event (unless you use a mouse hook which I can give you), otherwise you wont be guarenteed of getting a "mouse off" event.

The other problem is, depending on the complexity of your application, this will REALLY slow down the program.  Everytime you move the mouse just one pixel, it will need to recheck each and every control on the form.

Sorry if I appeared mad.   I wasn't.  I just think that you'd be better off using a component.  I am usually reluctant to use third party components and like sticking with native controls, but in this instance, I'm sure it can be overlooked as the code is just so generic and wont change.

If you DO opt to go with a new TLabel descendant (I can give you a slightly better option than the one posted before), all you need to do is add the component to your palette, make sure each form in your app has the new component's unit name in it's uses clause, then simply right click on each form, go "View as Text" and do a search/replace for TLabel and change to TExtLabel (whatever you end up calling it).  When you recompile, Delphi will re-declare each component and you'll have coloured labels - all in a few minutes of work.  Much neater, and certainly a damn sight faster than using enumerated controls :)

Hope this helps,

Stu.
0
 
LVL 3

Author Comment

by:neostudio
ID: 6307247
The best way yet...
i am convinced...


..</br> :-)
0
 
LVL 6

Expert Comment

by:Stuart_Johnson
ID: 6307264
Hi again,

Do you want me to post nnbbb09's code slightly modified so you dont have to worry about events?

Stu.
0
 
LVL 3

Author Comment

by:neostudio
ID: 6307289
if you'll have time...
0
 
LVL 6

Expert Comment

by:Stuart_Johnson
ID: 6307359
Hi Dude,

Try this component out.  I have added two new properties: FontMouseLeave and FontMouseOver.  FMO defaults to clRed.  You can change this before building the component if you want it to be anything other than clRed.

unit HoverLabel;

interface

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

type
  THoverLabel = class(TLabel)
  private
    FFontMouseLeave: TFont;
    FFontMouseOver: TFont;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CMMouseOver(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure SetFontMouseLeave(const Value: TFont);
    procedure SetFontMouseOver(const Value: TFont);
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    property FontMouseOver: TFont read FFontMouseOver write SetFontMouseOver;
    property FontMouseLeave: TFont read FFontMouseLeave write SetFontMouseLeave;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [THoverLabel]);
end;

{ THoverLabel }

procedure THoverLabel.CMMouseOver(var Message: TMessage);
begin
  Font := FFontMouseOver;
end;

procedure THoverLabel.CMMouseLeave(var Message: TMessage);
begin
  Font := FFontMouseLeave;
end;

procedure THoverLabel.SetFontMouseLeave(const Value: TFont);
begin
  FFontMouseLeave := Value;
end;

procedure THoverLabel.SetFontMouseOver(const Value: TFont);
begin
  FFontMouseOver := Value;
end;

constructor THoverLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFontMouseLeave := TFont.Create;
  FFontMouseOver := TFont.Create;
  FFontMouseLeave.Assign(Font); {Duplicate current font}
  FFontMouseOver.Assign(Font); {Duplicate current font}
  FFontMouseOver.Color := clRed; {change these two lines to something else if required}
end;

destructor THoverLabel.Destroy;
begin
  FFontMouseOver.Free;
  FFontMouseLeave.Free;
  inherited Destroy;
end;

end.

Cheers,

Stu.
0
 
LVL 3

Author Comment

by:neostudio
ID: 6307394
Thanks a lot !
0
 
LVL 3

Expert Comment

by:modder
ID: 6313621
Stuart,

I've suspended your duplicate account. I will not suspend your main Stuart Johnson account this time but please only use *one* account in Experts-Exchange.
0
 
LVL 3

Expert Comment

by:modder
ID: 6313622
modder
Community Support
0
 
LVL 6

Expert Comment

by:Stuart_Johnson
ID: 6315247
Can I ask why?  I was told about 3 years ago that it would be OK to maintain two accounts because one was used for work related issues (it's actually used by our IT department), and the other one is my personal account which I use to ask/answer questions relating to topics that interest me.

I have open questions under SJohnson.  What happens with them?
0
 
LVL 3

Expert Comment

by:modder
ID: 6316369
Post the URLs to those questions here and we'll ensure that they're brought to a satisfactory conclusion.
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

747 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now