Savoir si un composant est caché par un autre

**chekkal** · 09/09/2018, 12h41

Bonjour à tous,

j'ai une fiche "form1" contenant plusieurs composants (Tdbedit,Trichedit,Tlabel...ect) et j'ai programmé leur emplacement sur la fiche manuellement. De ce fait chacun peut mettre n'importe quel composant à n'importe quelle position sur la fiche, maintenant le problème est que si 2 composants se retrouvent dans le même emplacement alors l'un cache l'autre et je voudrais savoir si un composant est caché ou par un autre.

**Charly910** · 09/09/2018, 16h31

Bonjour,
qu'entends tu par "manuellement" : tu les poses à la souris depuis l'IDE, ou tu les créés dynamiquement dans ton code ?

Sinon, il y a la notion de premier plan et d’arrière plan qui modifie l'ordre de superposition

A+
Charly

**Mat.M** · 09/09/2018, 18h30

basiquement dans l'explorateur d'objet si tu as deux TEdit qui sont disposées au même emplacement ça permet de le voir
Sinon dans le code source également ( je n'ai pas delphi sous la main).

**chekkal** · 10/09/2018, 10h22

Bonjour,

les objets sont crées dynamiquement et l'utilisateur a la possibilité de les placer ou il veut on utilisant la souris, par contre je voudrais faire un contrôle qui m'avertirais si un tel ou tel objet est caché par un autre sur la fiche

**ALWEBER** · 10/09/2018, 11h06

Envoyé par chekkal

Bonjour,
les objets sont crées dynamiquement et l'utilisateur a la possibilité de les placer ou il veut on utilisant la souris, par contre je voudrais faire un contrôle qui m'avertirais si un tel ou tel objet est caché par un autre sur la fiche

Tu peux vérifier que le conteneur peut contenir l'objet à créer dans le cas d'un TButton dans un Tpanel.
Autrement tu peux créer un array of TRect et ajouter à chaque création d'objet le Top, Left, Top+Height, Left.Width comme nouvel élément de cet array
Ensuite tu contrôle avant de créer que les quatre points du composant à créer ne sont pas à l'intérieur d'un des éléments TRect du tableau

**chekkal** · 10/09/2018, 11h18

Bonjour,

Tu peux vérifier que le conteneur peut contenir l'objet à créer dans le cas d'un TButton dans un Tpanel.

Franchement j'ai pas compris

Autrement tu peux créer un array of TRect et ajouter à chaque création d'objet le Top, Left, Top+Height, Left.Width comme nouvel élément de cet array
Ensuite tu contrôle avant de créer que les quatre points du composant à créer ne sont pas à l'intérieur d'un des éléments TRect du tableau

j'ai bien pensé à ça mais le problème il me faut un tableau "array de 500 à 1000" parce-que on peut crée dynamiquement des milliers d'objet et ensuite à chaque déplacement d'un objet il faut rechercher dans le tableau "array" si il existe les même coordonnées

et c'est trés long.

**ShaiLeTroll** · 10/09/2018, 11h21

Avant de placer, tu utilises ControlAtPos
Le receveur de la méthode c'est le conteneur, la TForm un TPanel qui est fourni comme Parent aux contrôles crées dynamiquement
Le Point c'est la position de la souris obtenu par CursorPos et converti en coordonnées du conteneur via ScreenToClient

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
var
  MP: TPoint;
  MC: TControl
begin
  MP := Form1.ScreenToClient(Mouse.CursorPos);
  MC := Form1.ControlAtPos(MP, False, True);
  if not Assigned(MC) then 
   CreerNouveauControle
  else
    ErreurControleSuperpose

le code ci-dessus est basé sur la position de la souris
En réalité, que cela soit au moment du poser le contrôle ou lors du déplacement, il faut utiliser les Quatre coins du control déplacé

Tu peux aussi utiliser ControlCount \ Controls[], BoundsRect et PtInRect, c'est comme le tableau sauf que cela existe déjà, autant l'exploiter

Comme gère tu le déplacement de te contrôles ?
Tu as forcément déjà au besoin de savoir sur quel control tu cliques pour commencer le Drag&Drop

**ALWEBER** · 10/09/2018, 11h59

Voici un exemple que tu pourra adapter à ta convenance. Si tu veux que j'éclaircisse des points c'est possible :

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
 
unit ex01a;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
  Ar1: Array of TRect;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i1: Integer;
  bPossible: boolean;
  bt1: TButton;
  aRect: TRect;
 
  function EntreBornes(X, x1, x2, Y, y1, y2: Integer): boolean;
  begin
    result := (X > x1) and (X < x2) and (Y > y1) and (Y < y2);
  end;
 
begin
  bPossible := true;
  bt1 := TButton.Create(self);
  bt1.Top := Y;
  bt1.Left := X;
  aRect.Top := Y;
  aRect.Left := X;
  aRect.Bottom := Y + Button1.Height;
  aRect.Right := X + Button1.Width;
  if Length(Ar1) > 0 then
  begin
    for i1 := low(Ar1) to high(Ar1) do
    begin
      if EntreBornes(aRect.Left, Ar1[i1].Left, Ar1[i1].Right, aRect.Top,
        Ar1[i1].Top, Ar1[i1].Bottom) //
        or EntreBornes(aRect.Left, Ar1[i1].Left, Ar1[i1].Right, aRect.Bottom,
        Ar1[i1].Top, Ar1[i1].Bottom) //
        or EntreBornes(aRect.Right, Ar1[i1].Left, Ar1[i1].Right, aRect.Top,
        Ar1[i1].Top, Ar1[i1].Bottom) //
        or EntreBornes(aRect.Right, Ar1[i1].Left, Ar1[i1].Right, aRect.Bottom,
        Ar1[i1].Top, Ar1[i1].Bottom) then
        bPossible := false;
    end;
  end;
  if bPossible then
  begin
    bt1.Parent := Form1;
    SetLength(Ar1, Length(Ar1) + 1);
    Ar1[high(Ar1)] := aRect;
  end
  else
    bt1.Free;
end;
 
end.

**Andnotor** · 10/09/2018, 13h26

Contrôler les coins n'est pas fiable à 100% puisqu'on on pourrait ajouter un composant plus grand que le contrôle se trouvant en-dessous et utiliser IntersectsWith revient à boucler sur tous les composants

Il n'y a qu'en passant par des régions qu'on pourrait garantir le non-chevauchement (et à la vitesse max) :

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
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    FreeRegions :hRGN;
  public
    function CreateControl(const aClass :TControlClass; X, Y :integer; var aControl): boolean;
    function DropControl(aControl :TControl; X, Y :integer) :boolean;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  Control :TControl;
begin
  //Crée la région libre
  FreeRegions := CreateRectRgn(0, 0, ClientWidth, ClientHeight);
 
  CreateControl(TButton, 10, 10, Control);
  Control.SetTextBuf('Ok');
 
  CreateControl(TLabel, 10, 30, Control);
  Control.SetTextBuf('Pas ok');
 
  CreateControl(TPanel, 10, 40, Control);
  Control.SetTextBuf('Ok');
end;
 
function TForm1.CreateControl(const aClass :TControlClass; X, Y :integer; var aControl): boolean;
begin
  TControl(aControl) := aClass.Create(Self);
  Result := DropControl(TControl(aControl), X, Y);
 
  if Result
  then TControl(aControl).Parent := Self
  else FreeAndNil(aControl);
end;
 
function TForm1.DropControl(aControl: TControl; X, Y: integer): boolean;
var
  Bounds :TRect;
  RC, RF :hRgn;
 
begin
  Bounds := aControl.BoundsRect;
  Bounds.SetLocation(X, Y);
 
  //Crée la région du contrôle
  RC := CreateRectRgn(Bounds.Left, Bounds.Top, Bounds.Right, Bounds.Bottom);
 
  //Crée l'intersection avec la région "free"...
  RF := CreateRectRgn(0, 0, 0, 0);
  CombineRgn(RF, RC, FreeRegions, RGN_AND);
 
  //...qui doit être égale à la région du contrôle
  Result := EqualRgn(RF, RC);
 
  if Result then
  begin
    aControl.BoundsRect := Bounds;
    CombineRgn(FreeRegions, RC, FreeRegions, RGN_XOR);
  end;
 
  DeleteObject(RC);
  DeleteObject(RF);
end;

**ALWEBER** · 10/09/2018, 14h05

Envoyé par Andnotor

Contrôler les coins n'est pas fiable à 100% puisqu'on on pourrait ajouter un composant plus grand que le contrôle se trouvant en-dessous et utiliser IntersectsWith revient à boucler sur tous les composants

end;

Ma réponse était effectivement une ébauche de solution. Elle peut être complétée et ce n'est pas la seule comme tu l'exprime dans ton post

**tourlourou** · 10/09/2018, 14h40

Pour toutes ces questions, Andnotor est en quelque sorte le régional de l'étape !

**chekkal** · 10/09/2018, 16h42

J'ai réussi à régler le problème avec cette méthode

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
procedure TForm11.P1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
        leftinitial:=Twincontrol(Sender).left;
        topinitial:=Twincontrol(Sender).top;
        heightinitial:=Twincontrol(Sender).height;
        widthinitial:=Twincontrol(Sender).width;
 
end;
 
procedure TForm11.P1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
  OBJS,OBJC:Tcontrol;
  s:shortstring;
begin
      objs:=Tcontrol(sender);
      for I :=0 to form11.controlcount-1 do
      begin
             objc:=form11.Controls[i];
             if (objs<>objc)and(objc.Visible)and
             (((objs.left>=objc.Left)and(objs.top>=objc.top)and(objs.left+objs.width<objc.Left+objc.Width)and(objs.top+objs.height<objc.top+objc.height))or
              ((objs.left<=objc.Left)and(objs.top<=objc.top)and(objs.left+objs.width>objc.Left+objc.Width)and(objs.top+objs.height>objc.top+objc.height)))
              then
              begin
                      objs.left:=leftinitial;
                      objs.top:=topinitial;
                      objs.height:=heightinitial;
                      objs.width:=widthinitial;
 
              end;
 
      end;
 
end;

ainsi l'objet ne sera pas placé dans un coin ou il peut être caché par un autre objet ou lui même caché un objet. Je vous remercie beaucoup pour vos réponses.

**Andnotor** · 10/09/2018, 17h15

Ça peut pas marcher, tu ne traites qu'une petite partie des possibilités

Si tu veux vraiment faire une boucle : if objs.BoundsRect.IntersectsWith(objc.BoundsRect) then.

**chekkal** · 11/09/2018, 06h18

Bonjour,

Si tu veux vraiment faire une boucle : if objs.BoundsRect.IntersectsWith(objc.BoundsRect) then.

Ton exple est juste dans la mesure ou tu veut qu'aucun objet ne croise un autre, et c'est pas mon but. Moi la seule condition et qu'aucun objet "NE DOIT CACHER UN AUTRE", par contre si une partie d'un objet et caché par un autre là il ya pas de problème.

**Andnotor** · 11/09/2018, 09h25

Ah ! Fallait saisir la nuance

Mais deux contrôles de même taille parfaitement alignés (un complètement masqué) ne sont pas détectés.

Code :

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

objc.BoundsRect.Contains(objs.BoundsRect) or objs.BoundsRect.Contains(objc.BoundsRect)

Mais pour être parfaitement correct, il faudrait encore tester le Z-Order. Le plus petit pourrait être dessus et celui du dessous partiellement visible.

**anapurna** · 11/09/2018, 10h24

salut

Envoyé par chekkal

Bonjour,

Ton exple est juste dans la mesure ou tu veut qu'aucun objet ne croise un autre, et c'est pas mon but. Moi la seule condition et qu'aucun objet "NE DOIT CACHER UN AUTRE", par contre si une partie d'un objet et caché par un autre là il ya pas de problème.

tu oubli donc les objet pouvant être caché par deux objets cote à cote
╔═╦═╗
║╔║╗║
║╚║╝║
╚═╩═╝

**chekkal** · 11/09/2018, 13h39

Bonjour,
[QUOTE]Bonjour,

tu oubli donc les objet pouvant être caché par deux objets cote à cote
╔═╦═╗
║╔║╗║
║╚║╝║
╚═╩═╝

Non pas du tout, ce cas là ne peut jamais arriver parce que dans l’événement "onmouseup" je remet toujours le composant à son emplacement initiale

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
procedure TForm11.P1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
  OBJS,OBJC:Tcontrol;
  s:shortstring;
begin
      objs:=Tcontrol(sender);
      for I :=0 to form11.controlcount-1 do
      begin
             objc:=form11.Controls[i];
             if (objs<>objc)and(objc.Visible)and
             (((objs.left>=objc.Left)and(objs.top>=objc.top)and(objs.left+objs.width<objc.Left+objc.Width)and(objs.top+objs.height<objc.top+objc.height))or
              ((objs.left<=objc.Left)and(objs.top<=objc.top)and(objs.left+objs.width>objc.Left+objc.Width)and(objs.top+objs.height>objc.top+objc.height)))
              then
              begin
                      objs.left:=leftinitial;
                      objs.top:=topinitial;
                      objs.height:=heightinitial;
                      objs.width:=widthinitial;
 
              end;
 
      end;
 
end;

**anapurna** · 11/09/2018, 19h54

salut

revois ta copie dans se cas la cela ne marche pas
j'ai fait un test rapide avec trois bouton je peu recouvrir complètement l'un des boutons à l'aide des deux autres
debut
Nom : Capture.PNG
Affichages : 283
Taille : 2,3 Ko

Nom : Capture.PNG
Affichages : 283
Taille : 2,3 Ko

fin

Nom : Capture2.PNG
Affichages : 273
Taille : 1,3 Ko

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
 
type
   TForm2 = class(TForm)
    Button2: TButton;
    Button3: TButton;
    Button1: TButton;  
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
 private
     leftinitial : Integer;
     topinitial : Integer;
     heightinitial : Integer;
     widthinitial : Integer;
     selected : Boolean;
    { Déclarations privées }
  public
   ....
  End; 
 
procedure TForm2.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
  OBJS,OBJC:Tcontrol;
  s:shortstring;
begin
  selected := false;
  objs:=Tcontrol(sender);
  for I :=0 to Form2.controlcount-1 do
  begin
    objc:=Form2.Controls[i];
    if (objs<>objc)and(objc.Visible)and
      (((objs.left>=objc.Left)and(objs.top>=objc.top)and(objs.left+objs.width<objc.Left+objc.Width)and(objs.top+objs.height<objc.top+objc.height))or
      ((objs.left<=objc.Left)and(objs.top<=objc.top)and(objs.left+objs.width>objc.Left+objc.Width)and(objs.top+objs.height>objc.top+objc.height)))
        then
              begin
                      objs.left:=leftinitial;
                      objs.top:=topinitial;
                      objs.height:=heightinitial;
                      objs.width:=widthinitial;
 
              end
 
  end;
end;
 
 
procedure TForm2.Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  leftinitial:=Twincontrol(Sender).left;
  topinitial:=Twincontrol(Sender).top;
  heightinitial:=Twincontrol(Sender).height;
  widthinitial:=Twincontrol(Sender).width;
  selected := true;
end;
 
procedure TForm2.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if selected  and (Sender is TButton) then
  begin
    (Sender as TButton).Left := (Sender as TButton).Left + x;
    (Sender as TButton).Top := (Sender as TButton).Top + y;
  end;
end;

déplace les boutons comme j'ai indiqué sur le message précédent et tu vas peut être comprendre que ton test ne vérifie pas toutes les condition de masquage

en faites il faut que tu récupère le composant qui se trouve le plus bas (zorder) et ensuite tu verifie qu'il n'est pas totalement recouvert par les composant du dessus

**BigBisous1013** · 09/12/2018, 17h58

Teste la position des composants ' Left, Top, With, Height ) Puis BringToFront et SendToBack.

Un dinosaure

Savoir si un composant est caché par un autre

Composants VCL Delphi

Discussions similaires

Partager

Partager