Discussion :

[BuzzLeclaire]

Bonjour à tous.

J'ai besoin de comprendre pourquoi Delphi refuse cette procédure
(cela me génere une erreur de type : Access violation adresse xxxxx....
si je persiste j'ai une Abstract error)

Code :

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

1
2
3
4
5
6
procedure TFormPrincipal.ShapeDblClick(Sender: TObject);
begin
  if (Sender is TShape) then TShape(Sender).Free;

// .. suite du programme
end;

alors que cette fonctionne marche trés bien :

Code :

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

1
2
3
4
5
6
7
procedure TFormPrincipal.Supprimer1Click(Sender: TObject);
begin
 
  PopupMenu1.PopupComponent.free;
// .. suite du programme
 
end;

Dans le 1ere Cas lorsque je double clique sur mon composant je souhaiterais supprimer/liberer le shape sachant qu'il peux y avoir plusieur shapes

Dans le 2ème Cas je passe par un clique Droit sur le shape et là aucun probleme de suppression/libération du Shape

Je sais que l'on doit supprimer les composants dans le sens inverse de leur création.
Mais j'ai besoin de pouvoir supprimer n'importe que de mes composants. Le pire c'est que par le popupmenu je n'ai aucun probleme.

Avez vous une explication ?

[philnext]

Moi je dirais que c'est par ce que tu es dans un événement de ton TShape et que tu essayes de le détruire !!

[guillemouze]

petite explication 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
 
procedure TFormPrincipal.ShapeDblClick(Sender: TObject);
begin
  if (Sender is TShape) then 
    TShape(Sender).Free; // ici tu liberer le sender
 
// .. suite du programme
end;
 
procedure TShape.DblClick;
begin
  if Assigned(OnDblClick) then
    OnDblClick(Self); // = appel de ta procedure "ShapeDblClick"
 
  // a partir d'ici, Self est detruit. Donc tout le code qui suivera qui fera reference a self plantera, comme par exemple:
  Self.Invalidate; // self a ete detruit ->pointeur dans l'espace
 
end;

[Paul TOTH]

et plus exactement

Code :

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

1
2
3
4
5
6
7
8
9
 
procedure TControl.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  SendCancelMode(Self);
  inherited;
  if csCaptureMouse in ControlStyle then MouseCapture := True;
  if csClickEvents in ControlStyle then DblClick;
  DoMouseDown(Message, mbLeft, [ssDouble]);
end;

après le DblClick tu as scié la branche sur laquelle tu étais et DoMouseDown se plante

voici une solution :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
procedure TFormPrincipal.ShapeDblClick(Sender: TObject);
begin
  if (Sender is TShape) then 
    PostMessage(Handle, WM_USER, Integer(Sender),0); 
// .. suite du programme
end;
 
procedure TFormPrincipal.WMUser(var Msg:TMesage); // message WM_USER
begin
  TObject(Msg.wParam).Free;
end;

en voici une autre :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
procedure TFormPrincipal.ShapeDblClick(Sender: TObject);
begin
  if (Sender is TShape) then 
    Garbage.Add(Sender);  // Garbage : TObjectList créé dans le OnCreate
// .. suite du programme
end;
 
procedure TFormPrincipal.OnIdle(..); // Application.OnIdle := OnIdle;
begin
   Garbage.Clear; // ce qui détruit les objets
end;

[Andnotor]

Même s'il s'agit d'un PostMessage, je le mettrais à la fin de la procédure dans le cas où un Application.ProcessMessages traînerait dans Suite du programme.

Qu'en penses-tu Paul ?

Code :

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

1
2
3
4
5
6
procedure TFormPrincipal.ShapeDblClick(Sender: TObject);
begin
// .. suite du programme
  if (Sender is TShape) then 
    PostMessage(Handle, WM_USER, Integer(Sender),0); 
end;

[BuzzLeclaire]

Je comprends mieux mon erreur, je vais tester vos diverses solutions et je reviens pour vous dire.

Merci encore.

[Paul TOTH]

Même s'il s'agit d'un PostMessage, je le mettrais à la fin de la procédure dans le cas où un Application.ProcessMessages traînerait dans Suite du programme.

Qu'en penses-tu Paul ?

Code :

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

1
2
3
4
5
6
procedure TFormPrincipal.ShapeDblClick(Sender: TObject);
begin
// .. suite du programme
  if (Sender is TShape) then 
    PostMessage(Handle, WM_USER, Integer(Sender),0); 
end;

oui c'est vaguement pour cela que j'ai pensé à l'idée du Garbage

sinon l'événement MouseUp est peut-être plus indiqué, car il n'y a pas de traitement après coup

[BuzzLeclaire]

Bonjour à tous,

J'ai donc mis en place la procédure de Toth modifié par AndNotOr.

Code :

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

1
2
3
4
5
6
7
procedure TFormPrincipal.ShapeDblClick(Sender: TObject);
begin
// .. Traitement avant Free
 
  if (Sender is TShape) then 
    PostMessage(Handle, WM_USER, Integer(Sender),0); 
end;

Code :

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

1
2
3
4
procedure TFormPrincipal.WMUser(var Msg:TMesage); // message WM_USER
begin
  TObject(Msg.wParam).Free;
end;

J'ai n'ai plus de message d'érreur mais le shape n'est pas bien libéré.

Il ne s'éfface pas... il ne se passe rien.
La procedure WMUSER n'ai pas visité j'ai mis un Showmessage en dessous du xxxX.Free; et il ne s'affiche pas.


Pour info :
Mon Shape à aussi ces évenements :
- Shape.OndDlClk
- Shape.PoppuMenu
// Pour les evenements Move and resize
Formprincipal.MouseDown
FormPrincipal.MouseMove
FormPrinicpal.MouseUp
// Donc je peux pas utiliser le free ici car sinon lorsque j'utiliserais ces evenements il disparaitrait apres mouvement...

[BuzzLeclaire]

Ne tenez ma compte de mon message ci-dessous, j'avais mal déclarer ma procédure

Code :

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

1
2
// Déclaration
    procedure WMUser(var Msg:TMessage); message WM_User;

voici les procédures réellement utilisées :

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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
procedure TFormPrincipal.ShapeDblClick(Sender: TObject);
Var
  ChaineDroite, ChaineDroiteX: String;
  ChaineGauche: String;
begin
  TimerInsert.Enabled := False;
  TimerDelete.Enabled := False;

// On recherche la référence du Shape
  StatusBar1.Panels[0].Text := 'Modification tâche';
  if (Sender is TShape) then
  Begin
    ChaineDroite:=Droite('PANEL',TShape(Sender).Name);
    ChaineGauche:=Gauche('PANEL',TShape(Sender).Name);
    ChaineDroiteX := Droite('X',TShape(Sender).Name);
// Avant l'astuce de Toht et AndNotOr
//    TShape(Sender).Visible := False; 
//    TShape(Sender).Tag := -1000;
    Modification := True; // Variable globale pour autre traitement
    ModifDirecte := False;
  end;
// On supprimer l'enregistrement de la base de données
// Mais avant on mémorise tous les champs servant pour le form
// de saisie de tâche
  Try
    With ModuleDeDonneeSecondaire do
    Begin
      ADOCalendrier.Open;
      ADOCalendrier.Edit;
      if (ChaineGauche = '') //and (ChaineDroite <> '')
        then ADOCalendrier.Filter := 'NumEdit = '+ChaineDroite
          Else ADOCalendrier.Filter := 'Name = '+QuotedStr(ChaineDroiteX);
        ADOCalendrier.Filtered := true;
    // On alimentation la fiche de Saisie pour modification
        InfoCodeSalarie := ADOCalendrier.FieldByName('CodeSalarie').AsString;
        InfoNomSalarie := ADOCalendrier.FieldByName('NomSalarie').AsString;
        InfoLigne := ADOCalendrier.FieldByName('ARow').AsInteger;
        InfoColonne := ADOCalendrier.FieldByName('ACol').AsInteger;
        InfoNumeroSemaine := ADOCalendrier.FieldByName('NumeroSemaine').AsString;
        InfoHeureDebutNumItem := ADOCalendrier.FieldByName('HeureDebutNumItem').AsInteger;
        InfoHeureFinNumItem := ADOCalendrier.FieldByName('HeureFinNumItem').AsInteger;
        InfoDateDebutNumItem := ADOCalendrier.Fields.Fields[11].AsInteger;
        InfoDateFinNumItem := ADOCalendrier.FieldByName('DateFinNumItem').AsInteger;
        InfoCodeCategorieTache := ADOCalendrier.FieldByName('CodeCategorieTache').AsInteger;
        InfoDevisTache := ADOCalendrier.FieldByName('DevisTache').AsString;
        InfoTrancheTache := ADOCalendrier.FieldByName('TrancheTache').AsString;
        InfoMemoDevis := ADOCalendrier.FieldByName('MemoDevis').AsString;
        InfoNumDevis := ADOCalendrier.FieldByName('NumDevis').AsString;
        InfoColor := ADOCalendrier.FieldByName('Color').ASString;
//        InfoMemoTache := ADOCalendrier.FieldByName('MemoTache').AsString;
        InfoTop := ADOCalendrier.FieldByName('Top').AsInteger;
        InfoLeft := ADOCalendrier.FieldByName('left').AsInteger;
        InfoHeight := ADOCalendrier.FieldByName('height').AsInteger;
        InfoWidth := ADOCalendrier.FieldByName('Width').AsInteger;
        InfoHint := ADOCalendrier.FieldByName('Hint').AsString;
        InfoClient := ADOCalendrier.FieldByName('Client').AsString;
        InfoTelClient := ADOCalendrier.FieldByName('TelClient').AsString;
        InfoPortableClient := ADOCalendrier.FieldByName('PortableClient').AsString;
        InfoCodeClient := ADOCalendrier.FieldByName('CodeClient').AsString;
        InfoCpClient := ADOCalendrier.FieldByName('CpClient').AsString;
        InfoVilleClient := ADOCalendrier.FieldByName('VilleClient').AsString;
        InfoObjet := ADOCalendrier.FieldByName('Objet').AsString;
        InfoLibelleHint1 := ADOCalendrier.FieldByName('Hint1').AsString;
        InfoLibelleHint2 := ADOCalendrier.FieldByName('Hint2').AsString;
        InfoLibelleHint3 := ADOCalendrier.FieldByName('Hint3').AsString;
        InfoLibelleHint4 := ADOCalendrier.FieldByName('Hint4').AsString;
        InfoLibelleHint5 := ADOCalendrier.FieldByName('Hint5').AsString;
        InfoLibelleHint6 := ADOCalendrier.FieldByName('Hint6').AsString;
        InfoLibelleHint7 := ADOCalendrier.FieldByName('Hint7').AsString;
        InfoLibelleHint8 := ADOCalendrier.FieldByName('Hint8').AsString;
        InfoLibelleHint9 := ADOCalendrier.FieldByName('Hint9').AsString;
        InfoLibelleHint10 := ADOCalendrier.FieldByName('Hint10').AsString;
        InfoJourDeDebutEnNbr := ADOCalendrier.FieldByName('NumJourDebut').AsInteger;
        InfoJourDeFinEnNbr := ADOCalendrier.FieldByName('NumJourFin').AsInteger;
        InfoDateDebut := AdoCalendrier.FieldByName('DateDebut').AsDateTime;
        InfoDateFin := AdoCalendrier.FieldByName('DateFin').AsDateTime;
  // on supprime l'enregistrement existant du panel en cours
      ADOCalendrier.Delete;
  // On Ferme tout.
      ADOCalendrier.Filtered := false;
      ADOCalendrier.Close;
    end;
  Except
    ShowMessage('Erreur pendant la tentative de modification de cette tâche');
  end;
  if (Sender is TShape) then
  Begin
  // on créera un nouveau Shape en ouvrant la fenêtre de saisie
    FormVisuJour := TFormVisuJour.Create(Application);
    FormSaisieTache := TFormSaisieTache.Create(Application);
    Try
      FormSaisieTache.ShowModal;
      FormSaisieTache.Release;
    Finally
      FormSaisieTache.free;
    end;
    UneTacheAEteCreer := True;
    Modification := False;
  end;
  StringGridSemaine.CheckInBounds;
  StatusBar1.Panels[0].Text := 'Planning Light '+Commun.Version;

  TimerInsert.Enabled := True;
  TimerDelete.Enabled := True;

// Astuce Forum Devellopez.com (TOHT et AndNotOr)
  if (Sender is TShape) then
    PostMessage(Handle, WM_USER, Integer(Sender),0);
end;

Code :

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

1
2
3
4
procedure TFormPrincipal.WMUser(var Msg:TMessage); // message WM_USER
begin
  TObject(Msg.wParam).Free;
end;

Cela fonctionne trés bien le shape est bien libéré.

Merci à vous deux. je n'aurai jamais trouvé sans vous.