Probleme mit dem Freigeben von TabSheets

[r2c2]

Hallo an alle,

Ich programmiere gerade n ersatz für das Startmenü. D.h. das Prog hab ich schon vor ca. 2 Jahren programmiert, aber

dementsprechend sieht es auch aus: keine OOP, schlechter Programmierstil...

Ich wollte das dann mal verbessern. Soweit hab ich das - im Groben - auch fertig, nur hab ich komischerweise Probleme

mit dem Free von den TabSheets:

So hab ich das ursprünglich gemacht:

Delphi-Quellcode:

procedure TUEAppBar.DeleteGroupSBClick(Sender: TObject);
var
  GroupName: String;
  MsgText: String;
  List: TStringList;
  i: Integer;
begin
  GroupName := PageControl1.ActivePage.Caption;
  MsgText := 'Soll die Gruppe "' + GroupName + '" wirklich gelöscht werden?';
  if MessageDlg(MsgText, mtConfirmation, mbOKCancel, 0) = mrOK then
  begin
    if DeleteDir(ExtractFilePath(ParamStr(0)) + 'Links\' + PageControl1.ActivePage.Caption) then
    begin
      for i := 0 to PageControl1.ActivePage.ComponentCount -1 do // das hätte Probleme gegeben, wenn ComponentCount nicht 1 gewesen wäre ;-)
      begin
        PageControl1.ActivePage.Components[i].Free;   // wäre eigentlich unnötig,
      end;
      PageControl1.ActivePage.Free;  // weil heimit doch eigentlich alles freigeben wird
      List := TStringList.Create;
      try  // zu der Zeit kannte ich scheinbar FindFirst/Next noch nicht, also hab ich die zu öffnenden Order in ner TextDatei gespeichert
        List.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'UEAppBar.dat');
        List.Delete(List.IndexOf(GroupName));
        List.SaveToFile(ExtractFilePath(ParamStr(0)) + 'UEAppBar.dat');
      finally
        List.Free;
      end;
    end
    else
    begin
      ShowMessage('Ein Fehler ist aufgetreten! Gruppe konnte nicht gelöscht werden.');
    end;
  end;
end;

Jetzt mach ich das so:

Delphi-Quellcode:

procedure TUEAppBar.DeleteGroupSBClick(Sender: TObject);
var
  GroupName: String;
  MsgText: String;
begin
  GroupName := PageControl1.ActivePage.Caption;
  MsgText := 'Soll die Gruppe "' + GroupName + '" wirklich gelöscht werden?';
  if MessageDlg(MsgText, mtConfirmation, mbOKCancel, 0) = mrOK then
  begin
   if Groups.DeleteGroup(GroupName) then
     MessageDlg('Die Gruppe "' +  GroupName + '" wurde gelöscht!',
       mtInformation, [mbOK], 0);
  end;
end;

Das eigentliche Löschen passiert in der Klasse TGroups:

Delphi-Quellcode:

