Control chevauchement DragOver

**BuzzLeclaire** · 29/09/2012, 10h18

Bonjour,

Je réaliser un Drag and Drop d'un TListbox vers un Panel.

Drop

Code :

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

1
2
3
4
5
6
7
8
9
procedure TFDossierTiers.sListBoxObjetsDragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if Source is TsListBox then
  begin
    TsListBox(Source).Left := X;
    TsListBox(Source).Top := Y;
  end;
end;

Over

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
procedure TFDossierTiers.sPanelDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
Var
  VeritableSource: TObject;
begin
  if (source is TsListBox) then
  begin
    With (Source As TsListBox) do
    begin
      case AnsiIndexStr(Items.Strings[ItemIndex],['Biseau','Etiquette','Zone saisie','Liste de choix','Zone note','Case à cocher']) of
        0:if not Chevauchement(TsBevel(Source),TsPanel(Sender)) then Accept := true;
        1:if not Chevauchement(TsLabel(Source),TsPanel(Sender)) then Accept := true;
        2:if not Chevauchement(TsDBEdit(Source),TsPanel(Sender)) then Accept := true;
        3:if not Chevauchement(TsDBComboBox(Source),TsPanel(Sender)) then Accept := true;
        4:if not Chevauchement(TsDBMemo(Source),TsPanel(Sender)) then Accept := true;
        5:if not Chevauchement(TsDBCheckBox(Source),TsPanel(Sender)) then Accept := true;
      end;
    end;
  end;
end;

Function Chevauvement

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
function TFDossierTiers.Chevauchement(Sender, Target: TObject): Boolean;
Var
  i : integer;
  R : TRect;
begin
  result := False;
 
  With Target do
  Begin
//Contrôle chevauchement
    for i := 0 to ControlCount -1 do
    begin
//Ignore le control sélectionné (lui-même)
     if Controls[i] = TWinControl(Sender) then Continue;
//Superposition ?
     Result := IntersectRect(R, Controls[i].BoundsRect, TWinControl(Sender).BoundsRect);
    end;
  End;
end;

La notion proprement parlé du chevauvement fonctionne, cependant lorsque je pose l'objet (END DRAG)

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
procedure TFDossierTiers.sListBoxObjetsEndDrag(Sender, Target: TObject; X,
  Y: Integer);
Var
  aParent: TObject;
begin
  if (Target is TsPanel) then
  begin
    With (Sender as TsListBox) do
    begin
      case AnsiIndexStr(Items.Strings[ItemIndex],['Biseau','Etiquette','Zone saisie','Liste de choix','Zone note','Case à cocher']) of
        0:{$REGION 'Création dynamique Bevel'}
        begin
          With TsBevel.Create(Self) do
          begin
            Parent := TsPanel(Target);
            Left := X;
            Top := Y;
          end;
        end;
          {$ENDREGION}
        1:{$REGION 'Création dynamique Etiquette'}
        begin
          With TsLabel.Create(Self) do
          begin
            Parent := TsPanel(Target);
            Caption := 'Etiquette';
            Left := X;
            Top := Y;
          end;
        end;
          {$ENDREGION}
        2:{$REGION 'Création dynamique Zone saisie'}
        begin
          With TsDBEdit.Create(Self) do
          begin
            Parent := TsPanel(Target);
            Left := X;
            Top := Y;
          end;
        end;
//...

Ma fonction ne prend pas en compte la taile Height et Witdh de l'objet que je pose.

Ma question comment prendre en compte la taille de mon objet en DragOver pour ne pas le poser sur un objet déjà créer ?

PS : j'ai déjà essayé dans ma function ceci :

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
function TFDossierTiers.Chevauchement(Sender, Target: TObject): Boolean;
Var
  i : integer;
  R : TRect;
begin
  result := False;
   if (Sender is TsBevel) then
   begin
     TWinControl(Sender).Height := 50;
     TWinControl(Sender).Width  := 50;
   end
   else
     if (Sender is TsLabel) then
     begin
       TWinControl(Sender).Height := 16;
       TWinControl(Sender).Width  := 50;
     end
     else
       if (Sender is TsDBEdit) then
       begin
         TWinControl(Sender).Height := 24;
         TWinControl(Sender).Width  := 121;
       end
       else
         if (Sender is TsDBCombobox) then
         begin
           TWinControl(Sender).Height := 24;
           TWinControl(Sender).Width  := 145;
         end
         else
           if (Sender is TsDBMemo) then
           begin
             TWinControl(Sender).Height := 89;
             TWinControl(Sender).Width  := 185;
           end
           else
             if (Sender is TsDBCheckBox) then
             begin
               TWinControl(Sender).Height := 22;
               TWinControl(Sender).Width  := 109;
             end;

**BuzzLeclaire** · 29/09/2012, 12h45

