Discussion :

[RamDevTeam]

Bonjour,

J'ai créé un Composant perso (TplanItem) dérivé de Tpanel.
Pour l'instant, je n'ai pas placé le compo dans un paquet pour le rendre accessible via la palette.

J'essayé de mettre en place le drag&drop.

Pour résumer le code =>
d'un côté une form TplanningMensuel "vide".
Lors du chargement de cette form, elle crée l'ensemble des TplanItem dynamiquement et repositionne les gestionnaires d'événements des TplanItem.

j'ai déjà géré le Click sans soucis.

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
PlanningMensuelU;
 
...
 
// le nouveau Panel
type TPlanItem = class(tpanel)
   public
       Titre : Tlabel;
       etc... 
   end;
 
// gestion des évenements à retransmettre
 
type TNotifyMouseDown = procedure(Sender: TObject;  Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;
type TnotifyDragDrop = procedure (Sender, Source: TObject; X,  Y: Integer) of object;
 
 
// form Planning
TPlanningMensuel = class(TForm)
private
    procedure ClickOnItem(Sender : tobject);
    procedure ItemMouseDown(Sender: TObject;  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
public
          eventPlanItemtMouseDown : TNotifyMouseDown ;  
          eventPlanItemtClickOnItem : TnotifyEvent;
          procedure SetItem( MesParams ....);
end;
 
procedure TPlanningMensuel.ClickOnItem(Sender : tobject);
var
 oItem : TplanItem;
begin
   oItem := .... récup du bon objet en fonction de la classe du sender
   if assigned(eventPlanItemClickOnITem) then
       eventPlanItemClickOnITem(oitem);
end;
 
procedure TPlanningMensuel.itemMouseDown(Sender: TObject;  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 oItem : TplanItem;
begin
   oItem := .... récup du bon objet en fonction de la classe du sender
  if assigned(oitem) then
  begin
   try
    trace.Write('TPlanningMensuel.itemMouseDown  oItem is assigned');
    if assigned(eventPlanItemMouseDown) then
    begin
       trace.Write('TPlanningMensuel.itemMouseDown, appel de EventPlanItemMouseDown');
       eventPlanItemMouseDown(Sender, button, shift, x, y);
    end;
   except
    on E:Exception do
       trace.Write('  TPlanningMensuel.itemMouseDown, Erreur=' + e.message);
   end;
  end;
end;
 
 
procedure TPlanningMensuel.SetItem( Mesparams ....);
var
 oItem : TplanItem;
begin
    // création dynamique du TplanItem (et création et mise en form des composants inclus ... tlabel,    tImage, Tshape etc...)
 
   //Affectation des gestionnaires d'évenements on fait pointer vers les procédure déclarée en private.
 
    oItem.OnClick := ClickOnItem;
    oItem.OnMousedown := ItemMouseDown;
    oItem.OnDragDrop := Itemdragdrop
 
    oItem.Titre.OnClick := ClickOnItem;
    oItem.Titre.OnMousedown := ItemMouseDown;  
    oItem.Titre.OnDragDrop := Itemdragdrop;
 
 
end;

Concernant l'appel de cet écran.

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
unit EcranClient;
 
 
type TEcranClient = class(tform)
private
   ...
   procedure ClickOnMensItem(sender : tobject);
   procedure PlanItemMouseDown(Sender: TObject;  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  PlanItemDragDrop(Sender, Source: TObject; X,  Y: Integer) ;
public
 
end;
 
 
procedure TEcranClient .ClickOnMensItem(sender : tobject);
begin
    trace.write('>déclenchement de ClickOnMensItem' );
    ... traitement ok
end;
 
procedure TEcranClient .PlanItemMouseDown(Sender: TObject;  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    trace.write('>déclenchement de PlanItemMouseDown' );
    try trace.write('  sender.ClassName = ' + sender.classname); except end;
 
  if (button = mbLeft) and not (ssDouble in Shift)   then
  begin
     trace.write('  BeginDrag <- True');
     BeginDrag(true);
  end;
end;
 
procedure TEcranClient .PlanItemDragDrop(Sender, Source: TObject; X,  Y: Integer) ;
begin
    trace.write('> déclenchement de PlanItemDragDrop' );
    try trace.write('  sender.ClassName = ' + sender.classname); except end;
    try trace.write('  Source.ClassName = ' + Source.classname); except end;
end;
 
procedure TEcranClient.LancementPlanning;
var
  fPlanning : TPlanningMensuel;
begin
   fPlanning := TPlanningMensuel.create(self);
   //... initialisation de l'écran
   fplanning.EventPlanItemclickonitem := ClickOnMensItem;
   fplanning.eventPlanItemDragDrop := PlanItemDragDrop;
   fplanning.eventPlanItemMouseDown := PlanItemMouseDown;
 
   // ensuite on charge les éléments 
  while ..... do begin 
       fplanning.SetItem( Mesparams ....); 
  end;
end;

voici les logs lors qu'on appuie sur le bouton gauche de la souris sur un TplanItem =>

[11316] TPlanningMensuel.itemMouseDown sender=TLabel
[11316] TPlanningMensuel.itemMouseDown oItem is assigned
[11316] TPlanningMensuel.itemMouseDown, appel de EventPlanItemMouseDown
[11316] >déclenchement de PlanItemMouseDown
[11316] sender.ClassName = TLabel
[11316] BeginDrag <- True
[11316] TPlanningMensuel.itemMouseDown, Erreur=Cannot drag a form

Je ne vois pas trop où chercher.
Le sender recu par ItemMouseDown n'est pas un Tform mais le Tlabel qui sert de titre au compo.

[Eric Boisvert]

Je ne vois pas trop où chercher.
Le sender recu par ItemMouseDown n'est pas un Tform mais le Tlabel qui sert de titre au compo.

alors il faudrait appeler BeginDrag du sender...

Code :

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

1
2
 
with sender as TControl do BeginDrag(True);

non?

[RamDevTeam]

Effectivement, c'est aussi bête que çà ....
Merci.