Drag'n drop ou click sur un même composant.

Soyez le premier à donner votre avis sur cette source.

Vue 6 720 fois - Téléchargée 680 fois

Description

Cette petite démo montre comment programmer un "glisser-poser" propre et efficace.
De plus, elle montre comment obtenir un composant que l'on peut soit cliquer, soit glisser-poser.
Vous remarquerez la double utilisation du OnDragOver qui permet d'éviter certains comportements qui ont le don de m'énerver ; comme la "perte" du compo lors du glissement quand on fait un mouvement très rapide avec la souris ; ou cet affreux mouvement saccadé obtenu avec la méthode classique.

Conclusion :


( Fait avec Delphi 7 sur Windows XP )

Le source est bien commenté et très clair... j'espère.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
mardi 21 mars 2006
Statut
Membre
Dernière intervention
21 mars 2006

Simple et très utile. Il m'a bien servi. Merci
Petite remarque tout de même : ne permet pas de distinguer clic droit et gauche et réagit donc comme un clic sur les 2 boutons. Pas très pratique si l'on a un popupmenu sur le composant.
Mais un seul test règle le problème, if(Button = mbLeft)
Messages postés
2527
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
16 octobre 2019
18
Debiars a raison :
SIMPLICITE => EFFICACITE
Merci de nous le rappeler ;)

Je n'ai pas le temps d'appliquer la méthode de Icebird pour le moment, mais ça me semble prometteur à priori...

C'est vrai, MAURICIO. Il serait sans doute intéressant de rapprocher ces codes.

Joyeuses fêtes à tous et merci pour vos commentaires.
Messages postés
285
Date d'inscription
lundi 16 juin 2003
Statut
Membre
Dernière intervention
11 février 2018

Ca y est, j'ai essayé d'utiliser ton procédé dans un petit prog où j'ai à déplacer des pions. Malheureusement, il m'arrivait de temps en temps de voir disparaître un pion, même sans déplacement brusque.
Comme je n'ai pas bien pigé comment appliquer le truc de IceBird, j'en suis revenu à ma bonne vieille méthode MouseDown/Move/Up, simple et efficace que je vous livre ci-après dans le rôle de la démo de Caribensila :

var
XsurLab,YsurLab : integer;
oldX,oldY : integer;
Sliping : boolean;


procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Sliping := true;
oldX := Label1.Left;
oldY := Label1.Top;
XsurLab := X;
YsurLab := Y;
end;

procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not Sliping then exit;
Label1.Left := Label1.Left + (X - XsurLab);
Label1.Top := Label1.Top + (Y - YsurLab);
end;

procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not Sliping then exit;
Sliping := false;
if (Abs(Label1.Left - oldX) < 4) and // Mettre 15 ou + pour "parkinson"
(Abs(Label1.Top - oldY) < 4) then // ou autre contrôle, selon le cas
begin
Label1.Left := oldX;
Label1.Top := oldY;
Label1.Caption :'Action Click';
end
else Label1.Caption :'Action Déplacement';
end;
Messages postés
10
Date d'inscription
lundi 14 novembre 2005
Statut
Membre
Dernière intervention
27 décembre 2005

procedure TForm1.ControlOnDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
tempPoint:TPoint;
begin
getcursorpos(tempPoint);
with (Source as TControl) do begin
Top:=(Parent as TControl).screentoclient(tempPoint).Y;
Left:=(Parent as TControl).screentoclient(tempPoint).X;
end;
Accept:=true;
end;


En remplacant le X et Y fournit par OnDragOver par un GetCursorPos en conjonction avec un ScreenToClient, on évite tous les désagréments. Il suffit de lier cette procédure à tous les evenements OnDragOver des contrôles que l'on souhaite déplacer ou sur lesquels on veut déplacer quelque chose, et c'est bon.

Du moins c'est ce que j'ai trouvé. Dites-moi si vous y voyez un défaut.
Messages postés
285
Date d'inscription
lundi 16 juin 2003
Statut
Membre
Dernière intervention
11 février 2018

Fonctionne aussi sous w2000.
Je n'avais jamais approfondi le drag'age, car la plupart du temps ce sont des bitmap's posés sur une paintbox (carte à jouer par exemple) que j'ai à déplacer. Mais cela m'ouvre des horizons... Merci.
Afficher les 6 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.