Savoir si un composant est caché par un autre

Version imprimable

09/09/2018, 12h41
chekkal

Savoir si un composant est caché par un autre

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.
09/09/2018, 16h31
Charly910

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
09/09/2018, 18h30
Mat.M

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).
10/09/2018, 10h22
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
10/09/2018, 11h06
ALWEBER

Une réponse

Citation:

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
10/09/2018, 11h18
chekkal

Bonjour,

Citation:

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

Citation:

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 :roll: et c'est trés long.

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:

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

Un exemple

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

Code:

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.

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:

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;

10/09/2018, 14h05
ALWEBER

Citation:

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
10/09/2018, 14h40
tourlourou

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

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

Code:

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.;)

10/09/2018, 17h15
Andnotor

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

Si tu veux vraiment faire une boucle : if objs.BoundsRect.IntersectsWith(objc.BoundsRect) then.
11/09/2018, 06h18
chekkal

Bonjour,

Citation:

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.
11/09/2018, 09h25
Andnotor

Ah ! Fallait saisir la nuance :roll:

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

Code:

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.
11/09/2018, 10h24
anapurna

salut

Citation:

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
╔═╦═╗
║╔║╗║
║╚║╝║
╚═╩═╝

Bonjour,
[QUOTE]Bonjour,

Citation:

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:

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;

2 pièce(s) jointe(s)

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
Pièce jointe 410851
fin Pièce jointe 410855

Code:

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

09/12/2018, 17h58
BigBisous1013

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

Un dinosaure