[Besoin de précisions sur le ControlAtPos]

**Nuclear88** · 12/01/2016, 19h11

Bonjour,

Voici mon problème :
J'aimerais que lors d'un "drag & drop" manuel, connaître le nom du TControl que je suis en train de survoler...
C'est sûr que je n'ai pas du tout compris comment marche le ControlAtPos. D'ailleurs, je pense même que cette méthode ne répondra pas forcément à mon problème...
Mais je m'obstine !

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm3 = class(TForm)
    Button1: TButton;
    Shape1: TShape;
    procedure Distribution;
    procedure Button1Click(Sender: TObject);
 
    procedure MonLabelMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
 
    procedure MonLabelMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
 
    procedure MonLabelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
  appuiclick:bool;
  PosX,PosY:integer;
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form3: TForm3;
 
implementation
 
{$R *.dfm}
 
procedure TForm3.Button1Click(Sender: TObject);
begin
Distribution;
end;
 
procedure TForm3.Distribution;
var
MonLabel:TLabel;
i:integer;
begin
randomize;//le randomize je le mettrai dans le FormCreate mais peu importe...
 
for i := 0 to 4 do
  begin
  MonLabel:=TLabel.create(self);
  MonLabel.Parent:=self;
  MonLabel.Top:=100;
  MonLabel.Left:=50+i*100;
  MonLabel.Caption:=IntToStr(random(1+999999));
  MonLabel.Font.Size:=12;
  MonLabel.OnMouseDown:=MonLabelMouseDown;
  MonLabel.OnMouseUp:=MonLabelMouseUp;
  MonLabel.OnMouseMove:=MonLabelMouseMove;
  end;
 
end;
 
 
procedure TForm3.MonLabelMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if appuiclick=true then
begin
TLabel(sender).Left:=TLabel(sender).Left+X-PosX;
TLabel(sender).Top:=TLabel(sender).Top+Y-PosY;
end;
 
end;
 
procedure TForm3.MonLabelMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
appuiclick:=true;
PosX:=X;
PosY:=Y;
end;

Pour le moment, ça fait bien ce que je désirais que ça fasse....
Mais c'est la suite qui cloche...
Le code ne marche pas mais je le post quand même :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
procedure TForm3.MonLabelMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
Apoint:Tpoint;
 
begin
APoint:=ScreenToClient(Mouse.CursorPos);
 
if ControlAtPos(APoint,false)is TShape then
begin
        ShowMessage('Shape en dessous');
end;
appuiclick:=false;
end;

