[Liste] Suchen & Sortieren

[Mr_Anderson]

Hallo
Ich habe in der Schule die Aufgabe erhalten eine Bücher.txt mit 2000 Datensätzen in eine Liste zu schreiben und diese Liste nach Autoren bzw. Titel zu durchlaufen und zu sortieren. Ich habe es geschrieben, aber ich weiß nicht, ob es so wirklich "gute geschrieben" ist.

Könntet ihr euch das einmal anschauen? Ich hänge den Code an:

Delphi-Quellcode:

unit mSortListe;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, mDListe, XPMan, Buttons;
const max=2000;
type TBuch = class(TSortElement)
    Sachgebiet, Autor, Titel, Ort, Verlag : String;
    Jahr : integer;
    function gleich (zweites:TSortElement):boolean;override;
    function kleiner (zweites:TSortElement):boolean;override;
  end;
type TAutor = class(TSortElement)
    Sachgebiet, Autor, Titel, Ort, Verlag : String;
    Jahr : integer;
    function gleich (zweites:TSortElement):boolean;override;
    function kleiner (zweites:TSortElement):boolean;override;
  end;
type
  TfMain = class(TForm)
    Memo1: TMemo;
    lbAnzahl: TLabel;
    edTitel: TEdit;
    edAutor: TEdit;
    edSachgebiet: TEdit;
    btNext: TButton;
    btPrevious: TButton;
    edVerlag: TEdit;
    edJahr: TEdit;
    btlast: TButton;
    btfirst: TButton;
    edOrt: TEdit;
    rbautor: TRadioButton;
    rbtitel: TRadioButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    edSuche: TEdit;
    btSuche: TButton;
    XPManifest1: TXPManifest;
    BitBtn1: TBitBtn;
    procedure FormCreate(Sender: TObject);

    procedure Anzeigen;
    procedure btNextClick(Sender: TObject);
    procedure btPreviousClick(Sender: TObject);
    procedure btfirstClick(Sender: TObject);
    procedure btlastClick(Sender: TObject);
    procedure rbautorClick(Sender: TObject);
    procedure rbtitelClick(Sender: TObject);
    procedure btSucheClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
     Feld : array [0..max] of TBuch; Anzahl:Integer;
     TListe,AListe : TDListe;
  end;
var
  fMain: TfMain;


implementation {$R *.dfm}

function TBuch.gleich (zweites:TSortElement):boolean;
   begin gleich := Self.Titel = TBuch(zweites).Titel end;
function TBuch.kleiner (zweites:TSortElement):boolean;
   begin kleiner := Self.Titel < TBuch(zweites).Titel end;
function TAutor.gleich (zweites:TSortElement):boolean;
   begin gleich := Self.Autor = TAutor(zweites).Autor end;
function TAutor.kleiner (zweites:TSortElement):boolean;
   begin kleiner := Self.Autor < TAutor(zweites).Autor end;

procedure TfMain.FormCreate(Sender: TObject);
var i, Code:integer; Zeile : String; neu : TBuch; neu2 :TAutor;
begin
  memo1.Lines.LoadFromFile('Bücher.txt');
  Anzahl := memo1.Lines.Count;
  TListe := TDListe.Create;
  AListe := TDListe.Create;
  for i := 0 to Anzahl-1 do begin
    neu := TBuch.Create;
    with neu do begin
      Zeile := Memo1.Lines[i];
      delete (zeile, 1, pos(';', zeile));
      sachgebiet := copy(Zeile, 1, pos(';', zeile)-1);
      delete (zeile, 1, pos(';', zeile));
      Autor := copy(Zeile, 1, pos(';', zeile)-1);
      delete (zeile, 1, pos(';', zeile));
      Titel := copy(Zeile, 1, pos(';', zeile)-1);
      delete (zeile, 1, pos(';', zeile));
      Ort := copy(Zeile, 1, pos(';', zeile)-1);
      delete (zeile, 1, pos(';', zeile));
      if copy(Zeile, 1, pos(';', zeile)-1) = ''
      then Jahr :=0
      else val(copy(Zeile, 1, pos(';', zeile)-1),Jahr,Code );
      delete (zeile, 1, pos(';', zeile));
      Verlag := Zeile;
    end;
    TListe.Insert(neu);
  end;
  memo1.Lines.LoadFromFile('Bücher.txt');
  i:=0;
  TListe.First;
  for i := 0 to Anzahl-1 do begin
    neu2 := TAutor.Create;
    with neu2 do begin
      Zeile := Memo1.Lines[i];
      delete (zeile, 1, pos(';', zeile));
      sachgebiet := copy(Zeile, 1, pos(';', zeile)-1);
      delete (zeile, 1, pos(';', zeile));
      Autor := copy(Zeile, 1, pos(';', zeile)-1);
      delete (zeile, 1, pos(';', zeile));
      Titel := copy(Zeile, 1, pos(';', zeile)-1);
      delete (zeile, 1, pos(';', zeile));
      Ort := copy(Zeile, 1, pos(';', zeile)-1);
      delete (zeile, 1, pos(';', zeile));
      if copy(Zeile, 1, pos(';', zeile)-1) = ''
      then Jahr :=0
      else val(copy(Zeile, 1, pos(';', zeile)-1),Jahr,Code );
      delete (zeile, 1, pos(';', zeile));
      Verlag := Zeile;
    end;
    AListe.Insert(neu2);
  end;
  AListe.First;
  lbAnzahl.Caption := intToStr(Anzahl);
