Simuler l'évènement OnMouseOver de Java

bruce-willis · 07/04/2007, 13h37

En Delphi, les composants visuels ne possèdent pas l'évènement OnMouseOver et OnMouseOut, pas comme les autres langages comme Java.
Donc, on associe les évènements existants: OnMouseMove, OnMouseUp, OnMouseDown. Le composant TLabel possède nativement les évènements OnMouseEnter et OnMouseLeave.
C'est facile pour faire un drag & drop ou tracer un rectangle:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
StartX,StartY:Integer;{Déclarer au début de l'unitéde la fiche}
 
{Utiliser ce code comme le gestionnaire d'événement OnMouseDown de la fiche :}
 
procedure TForm1.FormMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
begin
StartX :=X;
StartY :=Y;
end;
 
{Utiliser ce code comme le gestionnaire d'événement OnMouseUp de la fiche :}
 
procedure TForm1.FormMouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:Integer);
begin
Form1.Canvas.Rectangle(StartX,StartY,X,Y);
StatusBar1.Panels[0].Text :='';
StatusBar1.Panels[1].Text :='';
StatusBar1.Panels[2].Text :='';
StatusBar1.Panels[3].Text :='';
end;

Mais comment faire pour OnMouseOver? ça me creuse l'esprit depuis un moment!

**randriano** · 07/04/2007, 13h39

Moi aussi, je me suis posé la question: pourquoi Borland (du moins Delphi 7 et antérieur) n'inclut pas cet évènement, je ne sais pas pour Delphi 2005 et 2006.

**philnext** · 07/04/2007, 14h11

Comme tu dis certains composants (TLabel ou dansla JVCL) possèdent le OnMouseEnter (qui me semble d'ailleurs plus cohérent que OnMouseOver) et ça ne te va pas pource que tu veux faire ? Ou tu aimerais que d'autres composants aient ce OnMouseEnter (et donc OnMouseLeave) ?

**exoseven** · 07/04/2007, 14h54

il te faut gérer les messages de windows CM_MOUSEENTER et CM_MOUSELEAVE

un exemple http://www.swissdelphicenter.ch/torr...de.php?id=1068

**user 56gt8** · 07/04/2007, 18h47

Avec l'évènement form.mousemove, tu peux générer un test sur différentes surfaces correspondant à des composants.

Tu crées une classe Tsurface avec private X1,X2,Y1,Y2 qui correspondent aux coordonées des composants ,
une procedure surface.generatevent qui envoit une boolean 'test' (public)

A chaque mousemove tu testes les coordonnées sur ton array de Tsurface.Le mouse move gènère du x,y.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
-------------------------------dans les types
Tsurface = class
     constructor create(X1,X2,Y1,Y2 : integer)
     procedure GenerateEvent
     private X1,X2,Y1,Y2 :integer;
     public  test: boolean;
end;
 
-------------------------------dans les var
surface: array[1..?]of Tsurface ;
 
-------------------------------dans le code
 
pour la procedure mousemove sur la main form.
 
for ix:=1 to (nombres de Tsurface) do
if (X>surface.[ix].X1) and (X<surface.[ix].X2) and (Y>surface.[ix].Y1)and(Y<surface.[ix].Y2) then Surface[ix].GenerateEvent;
----------------------------------------------------------------

Le plus chiant c'est qu'il faut enregistrer les coordonées des composants à tester lors de leur création dans les variables de la classe surface crée en parallèle...(j'imagine mais je ne ferais pas !)

Bref si tu veux te prendre la tête, voilà une bonne solution.

Le plus simple c'est d'adopter une version récente de delphi comme le laissait sous entendre rakoto vu que les évènemets de la souris sont tous gérés.

**exoseven** · 07/04/2007, 18h49

non le plus simple c'est de gérer les messages de windows, chose que borland à oublié de faire, cela doit fonctionner même sous delphi 1

**Fabrice ROUXEL 1** · 07/04/2007, 21h26

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
unit test;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs;
 
type
  TNewLabel = class (TLabel)
  private
    { Private declarations }
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    procedure CMMouseEnter(var msg: TMessage);message CM_MOUSEENTER;
    procedure CMMouseLeave(var msg: TMessage);message CM_MOUSELEAVE;
  protected
    { Protected declarations }
    procedure DoMouseEnter; virtual;
    procedure DoMouseLeave; virtual;
  public
    { Public declarations }
  published
    { Published declarations }
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;
 
implementation
 
 
procedure TNewLabel .CMMouseEnter(var msg: TMessage);
begin
  DoMouseEnter;
end;
 
procedure TNewLabel .CMMouseLeave(var msg: TMessage);
begin
  DoMouseLeave;
end;
 
procedure TNewLabel .DoMouseEnter;
begin
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;
 
procedure TNewLabel .DoMouseLeave;
begin
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
 
end.

bruce-willis · 08/04/2007, 14h49

exoseven, tu as raison d'insister sur la manipulation des messages CM_MOUSEENTER et CM_MOUSELEAVE, c'est le minimum à attendre d'un bon développeur.
Mais je me demande si Delphi 2005 ou supérieur possède déja cet évènement?

ROUXEL!
J'ai testé ton code et j'ai une question:est-ce que ce sera la même chose avec TImage, TButton, TPanel,etc.?
Comment faire pour insérer ce nouveau composant dans la palette de Delphi?

**Fabrice ROUXEL 1** · 08/04/2007, 18h12

Pour installer le compo tu ajoutes dans l'unité
section interface: procedure Register;
"" implementation:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
procedure Register;
begin
  RegisterComponents('NewCompo', [TNewLabel]);
end;

Ensuite dans le menu compo-> installer un compo: tu fournis l'unité.

Pour les autres composant le principe est le meme, tu captures les 2 messages et tu leurs connectes un evenement.

PS/Ajoutes des proprietes comme ColorEnter, ColorExit etc... si tu veux reproduire une balise <link> ou <a>

**Fabrice ROUXEL 1** · 08/04/2007, 21h18

j'ai ajouté 2 propriétés pour les couleurs:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
unit UNewLabel;
 
interface
 
uses
  Windows,Graphics, StdCtrls, Messages, SysUtils, Classes, Controls, Forms, Dialogs;
 
type
  TNewLabel = class (TLabel)
  private
    { Private declarations }
    FFontEnter: TFont;
    FFontLeave: TFont;
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    procedure CMMouseEnter(var msg: TMessage);message CM_MOUSEENTER;
    procedure CMMouseLeave(var msg: TMessage);message CM_MOUSELEAVE;
  protected
    { Protected declarations }
    procedure DoMouseEnter; virtual;
    procedure DoMouseLeave; virtual;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
  published
    { Published declarations }
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property FontEnter: TFont read FFontEnter write FFontEnter;
    property FontLeave: TFont read FFontLeave write FFontLeave;
  end;
 
procedure Register;
 
implementation
 
 
procedure TNewLabel .CMMouseEnter(var msg: TMessage);
begin
  Font.Assign(FFontEnter);
  DoMouseEnter;
end;
 
procedure TNewLabel .CMMouseLeave(var msg: TMessage);
begin
  Font.Assign(FontLeave);
  DoMouseLeave;
end;
 
constructor TNewLabel.Create(AOwner: TComponent);
begin
  inherited;
  FFontEnter := TFont.Create;
  FFontLeave := TFont.Create;
  FFontEnter.Assign(Font);
  FFontLeave.Assign(Font);
end;
 
destructor TNewLabel.Destroy;
begin
  FFontEnter.Free;
  FFontLeave.Free;
  inherited;
end;
 
procedure TNewLabel .DoMouseEnter;
begin
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;
 
procedure TNewLabel .DoMouseLeave;
begin
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
 
procedure Register;
begin
 RegisterComponents('FRox', [TNewLabel]);
end;
 
end.

**philnext** · 10/04/2007, 17h24

Belle réalisation...bon pour moi les TLabel étaient parmis les rares qui avaient ces évènements mais bon...

bruce-willis · 11/04/2007, 09h35

Bon, tous ces conseils me suffisent amplement!

Merci à tous!

Simuler l'évènement OnMouseOver de Java

Delphi

Discussions similaires

Partager

Partager