Drag&drop de controles

Soyez le premier à donner votre avis sur cette source.

Vue 9 083 fois - Téléchargée 904 fois

Description

Un bout de code qui permet à l'utilisateur de déplacer n'importe quel type de controle.
On peut spécifier une grille d'attachement (16 dans l'exemple) et çà fonctionne quel que soit la hierarchie des contrôles parents. C'est à dire que l'on peut déplacer un TButton sur une fiche, ou un TPanel avec tout son contenu, ou encore un TButton dans un TPanel.

J'ai réalisé ce petit bout de code car les rares sources sur le déplacement de composants que j'ai trouvé donnaient une solution plus complexe et surtout qui n'utilisait pas les gestionnaires d'evenements DragOver, DragDrop, etc...

Source / Exemple :


unit Unit1;

interface

uses
  Windows, Forms, StdCtrls, ExtCtrls, Classes, Controls, jpeg, Sysutils;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Panel1: TPanel;
    Button2: TButton;
    Memo1: TMemo;
    Image1: TImage;
    GroupBox1: TGroupBox;
    Panel2: TPanel;
    Button3: TButton;
    CheckBox1: TCheckBox;
    edTailleGrille: TEdit;
    Label2: TLabel;
    edDistanceAvantDrag: TEdit;
    Label3: TLabel;
    procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ControlDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure DragDropControl(Source: TObject; X, Y, Increment: Integer);
  end;

var
  Form1: TForm1;
  MousePoint: TPoint;

implementation

{$R *.dfm}
procedure TForm1.DragDropControl(Source: TObject; X, Y, Increment: Integer);
{ Récupère la position de la souris, convertit ces coordonnées en fonction du
 composant parent, et déplace le composant source en arrondissant au multiple
 d'Increment (d'où l'effet grille)}
var
  tempPoint:TPoint;
begin
  {Cette vérification permet d'ignorer l'attachement à la grille si la touche
  CTRL gauche est appuyée pendant le draggage}
  if (GetAsyncKeyState(VK_LCONTROL)) <> 0 then
    Increment:=1;

  getcursorpos(tempPoint);
  with (Source as TControl) do begin
    Top:=Round((Parent as TControl).screentoclient(tempPoint).Y/Increment)*Increment-MousePoint.Y;
    Left:=Round((Parent as TControl).screentoclient(tempPoint).X/Increment)*Increment-MousePoint.X;
    end;
  end;

procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
{ Lance le déplacement du controle après que la souris se soit déplacée de X
 pixels en gardant un bouton appuyé
 Il faut lier cet evenement à tous les controles que l'on souhaite déplacer}
begin
  {Cette variable permet d'éviter que le composant ne saute quand on commence
  le draggage}
  MousePoint.X:=X;
  MousePoint.Y:=Y;
  (Sender as TControl).begindrag(false,strtointdef(edDistanceAvantDrag.text,30));
  end;

procedure TForm1.ControlDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
{ Permet le déplacement au-dessus du composant Sender.
 Met à jour la position du composant Source (permet de voir où on déplace le
 controle).
 Il faut lier cet evenement à tous les composant au-dessus desquels on souhaite
 déplacer un controle, mais également à tous les contrôles déplacables eux-mêmes}
begin
  DragDropControl(Source,X,Y,strtointdef(edTailleGrille.text,16));
  Accept:=true;
  end;

end.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
2106
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
5
Salut Icebird,
pourrais tu me filer mon compo que tu as adapté en y marquant les lignes ajoutées SVP?
Je verrais si elles sont cool tes modifs...
A+
Messages postés
65
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
16 décembre 2011

J'ai déjà été voir le TcyResizer, et j'ai mis un commentaire que j'invite tout le monde à lire.
Messages postés
10
Date d'inscription
lundi 14 novembre 2005
Statut
Membre
Dernière intervention
27 décembre 2005

"Question, y-a-t-il un moyen simple d'afficher les poignées de sélection permettant de montrer les composants sélectionnés (ou le composant sélectionné et le dimmensionner)"

Là tu cherche le composant de Mauricio, TcyResizer (voir premier commentaire). Je l'avoue, j'ai fini par l'adopter pour le programme sur lequel je bosse en ce moment, vu que je cherchais également à redimensionner les controles. Il fonctionne particuliérement bien et c'est franchement une idée originale qu'il a eut. Je l'ai juste modifié un peu pour inclure cette fameuse grille d'attachement auquel je tient tant.

Malgré tout, je pense que pour un simple draggage, ma méthode est plus simple.

Pour la distance avant draggage, oui c'est beaucoup mais ce n'est qu'un exemple, et cette valeur à pour but de faire bien ressentir le délai avant le début du draggage.

Ton idée d'antidérapant pour les ascenceurs est très intéressante, mais l'idéal serait de modifier le code des barres à sa source pour permettre une option de ce type au lieu de retaper un bout de code dans chaque programme en affichant. Et je ne pense pas que ce soit possible actuellement.

PS: concernant mon heure de postage de ce commentaire: oui, je rentre du reveillon, et non, je n'ai pas trop but puisqu'on n'a pas but du tout ^^
Bonne année!
Messages postés
65
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
16 décembre 2011

Moi ça m'a plus, car c'est un exemple de Drag and Drop que j'ai très vite adapté à mon besoin.
Je n'aurais pas su le faire sans ce modèle créé par IceBird, ou du moins aussi vite.
Question, y-a-t-il un moyen simple d'afficher les poignées de sélection permettant de montrer les composants sélectionnés (ou le composant sélectionné et le dimmensionner)
Concernant la remarque du saccadement en cas de grille, la solutionne d'IceBird et évidemment la bonne pour avoir la même chose que dans l'EDI de DELPHI ou des autres EDI visuels, mais finalement, s'il y a grille pourquoi pas de saccadement ?
Et puis d'abord les grilles c'est nul !

Autre chose, le "Distance parcourue par la souris avant que le draggage ne commence :" est un truc extra pour éviter les dérappages du composant lors d'une sélection par click trop empressé. Mais dans ton exemple il n'est utile qu'en tant exemple, puisqu'il n'y a pas de sélection a proprement parlé.
30 points c'est beaucoup, pourquoi tant ?
Sous delphi ce serait bien utile un antidérapant de 5 points.

Antidérapant c'est aussi un adjectif que j'avais attribué à un ascenseur amélioré :
Lorsque l'on déplace le "curseur" d'un ascenceur, surtout s'il est long, il est fréquent que la souris "quitte" l'ascenceur, provocant un retour brutal de celui-ci à sa position d'origine. Pour éviter cela, j'avais ajouté un "ClipCursor" à OnMouseDown et à OnMouseUp, interdisant à la souris de quitter l'ascenceur si le bouton de la souris est enfoncé.
Ca devrait être ainsi dans toutes les interfaces graphiques.

Salut à tous !
Joyeux Réveillon !
(ne buvez pas trop, et ne buvez pas du tout si vous conduisez)
Bonne Année
Messages postés
10
Date d'inscription
lundi 14 novembre 2005
Statut
Membre
Dernière intervention
27 décembre 2005

A propos, je viens de penser à cela: on peut avoir un glissement "doux" avec malgré tout un attachement à une grille: il suffit d'ignorer l'increment dans le OnDragOver, et de l'appliquer lors d'un OnDragDrop.
Afficher les 9 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.