Fehler beim Programm beenden

[Perlsau]

Hab mir dein Test-Projekt heruntergeladen, ausprobiert und untersucht. Dabei ist mir aufgefallen, daß ich den VirtualStringTree (VST) ganz anders verwende als du:

Als erstes lege ich einen Record für NodeData fest, damit ich dort die Daten des Nodes eintragen kann, die am Ende in den diversen Spalten des VST angezeigt werden sollen. Das fehlt bei dir. Wenn ich Objekte erzeuge, die angezeigt werden sollen, ob nun mit oder ohne VST, verwende ich die TObjectList, und zwar nicht die aus der Unit Contnrs, sondern die aus den Generics, die es, soweit ich weiß, erst seit Delphi 2009 gibt:

BList : Generics.Collections.TObjectList<TStartBild>; Ich versuch dir das mal an einem meiner etwas älteren Projekte zu erklären:

In einer Unit habe ich eine Klasse für die Bilder, die angezeigt werden sollen. Eine Klasse deshalb, weil zum Bild auch ein TLabel gehört:

Delphi-Quellcode:

UNIT Startbilder;

INTERFACE

USES
  ExtCtrls, StdCtrls, Classes, Graphics;

TYPE
  TStartBild = Class

    PRIVATE { Private-Deklarationen }
      Var
        fModulId : Integer;
        fBild    : TImage;
        fTitel   : TLabel;

      Function  GetfModulId             : Integer;
      Procedure SetfModulId(Const Value : Integer);
      Function  GetfBild                : TImage;
      Procedure SetfBild(Const Value    : TImage);
      Function  GetfTitel               : TLabel;
      Procedure SetfTitel(Const Value   : TLabel);

    PUBLIC  { Public-Deklarationen  }

      Constructor Create();
      Destructor  Destroy; override;

      Property ModulId : Integer read GetfModulId write SetfModulId;
      Property Bild    : TImage  read GetfBild    write SetfBild;
      Property Titel   : TLabel  read GetfTitel   write SetfTitel;

  END;

IMPLEMENTATION
{ TStartBild }

// ----- Modul-Id zurückliefern -------------------------------------------------------------------------------------------------- Privat
Function TStartBild.GetfModulId: Integer;
begin
  Result := fModulId;
end;

// ----- Modul-Id setzen --------------------------------------------------------------------------------------------------------- Privat
Procedure TStartBild.SetfModulId(Const Value: Integer);
begin
  fModulId := Value;
end;

// ----- Bild zurückliefern ------------------------------------------------------------------------------------------------------ Privat
Function TStartBild.GetfBild: TImage;
begin
  Result := fBild;
end;

// ----- Bild setzen ------------------------------------------------------------------------------------------------------------- Privat
Procedure TStartBild.SetfBild(Const Value: TImage);
begin
  fBild.Assign(Value);
end;

// ----- Label zurückliefern ----------------------------------------------------------------------------------------------------- Privat
Function TStartBild.GetfTitel: TLabel;
begin
  Result := fTitel;
end;

// ----- Label setzen ------------------------------------------------------------------------------------------------------------ Privat
Procedure TStartBild.SetfTitel(Const Value: TLabel);
begin
  fTitel.Assign(Value);
end;

// ########## PUBLIC METHODEN ########################################################################################################

// ----- Constructor Create ------------------------------------------------------------------------------------------------------ Privat
Constructor TStartBild.Create;
begin
  inherited;

  fBild                       := TImage.Create(nil);
  fBild.Visible               := False;
  fBild.Constraints.MaxWidth  := 500;
  fBild.Constraints.MaxHeight := 500;
  fBild.Constraints.MinWidth  := 100;
  fBild.Constraints.MinHeight := 100;
  fBild.AutoSize              := False;
  fBild.Stretch               := True;
  fBild.Proportional          := True;
  fBild.Center                := True;

  fBild.Picture.Bitmap.Canvas.Brush.Style := bsClear;
  fBild.Picture.Bitmap.Canvas.Pen.Color := clRed;
  fBild.Picture.Bitmap.Canvas.Pen.Style := psSolid;
  fBild.Picture.Bitmap.Canvas.Pen.Width := 5;

  fTitel                      := TLabel.Create(nil);
  fTitel.Visible              := False;
  fTitel.AutoSize             := False;
  fTitel.Layout               := tlCenter;
  fTitel.Alignment            := taCenter;
  fTitel.WordWrap             := True;
  fTitel.ParentFont           := True;
end;

// ----- Destructor Destroy ------------------------------------------------------------------------------------------------------ Privat
Destructor TStartBild.Destroy;
begin
  If Assigned(fBild) Then
     fBild.Free;
  If Assigned(fTitel) Then
     fTitel.Free;

  inherited;
end;

end.

Die einzelnen Module dieser Anwendung befinden sich in Frames. Beim Programmstart wird der Startframe geladen und bereitgestellt. Das ist der Frame, der in den beiden Beispiel-Grafiken unten angezeigt wird. In diesem Frame kann ich nun zwischen Icon- und Baumdarstellung wählen; Grundlage für beide Darstellungsformen ist die Objektliste. In der Function ObjektNeu erzeuge ich die Objektliste und weise ihr die in der Datenbank gespeicherten Icons, Texte und Beschreibungen zu. Die Variable Objekt vom Typ TStartBild darf nicht freigegeben werden, da der darin enthaltene Pointer direkt dem jeweiligen Item der Objektliste übergeben wird:

