Delphi lista jednokierunkowa


(Wojtek49s) #1

Witam,

mam problem z poprawnym zaimplementowaniem listy jednokierunkowej. Jak zrobić poprawne zapisywanie danych do pliku i ich poprawne wczytanie do listy ?

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  type
  CarRec = record
      marka : string[20];
      model : string[20];
      cena : integer;
  end;

  type
   plist=^DataHelp;
   DataHelp = record
      MakeCar : CarRec;
      next : plist;
   end;
var
  DTF : File of CarRec; {DTF - Data To File}
  Samochod : CarRec;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  temp : plist;
begin
  new(temp);
  temp^.MakeCar.marka:= Edit1.Text;
  temp^.MakeCar.model:= Edit2.Text;
  temp^.MakeCar.cena:= StrToInt (Edit3.Text);
  if(temp^.MakeCar.marka <> '') and (temp^.MakeCar.model <> '') then
    begin
      Seek(DTF,FileSize(DTF));
      Write(DTF,temp^.MakeCar);
    end;
  Edit1.Text:='';
  Edit2.Text:='';
  Edit3.Text:='';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Close();
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  Wiersz, Calosc : Integer;
  temp2,temp3 : plist;
  current : plist;
  first : plist;
  previous : plist;
begin
  ListBox1.Items.Clear;
  ReSet(DTF);

  first:=nil;

  Wiersz := 0;
  Calosc := FileSize(DTF);
  while Wiersz < Calosc do
  begin
    Seek(DTF, Wiersz);
    if first <> nil then
    begin
      new(first);
      Read(DTF,first^.MakeCar);
    end
    else
      begin
        new(temp2);
        Read(DTF,temp2^.MakeCar);
        if (temp2^.MakeCar.cena < first^.MakeCar.cena) then
        begin
          new(current);
          current^.MakeCar.marka:=temp2^.MakeCar.marka;
          current^.MakeCar.model:=temp2^.MakeCar.model;
          current^.MakeCar.cena:=temp2^.MakeCar.cena;
          current^.next:=first;
          first:=current;
        end
        else
        begin
          current:=first;
          while (current <> nil) and (current^.MakeCar.cena < temp2^.MakeCar.cena) do
          begin
            previous:=current;
            current:=current^.next;
          end;
          temp3:=current;
          new(current);
          current^.MakeCar.marka:=temp2^.MakeCar.marka;
          current^.MakeCar.model:=temp2^.MakeCar.model;
          current^.MakeCar.cena:=temp2^.MakeCar.cena;
          current^.next:=temp3;
          previous^.next:=current;
          end;
      end;
    Wiersz := Wiersz + 1;
  end;

  current:=first;
  ListBox1.Items.Add(current^.MakeCar.marka+' '+current^.MakeCar.model+' '+IntToStr(current^.MakeCar.cena));
  while current^.next <> nil do
  begin
    previous:=current;
    current:=current^.next;
    ListBox1.Items.Add(current^.MakeCar.marka+' '+current^.MakeCar.model+' '+IntToStr(current^.MakeCar.cena));
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CloseFile(DTF);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  AssignFile(DTF,'cars.dat');
  if FileExists('cars.dat') then
    begin
      ReSet(DTF);
    end
    else
      ReWrite(DTF);
end;

end.

 


(nintyfan) #2

Odczytywanie:

Masz jakąś procedurę wywołującą poniższą i przekazującą wartość typu Variant.

procedure dodaj(Lista ^ostatni, Variant wartość)

var

Nowy: ^Lista;

begin

new(Nowy);

Nowy->nastepny = NULL;

Nowy->element = wartość;

ostatni->nastepny = Nowy;

end;


(Wojtek49s) #3

Dzięki @nintyfan.