Record и Class

Тема в разделе "Delphi - FAQ", создана пользователем Triangel.BY, 17 фев 2007.

Статус темы:
Закрыта.
  1. Triangel.BY

    Triangel.BY Гость

    при решении задачи нужно было использовать двусвязный список, оформленный ввиде класса. Сделал, элементы этого списка были record'ами. Преподователь сказал, что record - старье и надо от него избавляться и переделать чтобы элемент списка был class. Я тупо заменил "record" на "class" и добавил конструктор и деструктор. Ну вроде всё логически правильно, но...
    Программа выкидывает неизмеримое кол-во EAccesViolation. Причём пошагово я проверял, ошибки появляются при выходе из процедур, которые использовали этот список.
    И еще. Процедуры New(P), где P это ^элемент списка хватит для создания объекта или нужно еще пройтись по конструктору этого класса? Не работает никак.
     
  2. DIR3ct0r

    DIR3ct0r Гость

    Классы создаются с помощью метода Create:
    Код (Text):
    type
    TMyClass = class
    a,
    b: integer;
    public
    constructor Create;
    destructor Destroy; override;
    end;

    var
    MyClass: TMyClass;
    begin
    MyClass:= TMyClass.Create;
    MyClass.Free;
    end.
     
  3. Triangel.BY

    Triangel.BY Гость

    Это я понимаю.... Тут такое дело.
    Код (Text):
    unit ListClass;

    interface
    type
    StrArray=array[0..9] of string[20];

    TData = record
    Number:integer;
    Author: string[20];
    Name:string[50];
    Amount:integer;
    Theme:StrArray;
    end;

    TP=^TBook;
    TBook=record
    Info:TData;
    Next:TP;
    Prev:TP;
    end;

    TBookList=class(TObject)
    Head,Tail:TP;
    Count:integer;
    constructor Create;
    destructor Destroy;
    procedure AddToTail(Book:TData);
    function SearchTheme(STheme:StrArray):TBookList;
    end;


    implementation

    procedure NewItem(var p: TP);
    begin
    New(P);
    P^.Next:=nil;
    P^.Prev:=nil;
    end;



    constructor TBookList.Create;
    begin
    inherited;
    Count:=0;
    Head:=nil;
    Tail:=nil;
    end;

    destructor TBookList.Destroy;
    begin
    inherited Destroy;
    end;

    procedure TBookList.AddToTail(Book:TData);
    var Item:TP;
    begin
    NewItem(Item);
    Item^.Info:=Book;
    if Head=nil then Head:=Item;
    if Tail<>nil then
    begin
    Tail^.Next:=Item;
    Item^.Prev:=Tail;
    end;
    Tail:=Item;
    Inc(Count);
    end;
    И вот как-то в процедурке NewItem строка New(P) и вызывает ошибки...
     
  4. DIR3ct0r

    DIR3ct0r Гость

    Может стоит сделать таким образом
    Код (Text):
    function NewItem: TP;
    begin
    New(Result);
    Result^.Next:=nil;
    Result^.Prev:=nil;
    end;
     
  5. Triangel.BY

    Triangel.BY Гость

    Извини, но я не понимаю, в чём сильная разница. Т.к. в твоём случае это тоже самое моё, только переписаное через функцию....
    Прога начала запускаться...
    Код (Text):
    procedure TBookList.AddToTail(Book:TData);
    var Item:TP;
    K:Tbook;
    begin
    K:=TBook.New;
    K.Info:=Book;
    Item:=@K;
    if Head=nil then Head:=Item;.....
    Заменив шапку функции на это... Но до конца не фурычит, т.к. в списке постоянно находиться лишь один элемент. Мне сказали что это проблема в Item:=@K;
     
  6. zubr

    zubr Гость

    Вот посмотри реализацию списка, может поможет:
    Код (Text):
    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    StdCtrls;

    type
    TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    TMList=^mlist;
    mlist=record
    pole:string[20];
    prev,next:TMList;
    end;

    MyList=class
    Private
    FList:TMList;
    FFirst:TMList;
    FLast:TMList;
    FCount:Integer;
    function GetString(Index:Integer):string;
    procedure SetString(Index:Integer; const s:string);
    Public
    Constructor Create;
    property Count:Integer read FCount;
    property First:TMList read FFirst;
    property Last:TMList read FLast;
    property Strings[Index: Integer]: string read GetString write SetString;
    Destructor Destroy; Override;
    function Add(const s:string):Integer;
    end;


    var
    Form1: TForm1;

    implementation

    {$R *.DFM}

    Constructor MyList.Create;
    Begin
    inherited;
    FCount:=0;
    FFirst:=nil;
    FLast:=nil;
    End;

    Destructor MyList.Destroy;
    var
    temp:TMList;
    Begin
    inherited;
    If FLast<>nil then
    begin
    While FLast^.prev<>nil do
    begin
    temp:=FLast;
    FLast:=FLast^.prev;
    Dispose(temp);
    end;
    Dispose(FLast);
    end;
    End;

    function MyList.Add(const s:string):Integer;
    var
    temp:TMList;
    begin
    inc(FCount);
    If FCount=1 then
    begin
    New(FFirst);
    First^.pole:=s;
    First^.prev:=nil;
    First^.next:=nil;
    FList:=FFirst;
    FLast:=First;
    end
    else
    begin
    New(temp);
    FLast^.next:=temp;
    temp^.pole:=s;
    temp^.prev:=FLast;
    temp^.next:=nil;
    FList:=temp;
    FLast:=FList;
    end;
    Result:=FCount-1;
    end;

    function MyList.GetString(Index:Integer):string;
    var
    i:Integer;
    temp:TMList;
    begin
    If (Index<0) or (Index>FCount-1) then
    ;//exception
    temp:=FFirst;
    For i:=0 to index-1 do
    temp:=temp^.next;
    FList:=temp;
    Result:=temp^.pole;
    end;

    procedure MyList.SetString(Index:Integer; const s:string);
    var
    i:Integer;
    temp:TMList;
    begin
    If (Index<0) or (Index>FCount-1) then
    ;//exception
    temp:=FFirst;
    For i:=0 to index-1 do
    temp:=temp^.next;
    FList:=temp;
    temp^.pole:=s;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    var
    d:MyList;
    begin
    d:=MyList.Create;
    d.Add('www');
    d.Add('bbb');
    d.Add('ccc');
    Edit1.Text:=d.Strings[1];
    end;

    end.
     
  7. Triangel.BY

    Triangel.BY Гость

    Народ, я понял!!!! В описании списка нужно заменить указатель на сам TBook, и всё нормально работает, т.к. Тотже самый К а моём листинге представляет собой ссылку. Так что дерзайте, извините меня за расплывчатое указание, т.к. я немного пьян, но сегодня же суббота! Рядом со мной классная девчёнка и всё супер. :)


    P.S. Модераторы, я завтра исправлю.....
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей