Drag&drop de controles

Télécharger le projet
Commenter

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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (Icebird)