TTreeView, Events kommen falsch

[MmVisual]

Ich habe folgenden Code um ein TTreeView zu ändern, aber ich will nicht dass das OnChange Event aufgerufen wird:

Code: Alles auswählen

tvProjekt: TTreeView;
procedure TfrmMain.tvProjektChange(Sender: TObject; Node: TTreeNode);
Begin
  If NotGoot Then
  Begin
    tvProjekt.OnChanging := Nil;
    tvProjekt.OnChange := Nil;
    tvProjekt.Selected := nProjBeforeChg;
    tvProjekt.OnChange := @tvProjektChange;
    tvProjekt.OnChanging := @tvProjektChanging;
    ShowMessage('BlaBla');
    Abort;
  End;
End;

Aber das klappt nicht! OnChange wird zwei mal aufgerufen und es erscheinen zwei Message-Boxen.

Wenn ich das aber so mache:

Code: Alles auswählen

procedure TfrmMain.tvProjektChange(Sender: TObject; Node: TTreeNode);
Begin
  If NotGoot Then
  Begin
    tvProjekt.OnChanging := Nil;
    tvProjekt.OnChange := Nil;
    tvProjekt.Selected := nProjBeforeChg;
    ShowMessage('BlaBla');
    tvProjekt.OnChange := @tvProjektChange;
    tvProjekt.OnChanging := @tvProjektChanging;
    Abort;
  End;
End;

Dann klappt das richtig.
Ein tvProjekt.BeginUpdate; und tvProjekt.EndUpdate; und dazwischen die Änderung bringt auch nichts.

Ist das ein Bug für den Bugtracker?


Grüße Markus

[MmVisual]

PS: Hier ein Test-Projekt mit 2 Checkboxen um beides zu sehen.

[DiBo33]

Durch das ShowMessage wird das MessageLoop zwischen den 2 OnChange-Zuweisungen aufgerufen was bei der ersten Version nicht passiert.

Rufe statt ShowMessage Application.ProcessMessages auf, damit die MessageLoop zwischendurch abgearbeitet werden kann.

Kein Fall für ein Bugtracer.

[MmVisual]

Um bei meinem Beispiel Demo zu bleiben:

Code: Alles auswählen

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
  If CheckBox1.Checked Then
  Begin
    TreeView1.OnChanging := Nil;
    TreeView1.OnChange := Nil;
    TreeView1.Selected := nBeforeChg;
    TreeView1.OnChange := @TreeView1Change;
    TreeView1.OnChanging := @TreeView1Changing;
    Application.ProcessMessages;
    ShowMessage('BlaBla');
    Abort;
  End;
  If CheckBox2.Checked Then
  Begin
    TreeView1.OnChanging := Nil;
    TreeView1.OnChange := Nil;
    TreeView1.Selected := nBeforeChg;
    ShowMessage('BlaBla');
    TreeView1.OnChange := @TreeView1Change;
    TreeView1.OnChanging := @TreeView1Changing;
    Abort;
  End;
end;

Ich habe jetzt mal vor dem ShowMessage ein ProcessMessages eingefügt und es kommen dennoch 2 Message Boxen.

Ich denke es ist ein Bug.

[DiBo33]

Nein, Application.ProcessMessages; muß zwischen TreeView1.Selected := nBeforeChg; und TreeView1.OnChange := @TreeView1Change;

[MmVisual]

Jo, so was hatte ich auch schon gemacht, ich mache Pascal ja schon seit 13 Jahre.

Jetzt sieht der Code so aus:

Code: Alles auswählen

If CheckBox1.Checked Then
  Begin
    TreeView1.OnChanging := Nil;
    TreeView1.OnChange := Nil;
    TreeView1.Selected := nBeforeChg;
    Application.ProcessMessages;
    TreeView1.OnChange := @TreeView1Change;
    TreeView1.OnChanging := @TreeView1Changing;
    ShowMessage('BlaBla');
    Abort;
  End;

Und es geht, ein mal darfst Du raten ... nicht. (2 Message-Boxen kommen, man kann eine sogar weg schieben und man sieht dann beide auf dem Bildschirm!)
Als ob der im Hintergrund das Event, nach setzen auf NIL immer noch hat.

Nach wie vor, ich bleibe dabei es ist ein Bug. Der darf mir kein Event Change ausführen wenn ich ihm während dem Change das Event vorher weg nehme.
Bei z.B. TEdit oder anderen Komponenten geht das richtig.

[theo]

Schon mal mit TreeView1.LockSelectionChangeEvent / TreeView1.UnLockSelectionChangeEvent; versucht?

[DiBo33]

Scheint dann wohl doch ein Bug zu sein?

Probiere mal die von theo genannten Methoden, obs dann läuft.

[MmVisual]

Mit dem Theo-Trick stürzt die EXE sogar ab.

Der Code:

Code: Alles auswählen

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
  : : :
  If CheckBox3.Checked Then
  Begin
    TreeView1.LockSelectionChangeEvent;
    TreeView1.Selected := nBeforeChg;
    TreeView1.UnlockSelectionChangeEvent;
    ShowMessage('BlaBla');
    Abort;
  End;
end;

Die Fehlermeldung und der Code...

Bild1.png (7.41 KiB) 1557 mal betrachtet

[MmVisual]

Ich habe ein Bugreport geschrieben: http://bugs.freepascal.org/view.php?id=21652" onclick="window.open(this.href);return false;