Delphi-Quellcode:

Function TFrame_Main.ObjektNeu(Const PId : Integer) : Integer;
Const
  BildPreString = 'Img_';
  LabelPreString = 'Lbl_';
Var
  Objekt  : TStartBild;
  LblName : String;
  Bild    : TBitMap;
  R       : TRect;

begin
  Result := -1;
  Objekt := TStartBild.Create;
  Bild   := TBitMap.Create;

  Try
    Bild.PixelFormat := pf24bit;
    Bild.Width       := ImgList.Width;
    Bild.Height      := ImgList.Height;
    R.Left           := 0;
    R.Top            := 0;
    R.Right          := Bild.Width  -1;
    R.Bottom         := Bild.Height -1;

      Try
        LblName                  := RemoveUnwantetChars(Titel);
        Objekt.ModulId           := fProgModus;
        Objekt.Bild.Parent       := Panel_Start;
        Objekt.Bild.Name         := BildPreString + LblName;
        Objekt.Bild.Width        := Laenge;
        Objekt.Bild.Height       := Laenge;
        Objekt.Bild.Canvas.Font  := Panel_Start.Font;
        Objekt.Bild.OnClick      := BildGeklickt;

        Objekt.Titel.Parent      := Panel_Start;
        Objekt.Titel.Name        := LabelPreString + LblName;
        Objekt.Titel.Caption     := Titel;
        Objekt.Titel.OnClick     := TitelGeklickt;
        Objekt.Titel.OnMouseMove := TitelMausBewegt;
        Objekt.Titel.Hint        := HintText;
        Objekt.Titel.ShowHint    := HintsZeigen;

        If Not DatMod.BlobToImage(Feld,Objekt.Bild.Picture.Bitmap) Then
               Raise Exception.Create('Fehler beim Einlesen eines Blobfelds in ein Bitmap ')
                     at @TFrame_Main.ObjektNeu;

        If PId = 0 Then RahmenZeichnen(Objekt.Bild.Picture.Bitmap.Canvas);

        Result           := BList.Add(Objekt);
        Objekt.Bild.Tag  := fProgModus;
        Objekt.Titel.Tag := Result;

        Bild.Canvas.StretchDraw(R,Objekt.Bild.Picture.Graphic);
        ImgList.Add(Bild,Nil);

      Except
        On e:Exception Do
        Begin
          If Assigned(Objekt)
             Then Objekt.Free;
          fInitOkay := e.Message;
        End;
      End;
  Finally
    Bild.Free;
  End;
end;

Je nachdem, welche Darstellungsform der Anwender nun wählt (Baum oder Icons), wird der Baum gezeichnet oder die Icons:

Delphi-Quellcode:

// ----- Zeichnet die Bilder auf das Panel in der Scrollbox --------------------------------------------------------------------- Privat
Procedure TFrame_Main.Zeichnen;
Var
  i,z,
  Titel_Breite,
  Titel_Hoehe,
  GesamtHoehe,
  GesamtBreite,
  HoehenMulti,
  AnzahlX,
  AnzahlY,
  X,Y          : Integer;
  Obj          : TStartBild;

// Panel an Scrollbox-Breite anpassen
Procedure PanelBreiteAnScrollBox;
Begin
  If ScrollBox_Start.VertScrollBar.Visible                  Then
     Panel_Start.Width  := ScrollBox_Start.ClientWidth  - 4 Else
     Panel_Start.Width  := ScrollBox_Start.ClientWidth + 15;
End;

// Code innerhalb der For-Schleife
Procedure ObjekteZeigen;
Begin
  Obj               := BList[i];
  Obj.Bild.Width    := Laenge;
  Obj.Bild.Height   := Laenge;
  Obj.Titel.Width   := Laenge;
  Obj.Titel.Height  := TitelHoehe;
  Obj.Bild.Left     := X;
  Obj.Bild.Top      := Y;
  Obj.Titel.Left    := X;
  Obj.Titel.Top     := Obj.Bild.Top + Laenge;
  Obj.Titel.Color   := TitelFarbe;
  Obj.Titel.Font    := Panel_Start.Font;
  Obj.Bild.Visible  := True;
  Obj.Titel.Visible := True;

//  Application.ProcessMessages;

  X := X + GesamtBreite;
  If X + GesamtBreite > Panel_Start.ClientWidth Then
  Begin
    X := Abstand;
    Y := Y + GesamtHoehe;
  End;
End;