Bon je change la procédure Over du Panel

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
procedure TFDossierTiers.sPanelDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
Var
  aBevel: TsBevel;
  aLabel: TsLabel;
  aDBEdit: TsDBEdit;
  aDBComboBox : TsDBComboBox;
  aDBMemo: TsDBMemo;
  aDBCheckBox: TsDBCheckBox;
begin
  if (source is TsListBox) then
  begin
    With (Source As TsListBox) do
    begin
      case AnsiIndexStr(Items.Strings[ItemIndex],['Biseau','Etiquette','Zone saisie','Liste de choix','Zone note','Case à cocher']) of
        0:
        begin
          aBevel := TsBevel(Control);
          if not Chevauchement(TWinControl(Sender),aBevel) then Accept := true;
        end;
        1:
        begin
          aLabel := TsLabel(TControl);
          if not Chevauchement(TWinControl(Sender),aLabel) then Accept := true;
        end;
        2:
        begin
          aDBEdit := TsDBEdit(TControl);
          if not Chevauchement(TWinControl(Sender),ADBEdit) then Accept := true;
        end;
        3:
        begin
          aDBComboBox := TsDBComboBox(TControl);
          if not Chevauchement(TWinControl(Sender),aDBComboBox) then Accept := true;
        end;
        4:
        begin
          aDBMemo := TsDBMemo(TControl);
          if not Chevauchement(TWinControl(Sender),aDBMemo) then Accept := true;
        end;
        5:
        begin
          aDBCheckBox := TsDBCheckBox(TControl);
          if not Chevauchement(TWinControl(Sender),aDBCheckBox) then Accept := true;
        end;
      end;
    end;
  end;
end;

Function

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
function TFDossierTiers.Chevauchement(Sender:TWincontrol; Target: TObject): Boolean;
Var
  i : integer;
  R : TRect;
begin
  result := False;
 
  With Sender do
  Begin
//Contrôle chevauchement
//Ensemble des Objects du Sender = Tpanel
    for i := 0 to ControlCount -1 do
    begin
//Superposition ?
     Result := IntersectRect(R, Controls[i].BoundsRect, TWinControl(Target).BoundsRect);
    end;
  End;
end;

Mais sur les lignes comme :

aDBBevel := TsBevel(Control);

J'ai Identificateur non déclaré Control ???? Halucinant ?

Merci pour votre aide.

**tourlourou** · 29/09/2012, 13h52

Code :

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

1
2
aBevel := TsBevel(Control);
          aLabel := TsLabel(TControl);

Euh, ... ?

Control ne me semble pas une variable déclarée dans Panel.DragOver, et le cast du type TControl est surprenant aussi !

Du copier-coller pas relu ?

**BuzzLeclaire** · 29/09/2012, 16h34

Désolé pour le copier-coller, et ce n'est pas un problème de variable,
Je parlais de Controls.Control pour Control.

Après avoir essayé le DragImageList sur projet sépararé qui marchais super où je créer un bitmap au dimension de chaque Object, sur mon projet réel impossible de le faire marcher une tonne d'erreur EAccessVilation.

Bref, Je change de technique je vais passer par un Hook

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Var  // Gestion du glisser déposer
  MouseHook     : HHook;
  SelectedBevel : TsBevel = nil;
  SelectedLabel : TsLabel = nil;
  SelectedCombo : TsDBComboBox = nil;
  SelectedDBEdit: TsDBedit = nil;
  SelectedDBMemo: TsDBMemo = nil;
  SelectedDBCheckBox: TsDBCheckBox = nil;
  SelectedPanel  : TsPanel = nil; // le parent
  SelectedOffSet: TPoint;
Const
  WH_MOUSE_LL = 14;

Je commence on va bien voir.

**BuzzLeclaire** · 29/09/2012, 17h53

Bon,

J'ai réussi à faire fonctionner mon Drag&Drop avec un Hook.

Merci

@Exemple de Hook qui j'avais eu il y a trés lontemps par AndNotOr, je l'ai évidement adapter pour la situation.

Je garde le topic ouvert pour l'instant.

**BuzzLeclaire** · 29/09/2012, 19h28

J'ai donc réalisé le hook.

J'ai un souci juste sur la libération de l'object de type DBCombobox.

Concrétement j'ai prévu pendant le Hook que sur un clique droit
Message WM_RBUTTONDOWN de réaliser un Free de l'object, option permettant d'annuler pour l'utilisateur, cela fonctionne pour tous mes objects sauf le DBComboBox, je tombe sur une belle ACCESSVIOLATION.

Il y a-t-il des particularités sur le FREE d'un combobox ?

Merci

**BuzzLeclaire** · 06/10/2012, 21h11

Bon j'ai opter pour un mécanisme différent.

Chacun de mes composants ont un parent Panel, je n'ai plus aucun problème.

p'tit photo :

Control chevauchement DragOver

Delphi

Discussions similaires

Partager

Partager