end;
procedure TfMain.Anzeigen;
var buch :TBuch; buch2:TAutor;
begin
buch := TBuch(TListe.GetElement);
buch2 := TAutor(AListe.GetElement);
  case fMain.rbtitel.Checked of
  true : begin
        with buch do begin
        edTitel.Text := Titel;
        edAutor.Text := Autor;
        edSachgebiet.Text := Sachgebiet;
        edVerlag.Text := Verlag;
        edJahr.Text:= inttostr(Jahr);
        edOrt.Text := Ort;
        end;
        end;
  false : begin
                with buch2 do begin
                edTitel.Text := Titel;
                edAutor.Text := Autor;
                edSachgebiet.Text := Sachgebiet;
                edVerlag.Text := Verlag;
                edJahr.Text:= inttostr(Jahr);
                edOrt.Text := Ort;
                end;
        end;
end;
end;



procedure TfMain.btNextClick(Sender: TObject);
var buch :TBuch;
begin
  case fMain.rbtitel.Checked of
  true : begin TListe.Next; Anzeigen;
        end;
  false: begin
         AListe.Next;Anzeigen;
         end;
end;
end;
procedure TfMain.btPreviousClick(Sender: TObject);
var buch :TBuch;
begin
  case fMain.rbtitel.Checked of
  true : begin TListe.Previous; Anzeigen;
        end;
  false: begin
        AListe.Previous; Anzeigen;
          end;
end;
end;

procedure TfMain.btfirstClick(Sender: TObject);
begin
  case fMain.rbtitel.Checked of
  true : begin TListe.First; Anzeigen;
        end;
  false: begin
        AListe.First; Anzeigen;
          end;
end;
end;

procedure TfMain.btlastClick(Sender: TObject);
begin
  case fMain.rbtitel.Checked of
  true : begin TListe.Last; Anzeigen;
        end;
  false: begin
        AListe.last; Anzeigen;
          end;
end;
end;

procedure TfMain.rbautorClick(Sender: TObject);
var buch :TBuch;
begin
  buch := TBuch(TListe.GetElement);
        AListe.First;
        while (not Aliste.isLast) and (buch.Autor <> TBuch(AListe.GetElement).Autor) do begin
              AListe.Next;
              end;
       // Anzeigen;
  end;

procedure TfMain.rbtitelClick(Sender: TObject);
var buch :TAutor;
begin
  buch := TAutor(AListe.GetElement);
        TListe.First;
        while not Tliste.isLast and (buch.Autor <> TBuch(TListe.GetElement).Autor) do begin
              tListe.Next;
              end;
        Anzeigen;
  end;
procedure TfMain.btSucheClick(Sender: TObject);
var gefunden:boolean; i,p,z:integer;
begin
gefunden := false;
z:= 1;
case fMain.rbtitel.Checked of
  true : begin
         TListe.First;
         while not Tliste.isLast do begin
                z:= z+1;
                i := Pos(LowerCase(fMain.edSuche.Text), LowerCase(TBuch(TListe.GetElement).titel));
                if i <> 0 then begin gefunden:=true;
                break;
                end else
                tliste.next;
         end;
                 if gefunden then Anzeigen
                else showmessage(inttostr(i) + 'Nicht gefunden');
         end;
  false: begin
         AListe.First;
         while not Aliste.isLast do begin
                z:= z+1;
                i := Pos(LowerCase(fMain.edSuche.Text), LowerCase(TAutor(AListe.GetElement).titel));
                if i <> 0 then begin gefunden:=true;
                break;
                end else
                tliste.next;
         end;
                 if gefunden then Anzeigen
                else showmessage(inttostr(i) + 'Nicht gefunden');
         end;
  end;
