OnMouseLeave et TImageRésolu

Question

Bonjours,

Je suis en train d'essayer de faire un bouton avec un composant TImage, le but étant de changer l'image lorsque la souris est sur cette image et remettre son image initiale lorsque la souris quitte le bouton. 

C'est pourquoi j'ai utilisé l'évènement OnMouseEnter et OnMouseLeave. Pour tester ces évènements je les ai testé avec un showmessage. 

Le probleme est que le showmessage du onmouseleave apparait en meme temps que celui du onmouseenter.

Quelqu'un sait-il ce qui se passe et comment y remedier ?
Merci beaucoup

cs_txo · Accepted Answer

Parfait merci beaucoup j'avais pas vu mon probleme comme ca.
Voici mon code pour ceux qui auraient le meme probleme, pour précision, j'ai une image de fond (Image2) et une image servant de bouton par dessus (Image1).

----------code---------------

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Image1.Picture.Bitmap := nil;
ImageList1.GetBitmap(1,Image1.Picture.Bitmap);
end;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Image1.Picture.Bitmap := nil;
ImageList1.GetBitmap(0,Image1.Picture.Bitmap);
end;

-------code-------------

cs_txo · Answer

Personne n'a rencontré ce problème ?

Francky23012301 · Answer

Salut,


Heu les procédures OnMouseEnter et OnMouseLeave, tu es sur qu'elles existent pour un TImage ????

PS : les procédures à utiliser sont :

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);

JulioDelphi · Answer

Oui c'est bien mais c'est executé 1000000000 fois en 1 secondes ça non ? ^^
fait un test avec une listbox genre pour voir le nombre de fois que tu assigne une picture a ton image :
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
ListBox1.Add('dessus');
end;

ne vaut mieux t'il pas utiliser un boolean casé quelque part pour indiquer si on a deja assigner l'image afin de ne pas flooder justement ?
var
fDeja : Boolean;
...
TForm1.Create
begin
fDeja := false;
end;
...
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin
if not fDeja then
 begin
  Image1.Picture.Bitmap := nil;
  ImageList1.GetBitmap(1,Image1.Picture.Bitmap);
  fDeja := true;
 end;

end;
puis tu remets a False ailleurs, je te laisse trouver ^^ a bientot

Francky23012301 · Answer

On peut jouer aussi avec la propriété Tag Julio ;) comme cas pas de variable à définir.

JulioDelphi · Answer

Oui tout a fait !

f0xi · Answer

tu peu faire ça aussi :

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TImage = class(ExtCtrls.TImage)
  private
    fBringToFrontOnEnter : boolean;
    fOnMouseEnter : TNotifyEvent;
    fOnMouseLeave : TNotifyEvent;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  published
    property BringToFrontOnEnter : boolean read fBringToFrontOnEnter write fBringToFrontOnEnter default false;
    property OnMouseEnter : TNotifyEvent read fOnMouseEnter write fOnMouseEnter;
    property OnMouseLeave : TnotifyEvent read fOnMouseLeave write fOnMouseLeave;
  end;

  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
  private

  protected
    procedure DoImageEnter(Sender : TObject);
    procedure DoImageLeave(Sender : TObject);
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TImage.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if fBringToFrontOnEnter then
     BringToFront;
  if Assigned(FOnMouseEnter) then
     fOnMouseEnter(Self);
end;

procedure TImage.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseLeave) then
     fOnMouseLeave(Self);
end;

procedure TForm1.DoImageEnter(Sender : TObject);
begin
  with (Sender as TImage).Picture.Bitmap.Canvas do begin
       Brush.Color := $0099FF;
       FillRect((Sender as TImage).ClientRect);
  end
end;

procedure TForm1.DoImageLeave(Sender : TObject);
begin
  with (Sender as TImage).Picture.Bitmap.Canvas do begin
       Brush.Color := $FFFFFF;
       FillRect((Sender as TImage).ClientRect);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  image1.OnMouseEnter := DoImageEnter;
  image1.OnMouseLeave := DoImageLeave;
  image1.BringToFrontOnEnter := true;
  image1.Picture.Bitmap.Width := image1.Width;
  image1.Picture.Bitmap.Height := image1.Height;

  image2.OnMouseEnter := DoImageEnter;
  image2.OnMouseLeave := DoImageLeave;
  image2.BringToFrontOnEnter := true;
  image2.Picture.Bitmap.Width := image1.Width;
  image2.Picture.Bitmap.Height := image1.Height;
end;

end.

et ça marche trés trés bien!

<hr size="2" width="100%" />Croc (click me)

OnMouseLeave et TImage

7 réponses

Votre réponse

Discussions similaires