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

Résolu
Signaler
Messages postés
137
Date d'inscription
dimanche 7 juillet 2002
Statut
Membre
Dernière intervention
11 janvier 2009
-
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
-
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.

11 réponses

Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
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
Messages postés
814
Date d'inscription
vendredi 3 novembre 2000
Statut
Membre
Dernière intervention
30 juillet 2009
3
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,
Messages postés
814
Date d'inscription
vendredi 3 novembre 2000
Statut
Membre
Dernière intervention
30 juillet 2009
3
bin c'est bien plus propre comme méthode.... :D
Messages postés
137
Date d'inscription
dimanche 7 juillet 2002
Statut
Membre
Dernière intervention
11 janvier 2009

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

Orélien.
Messages postés
137
Date d'inscription
dimanche 7 juillet 2002
Statut
Membre
Dernière intervention
11 janvier 2009

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.
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
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
Messages postés
137
Date d'inscription
dimanche 7 juillet 2002
Statut
Membre
Dernière intervention
11 janvier 2009

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.
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
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
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
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
Messages postés
2106
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
5
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+
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
@ 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