function TGroups.DeleteGroup(const AName: string): Boolean;
var i: Integer;
begin
  Result := False;
  if DeleteDir(ExtractFilePath(ParamStr(0)) + 'Links\' + AName) then
  begin
    FPageControl.ActivePage.Free; // FPageControl is n Pointer auf das PageContol auf der Form
    Result := True;
  end;
end;

Ich bekomme leider immer ne AccessViolation. Und zwar direkt nach dem Anzeigen des MessageDlg: "Die Gruppe wurde

gelöscht". Wenn ich mit [F8] duchsteppe, komme ich auch nicht weiter, die AV kommt direkt nach der Message.

Ich hab schon versucht
- direkt im Click-Ereignis zu löschen(also ohne den Pointer) --> funktioniert auch nicht
- die Componenten auf dem TabSheet manuell freizugeben --> funktioniert auch nicht
- alle TabSheets zu löschen und dann neu anzuzeigen --> auch das funktioniert nicht

Teilweise - je nachdem, wie ich meinen Quelltext umbaue - erhalte ich auch ne AV an der Adresse 0.

Weil ich auch in manchen Fällen die Meldung erhalte, dass das Objekt '' kein Parent hat, bin ich auf die Idee gekommen,

dass schon beim Erstellen der TabSheets was nicht stimmt:

Delphi-Quellcode:

function TGroups.CreateTab(AName: string): TShellListView;
var
  Tab: TTabSheet;
  ListView: TShellListView;
  i: Integer;
begin
  Tab := TTabSheet.Create(FPageControl);
  Tab.PageControl := FPageControl;
  Tab.Parent := FPageControl;
  Tab.Caption := AName;
  ListView := TShellListView.Create(Tab);
  ListView.Parent := Tab;
  ListView.Align := alClient;
  ListView.BorderStyle := bsNone;
  ListView.FlatScrollBars := True;
  ListView.HotTrackStyles := [htHandPoint, htUnderlineHot];
  ListView.MultiSelect := False;
  ListView.ViewStyle := vsReport;
  ListView.ShowColumnHeaders := False;
  ListView.HideSelection := True;
  ListView.Root := ExtractFilePath(ParamStr(0)) + 'Links\' + AName;
  ListView.OnMouseDown := ShellListViewMouseDown;
  ListView.AutoRefresh := True;
  for i := ListView.Columns.Count -1 downto 1 do
  begin
    ListView.Columns.Items[i].Free;
  end;
  Result := ListView;
end;

Da find ich aber auch keinen Fehler. Der Leerstring in der Fehlermeldung kommt wahrscheinlich daher, dass ich den Tabs

keinen Namen verpasst habe. Wenn ich das ändere, bekomme ich aber wieder die AV und nicht die Kein-Parent-Meldung,

ich kann also schlecht sagen, obs an den TabSheets, oder an den ShellListViews hängt.

Irgendwo muss ich was ganz dummes falsch geacht haben. Ich hab nur keine Ahnung was!

mfg

Christian

P.S.: @Mods: bin mir nicht sicher, ob ich hier richtig bin, wenn nicht, einfach verschieben...

Anhang: Im Anhang is der komplette Quelltext, wenn den jemand 'braucht'...

[marabu]

Hallo Christian,

einfach ActivePage frei zu geben ist vielleicht nicht die beste Methode. Nachdem du im MessageDialog das erfolgreiche ActivePage.Free verkündet hast, greift dein Programm auf diesen Zeiger zu um die Form neu zu zeichnen. Merke dir die ActivePage in DelPage, schalte auf eine andere Page um, und gib dann DelPage frei - dann sollte keine AV mehr an der Stelle auftreten.

Grüße vom marabu

[r2c2]

Hallo marabu,

ich habs jetzt so gemacht, wie dus gesagt hast, aber es funktioniert leider immer noch nicht!
Ich bekomme wahlweise(ohne, dass ich was am Quelltext ändere) ne AV oder die Meldung: "Element '' hat kein übergeordnetes Fenster". Ich kapier das net. Irgendwo muss doch der Fehler sein...

Naja, trotzdem danke.

mfg

Christian

[r2c2]

Naja, wenn keiner mehr weiter weiß bzw. sich keiner mehr durch meinen - zugegeben langen - Post quälen will, muss ich eben alleine weiter suchen...

mfg

Christian

[marabu]

Hallo Christian,

zwei Sachen fallen mir an deinem Code auf. Zum Einen verwendest du CreateDir() zum Anlegen eines Unterverzeichnisses von '.\Links\' - das funktioniert vielleicht auf deiner Maschine, aber anderswo eher nicht. Du solltest da besser ForceDirectories() verwenden. Zum Anderen entfernst du beim Löschen das Verzeichnis auf der Platte, aber im darauf folgenden CreateGroups greifst du wieder auf das noch existierende TabSheet zu, was zum Knall führt.

Grüße vom marabu

Nachtrag:

Bei DeleteDir() musst du mal nachsehen. Da wird gemeldet Zugriff verweigert. Du kannst das Verzeichnis nicht erfolgreich löschen, solange es noch als Root in deiner ShellListView eingetragen ist.

[r2c2]

Hallo marabu,
danke für die Antwort. Ich werd das auf jeden Fall noch mal checken. Ob heut noch oder erst morgen, weiß ich noch nicht. Auf jeden Fall hört sich das doch schon Mal ganz vielversprechend an...

mfg

Christian

[r2c2]

Zum fortlaufen! Auch das klappt net. Zwischendurch hab ich gedacht es liegt vielleicht daran, wie der Ordner gelöscht wird. Lösch ich den nämlich nicht, klappt alles problemlos ohne AV. Ich hab also die Funktion DeleteDir von ner Funktion, die ich irgendwo gefunden hab, auf ne eigene umgestellt(jetzt wird das Verzeichnis rekursiv gelöscht). Nur leider klappt auch das net.

Momentan sieht meine Funktion so aus:

Delphi-Quellcode:

function TGroups.DeleteGroup(const AName: string): Boolean;
var
  DelPage: Integer;
begin
  Result := False;
  (FPageControl.ActivePage.Components[0] as TShellListView).Root := 'C:\'; // Root umstellen
  if DeleteDir(ExtractFilePath(ParamStr(0)) + 'Links\' + AName) then // Ordner löschen
  begin
    DelPage := FPageControl.ActivePageIndex; // Index merken
    ActivateStd; // die Registerkarte "Standard" aktivieren
    FPageControl.Pages[DelPage].Free; // Free.
    Result := True;
  end;
end;

Irgendwie muss es aber doch am ShellistView liegen!

mfg

Christian

[Khabarakh]

Wo genau kommt denn die Exception?

[r2c2]

Wo genau? Genau das is ja mein Problem.

Wenn ich mit Step([F8]) debugge, kommt die Exception genau nach dem MessageDlg, ergo am ende der Prozedur DeleteGroupSBClick.
Wenn ich stattdessen mit [F7] weitermache, seh ich, wie der MessageDlg aufgerufen wird und ich hüpf fröhlich in anderen Units rum. Irgendwann kommt dann eine Meldung: "Wegen zu vieler Exceptions kann das Programm nicht weitergeführt werden." oder zumindest so ähnlich.

Es gibt also scheinbar dann mehrere Exceptions hintereinander, die nicht angezeigt werden(aus welchen Gründen auch immer) und darüber bekomme ich dann Nachricht. Das bringt mir aber herzlich wenig, da ich dann immer noch nicht weiß, wo die AV auftritt. Ich hab also kaum einen Ansatzpunkt.

Das einzige, was ich weiß ist:
- Wenn ich das Verzeichnis nicht lösche, gibts keine AV, ansonsten immer
- Das ShellListView ist daran beteiligt(sonst könnte ich mir den Zusammenhang mit dem DeleteDir nicht erklären)
- Manchmal(d.h. in Fällen, die ich momentan nicht reproduzieren kann) bekomme ich auch die Exception "Das Element '' hat kein übergeordnetes Fenster"

Der Fehler muss also irgendwas mit dem ShellListView und den deleteDir zu tun haben, nur was...

mfg

Christian

[marabu]

Hallo Christian,

deine Groups property hast du als read-only festgelegt, instanziierst immer fleißig neu und gibst nie frei. Ich fürchte da sind noch andere Schwachstellen.

Grüße vom marabu