MoouseDown, MouseUp : exécution/arrêt boucleRésolu

Question

Bonjour,


Je suis à la recherche d'un moyen pour exécuter une action (lancement d'une procédure en boucle par exemple) lors que je laisse le bouton de la souris enfoncée et lque losque je le relâche, la boucle se termine.

Quelqu'un a t-il une solution ?

Orélien.

Cirec · Accepted Answer

Salut,

une autre méthode :

Procedure Test;
Var X : Integer;
Begin
  x :=  0;
   Repeat 
    Form1.Label1.Caption : = IntToStr(X);
    Form1.Label1.Refresh;
    Inc(X);
  Until (GetAsyncKeyState(VK_LBUTTON) And $8000) =  0; // et tant que le bouton gauche est enfoncé on continue
 End ;



procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If Button  = mbLeft Then  Test; // on déclanche l'action
end;















@+
Cirec

cs_Loda · Answer

salut,

je te pond le code comme ça, alors regarde pas trop la syntaxe (et tu dois pouvoir faire mieux pour les nom de var):

var
  TacheFinit : boolean;


OnMouseDown:
StartTache;

OnMouseUp:
TacheFinit := true;

procedure StartTache;
begin 
  TacheFinit := false;
repeat
  ExecuterTache;
until tacheFinit;
end;


je pense que ça doit marcher. Si ta tache est très longue, fait des test a l'interieur pour l'interompre.

bon code,

cs_Loda · Answer

bin c'est bien plus propre comme méthode.... :D

cs_orelien · Answer

Super, merci beaucoup, c'est exactement ce qu'il me fallait...

Orélien.

cs_orelien · Answer

Juste une autre question :
Toujours par code et en complétant cette façon de procéder, comment serait-il possible de détecter que l'utilisateur maisse sa souris cliqué gauche pendant deux secondes par exemple ?

Ainsi j'aimerais détecter s'il désire faire un défilement de ma nière automatique.

Merci

Orélien.

Cirec · Answer

la procedure Test est executé tant que le bouton gauche reste enfoncé et durant un maximum de deux secondes

Procedure Test;
Var X : Integer; 
Start, Elapsed : DWORD;
Begin
  x :=  0;
  Start := GetTickCount;
   Repeat 
    Form1.Label1.Caption : = IntToStr(X);
    Form1.Label1.Refresh;
    Inc(X);
    Elapsed :=  GetTickCount - Start;
   Until  ((GetAsyncKeyState(VK_LBUTTON) And $8000)  = 0) or (Elapsed > 2000);
End;



procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If Button = mbLeft Then  Test
end;

@+
Cirec

cs_orelien · Answer

C'est presque ça, mais en réalité je souhaitais lancer le défilement auto quand l'utilisateur laisse le bouton enfoncé pendant au moins deux secondes sinon un défilement normal se produit.

Orélien.

Cirec · Answer

un peut de réflection t'aurai mené à ceci :

Procedure Test;
Var X : Integer; 
Start    : DWORD;
Begin
  x :=  0;
  Start := GetTickCount;
   Repeat 
    // Défilement Normal
    If GetTickCount - Start > 2000 Then 
    // Défilement Automatique
  Until (GetAsyncKeyState(VK_LBUTTON) And $8000)  = 0;
End;

@+
Cirec

Cirec · Answer

Une petite correction :


 





Procedure Test;
Var Start    : DWORD;
Begin
  Start :=  GetTickCount;
   Repeat 
    // Défilement Normal
    If GetTickCount - Start > 2000 Then 
    // Défilement Automatique
  Until (GetAsyncKeyState(VK_LBUTTON) And $8000)  = 0;
End;

@+
Cirec

cs_MAURICIO · Answer

Attention:
Repeat
  DoSometing ...
Until (GetAsyncKeyState(VK_LBUTTON) And $8000) = 0; 

Ça ne marche pas si tu relaches le bouton et que tu cliques une nouvelle fois  n' importe oú en restant enfoncé pendant que le programme execute le code représenté par "something" ... 

Je te conseille d' ailleurs d' utiliser application.processMessages; pour pas que ton programme bloque/rame ...


Je suis plus pour la solution de Loda qui marcehrait sur n' importe quelle situation ...

A+

Cirec · Answer

@ Mauricio,

Salut, j'ai fait le teste 20 fois de suite et ça à fonctionné 20 fois ???????

20 sur 20 c'est un bon rapport ... non ?

En effet le DoSomething (chez moi) est interne à la procedure (Test) de ce fait dès que le bouton de la souris est relâché l'action est terminé et est prête pour un nouveau cycle.
As-tu au moins essayé le code ?

Et l'utilisation abusive d'Application.ProcessMessages peut provoquer l'effet inverse (ralentissement blocage ...)
@+
Cirec

MoouseDown, MouseUp : exécution/arrêt boucle

11 réponses

Votre réponse

Discussions similaires