// ********** HAUPTPROCEDURE **********
begin
  If Not Self.Visible Then Exit;

  z := BList.Count;

  If z > 0 Then
  Begin
    Label_Schriftart.Color := TitelFarbe;
    PanelBreiteAnScrollBox;

    TitelHoehe := 0;
    For i := 0 To z-1 Do
    Begin
      Obj                  := BList[i];
      Obj.Bild.Visible     := False;
      Obj.Titel.Visible    := False;
      Obj.Bild.Canvas.Font := Panel_Start.Font;
      Titel_Breite         := Obj.Bild.Canvas.TextWidth(Obj.Titel.Caption) + 10;
      If Titel_Breite > Laenge Then
         HoehenMulti := 2      Else
         HoehenMulti := 1;
      Titel_Hoehe          := (Obj.Bild.Canvas.TextHeight(Obj.Titel.Caption) + (HoehenMulti * 6)) * HoehenMulti;
      If Titel_Hoehe > TitelHoehe Then
         TitelHoehe        := Titel_Hoehe;
    End;

    GesamtBreite := Laenge + Abstand;
    GesamtHoehe  := Laenge + Abstand + TitelHoehe;
    X            := Abstand;
    Y            := Abstand;

    AnzahlX := (Panel_Start.Width - Abstand) Div GesamtBreite;
    If AnzahlX >= z Then
    Begin
      Panel_Start.Height := GesamtHoehe + Abstand;
      PanelBreiteAnScrollBox;
    End Else
    Begin
      AnzahlY := z Div AnzahlX;
      If z Mod AnzahlX > 0 Then Inc(AnzahlY);
      Panel_Start.Height := (AnzahlY * GesamtHoehe) + Abstand;
      PanelBreiteAnScrollBox;
    End;

    AnzahlX := (Panel_Start.Width - Abstand) Div GesamtBreite;
    If AnzahlX >= z Then
    Begin
      Panel_Start.Height := GesamtHoehe + Abstand;
      PanelBreiteAnScrollBox;
    End Else
    Begin
      AnzahlY := z Div AnzahlX;
      If z Mod AnzahlX > 0 Then Inc(AnzahlY);
      Panel_Start.Height := (AnzahlY * GesamtHoehe) + Abstand;
      PanelBreiteAnScrollBox;
    End;

    For i := 0 To z-1 Do ObjekteZeigen;
  End;
end;

// ----- Baumdarstelung initialisieren ------------------------------------------------------------------------------------------ Privat
Function TFrame_Main.BaumInit(Sender: TBaseVirtualTree) : Boolean;
Var
  Data   : PNodeData;
  Node   : PVirtualNode;
  PId    : Integer;

begin
  Try
    If Not DatMod.Qset_Modulix.Active Then
           DatMod.Qset_Modulix.Open;

    DatMod.Qset_Modulix.Filter   := 'ID_PARENT=0 and BILD<>null';
    DatMod.Qset_Modulix.Filtered := True;

    If DatMod.Qset_Modulix.RecordCount > 0 Then
    Begin
      DatMod.Qset_Modulix.First;

      VST.Clear;
      VST.BeginUpdate;

// Haupteinträge (Parent = 0)
      While Not DatMod.Qset_Modulix.Eof Do
      Begin
        Node         := Sender.AddChild(Sender.RootNode);
        Data         := Sender.GetNodeData(Node);
        Data.ImgId   := DatMod.Qset_Modulix.FieldByName('REIHENFOLGE').AsInteger;
        Data.Id      := DatMod.Qset_Modulix.FieldByName('ID_MODULIX').AsInteger;
        Data.PId     := DatMod.Qset_Modulix.FieldByName('ID_PARENT').AsInteger;
        Data.Titel   := DatMod.Qset_Modulix.FieldByName('TITEL').AsString;
        Data.Caption := DatMod.Qset_Modulix.FieldByName('CAPTION').AsString;

        DatMod.Qset_Modulix.Next;
      End;

// Untereinträge (Parent > 0)
      DatMod.Qset_Modulix.Filter   := 'ID_PARENT>0 and BILD<>null';
      If DatMod.Qset_Modulix.RecordCount > 0 Then
      Begin
        DatMod.Qset_Modulix.First;
        While Not DatMod.Qset_Modulix.Eof Do
        Begin
          PId  := DatMod.Qset_Modulix.FieldByName('ID_PARENT').AsInteger;
          Node := GetNodeBy_Id(PId);

          If Node <> Nil Then
          Begin
            Node := VST.AddChild(Node);
            Data         := Sender.GetNodeData(Node);
            Data.ImgId   := DatMod.Qset_Modulix.FieldByName('REIHENFOLGE').AsInteger;
            Data.Id      := DatMod.Qset_Modulix.FieldByName('ID_MODULIX').AsInteger;
            Data.PId     := PId;
            Data.Titel   := DatMod.Qset_Modulix.FieldByName('TITEL').AsString;
            Data.Caption := DatMod.Qset_Modulix.FieldByName('CAPTION').AsString;
          End;

          DatMod.Qset_Modulix.Next;
        End;

      End;

      VST.EndUpdate;

      DatMod.Qset_Modulix.Filtered := False;
      Result := True;

    End Else Raise Exception.Create('keine Parent=0 Einträge in der Datenbank') at @TFrame_Main.BaumInit;
  Except
    on e:exception Do
    Begin
      Result    := False;
      fInitOkay := e.Message;
    End;
  End;
end;

Die komplette UnitFrameMain incl. DFM-Datei hab ich angehängt.