end;
procedure TfMain.BitBtn1Click(Sender: TObject);
begin
  Case MessageDlg ('Titelliste speichern?', mtConfirmation, [mbAbort, mbYes, mbNo], 0) of
    mrYes:
    TListe.ComponentSaveToFile(self,'Sortiert.txt');
       // Hier der Code bei Yes
    mrNo:
    AListe.ComponentSaveToFile(self,'Sortiert_autor.txt')
      ; // Hier der Code bei No
    mrCancel:
      ; // Hier der Code bei Cancel
  End;
 showmessage('toll');

end;

end.

Delphi-Quellcode:

unit mDListe;

interface
uses   classes,Sysutils;
type
 TSortElement = class (TObject)
    private
      FNext, FPrevious : TSortElement;
    public
      constructor Create;
      function gleich (zweites:TSortElement):boolean;virtual;abstract;
      function kleiner (zweites:TSortElement):boolean;virtual;abstract;
  end;

  TDListe = class(TObject)
  private
    FRoot, FBottom,
    FPosition : TSortElement;
  public
    constructor Create;
    function GetElement: TSortElement;
    function isElement(Elem:TSortElement):boolean;
    procedure Insert (Elem:TSortElement);
    procedure ComponentSaveToFile(Component: TComponent; const FileName: String);
    procedure Delete;
    Procedure Next;
    procedure First;
    Procedure Previous;
    procedure Last;
    function isEmpty : Boolean;
    function isLast : Boolean;
    function isFirst : Boolean;
    
  End;
implementation

    constructor TSortElement.Create;
      begin inherited create; FNext := nil; FPrevious :=nil;
    end;

    constructor TDListe.Create;
    begin inherited create; FRoot:=nil; FPosition:=FRoot; FBottom:=nil;
    end;

    function TDListe.GetElement: TSortElement;
    begin GetElement:=FPosition;
    end;

    function TDListe.isElement(Elem:TSortElement):boolean;
    var gefunden : boolean; hilf : TSortElement;
    begin
      gefunden := false; hilf := FRoot;
      if not isEmpty then begin
        while (hilf <> FBottom) and hilf.kleiner(Elem) do
          hilf := hilf.FNext;
          gefunden := FPosition.gleich(Elem);
      end;
      if gefunden then FPosition := hilf;
      isElement := gefunden;
    end;

    procedure TDListe.Insert (Elem:TSortElement);
    var hilf : TSortElement;
    begin
      if isEmpty then begin
        FRoot := Elem; FPosition := Elem; FBottom := Elem; end
      else begin
         hilf := FRoot;
         while (hilf.FNext <> nil) and (hilf.kleiner(Elem))
         do hilf := hilf.FNext;
         if hilf = FRoot then
           begin
             FRoot := Elem;
             FRoot.Fnext := hilf;
             hilf.FPrevious := FRoot
           end
         else
           if (hilf.FNext = nil) and hilf.kleiner(Elem) then
             begin
               hilf.FNext:=Elem; Elem.FPrevious:=hilf; FBottom:=Elem;
             end
           else begin
             hilf.FPrevious.FNext:=Elem; Elem.FNext:= hilf;
            Elem.FPrevious:=hilf.FPrevious;hilf.FPrevious:=Elem;
          end;
      end;
    end;

    procedure TDListe.Delete;
    begin
      if FRoot = FBottom then begin
         FRoot := nil; FBottom := nil;
      end
      else
        if FPosition = FRoot then begin
          FRoot := FPosition.FNext; FRoot.FPrevious := nil;
        end
        else
          if FPosition = FBottom then begin
             FBottom := FBottom.FPrevious; FBottom.FNext := nil;
          end
          else begin
             FPosition.FNext.FPrevious := FPosition.FPrevious;
             FPosition.FPrevious.FNext := FPosition.FNext;
          end;

    end;
    Procedure TDListe.Next;
    begin
      if FPosition <> nil then
        if FPosition.FNext <> nil
        then FPosition:=FPosition.FNext;
    end;
    procedure TDListe.First;
    begin FPosition := FRoot;
    end;
    Procedure TDListe.Previous;
    begin
      if FPosition <> nil then
        if FPosition.FPrevious <> nil
        then FPosition:=FPosition.FPrevious;
    end;
    procedure TDListe.Last;
    begin FPosition := FBottom;
    end;
    function TDListe.isEmpty : Boolean;
    begin isEmpty := FRoot=nil

    end;
    function TDListe.isLast : Boolean;
    begin isLast := FPosition=FBottom
    end;
    function TDListe.isFirst : Boolean;
    begin isFirst := FPosition=FRoot
    end;

procedure TDliste.ComponentSaveToFile(Component: TComponent; const FileName: String);
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(FileName, fmCreate);
  try
    fs.WriteComponentRes(Component.Name, Component);
  finally
    fs.Free;
  end;
end;

end.

Vielen Dank im voraus!

MfG