En fait, j'aimerais qu'il me détecte le TControl que je suis en train de survoler (malgré le fait que je "tiens en permanence un TLabel).

N'hésitez pas à me proposer une autre solution, car je crois que cette méthode n'est pas forcément des plus adaptées !

Par avance, merci.

**ShaiLeTroll** · 13/01/2016, 11h44

1- Est-ce que le MonLabelMouseUp se produit bien lorsque tu arrête ton clic, quand tu fais ton "drop manuel" ?
2- As tu essayé "if ControlAtPos(APoint, False, False, True) is TShape" ?

if appuiclick=true then peut s'écrire plus simplementif appuiclick then
EDIT :

J'ai fait un test, le Label et le Shape ont comme parent un TTabSheet
La plupart du temps, c'est le label draggrable qui est le control survolé et j'ai bien le survol de mon Shape
Note que le Label est créé AVANT le Shape !

Par contre, dès que je créé un composant dynamiquement (par Double clic), comme le ControlAtPos commence par le dernière controle de la liste Controls[] c'est toujours le label en cours de déplacement que retourne le ControlAtPos
Il ne te faudrait pas déplacer le label durant le OnMouseMove mais plutôt faire un dessin dans le Canvas du Parent
Ou alors utiliser le BeginDrag/EndDrag ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
...
    tsLabelShape: TTabSheet;
    lblManualDraggableLabel: TLabel;
    shpManualDropableShape: TShape;
    lblManuelDragMonitor: TLabel;
...
    procedure lblManualDraggableLabelMouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure lblManualDraggableLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure lblManualDraggableLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure lblManualDraggableLabelDblClick(Sender: TObject);
 
...
  private
    { Déclarations privées }
    ManualDrag: record
      Control: TControl;
      OldCursorPos: TPoint;
    end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
procedure TZooThomVCLControlExperimentForm.lblManualDraggableLabelDblClick(Sender: TObject);
var
  MonLabel: TLabel;
begin
  MonLabel := TLabel.Create(Self);
  MonLabel.Parent := lblManualDraggableLabel.Parent;
  MonLabel.Top := lblManualDraggableLabel.Top + lblManualDraggableLabel.Height;
  MonLabel.Left := lblManualDraggableLabel.Left + 10;
  MonLabel.Caption := IntToStr(Integer(@MonLabel));
  MonLabel.Name := 'Label' + IntToStr(Integer(@MonLabel));
  MonLabel.OnMouseDown := lblManualDraggableLabel.OnMouseDown;
  MonLabel.OnMouseUp := lblManualDraggableLabel.OnMouseUp;
  MonLabel.OnMouseMove := lblManualDraggableLabel.OnMouseMove;
end;
 
 
procedure TZooShaiVCLControlExperimentForm.lblManualDraggableLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Sender is TControl then
  begin
    with ManualDrag do
    begin
      Control := TControl(Sender);
      OldCursorPos.X := X;
      OldCursorPos.Y := Y;
    end;
  end;
end;
 
procedure TZooShaiVCLControlExperimentForm.lblManualDraggableLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  MP: TPoint;
  MC: TControl;
begin
  if ManualDrag.Control = Sender then
  begin
    with ManualDrag do
    begin
      MP := Control.Parent.ScreenToClient(Mouse.CursorPos);
      MC := Control.Parent.ControlAtPos(MP, False);
      if Assigned(MC) then
        lblManuelDragMonitor.Caption := MC.Name
      else
        lblManuelDragMonitor.Caption := '?';
 
      with Control do
      begin
        Left := Left + X - OldCursorPos.X;
        Top := Top + Y - OldCursorPos.Y;
      end;
    end;
  end;
end;
 
procedure TZooShaiVCLControlExperimentForm.lblManualDraggableLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  MP: TPoint;
  MC: TControl;
begin
  if ManualDrag.Control = Sender then
  begin
    with ManualDrag do
    begin
      MP := Control.Parent.ScreenToClient(Mouse.CursorPos);
      MC := Control.Parent.ControlAtPos(MP, False);
      if Assigned(MC) then
        lblManuelDragMonitor.Caption := MC.Name
      else
        lblManuelDragMonitor.Caption := '?';
 
      Control := nil;
    end;
  end;
end;

**Nuclear88** · 13/01/2016, 18h26

Bonjour,

tout d'abord merci de t'être penché sur mon problème !
Décidément on le voit partout ce ShaiLeTroll

Il y a fort longtemps déjà, tu m'avais été d'une grande aide !

J'ai finalement opté pour une solution "clé en main", si je puis me permettre.
Il s'agit d'un code récupéré en ligne. Je le trouve particulièrement malin (moi qui suis plutôt du genre "usine à gaz"), c'est pour ça que je l'ai réutilisé.
Tout d'abord la fonction suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
function IsMouseOverControl(const ctrl: TControl): boolean;
var
  sr : TRect;
begin
  sr := Rect(ctrl.ClientToScreen(Point(0, 0)), ctrl.ClientToScreen(Point(ctrl.Width, ctrl.Height)));
 
  result := PtInRect(sr, Mouse.CursorPos);
end;

Et enfin son "application" pour mes besoins précis (au "relâché" du drop) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
procedure TForm3.MonLabelMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if IsMouseOverControl(Shape1) then
    ShowMessage('Shape1 en dessous');
 
appuiclick:=false;
 
end;

En espérant que cela aide quelqu'un à l'avenir !

Merci encore pour toutes ces attentions ShaiLeTroll !

Je passe mon topic à résolu du coup !

[Besoin de précisions sur le ControlAtPos]

Delphi

Discussions similaires

Partager

Partager