finnk
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору unit AbstractUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, XPMan, ComCtrls, ExtCtrls, Grids; type list = ^cell; elementtype = record author, name, subject: shortstring; year: integer; end; cell = record element: elementtype; next: list; end; //------------------------------------------------------------------------------ procedure InsertValue(x: elementtype; var head, pos: list); procedure PrintList(head: list); procedure MakeNull(var head: list); procedure SaveListToFile(head: list; fName: string); procedure LoadListFromFile(var head: list; fName: string); function Locate(x: elementtype; head: list): list; procedure DeleteValue(var pos, head: list); //------------------------------------------------------------------------------ var head, pos: list; x: elementtype; implementation uses MainUnit; {вставляет элемент х в список} procedure InsertValue(x: elementtype; var head, pos: list); var p: list; begin New(p); if head = nil then head:= p else pos.next:= p; p.element:= x; p.next:= nil; pos:= p; end; {выводит элементы списка} procedure PrintList(head: list); var p: list; index: integer; begin if head = nil then begin Application.MessageBox('Список пуст','Внимание',MB_ICONWARNING+MB_OK); MainForm.StringGrid1.RowCount:= 2; MainForm.StringGrid1.Rows[1].Clear; Exit; end else begin index:= 1; p:= head; while(p <> nil) do begin MainForm.StringGrid1.Cells[0,index]:= IntToStr(index); MainForm.StringGrid1.Cells[1,index]:= p.element.author; MainForm.StringGrid1.Cells[2,index]:= p.element.name; MainForm.StringGrid1.Cells[3,index]:= IntToStr(p.element.year); MainForm.StringGrid1.Cells[4,index]:= p.element.subject; p:= p.next; inc(index); MainForm.StringGrid1.RowCount:= index; end; end; end; {очистка списка} procedure MakeNull(var head: list); begin head:= nil; end; {сохранение списка в файл} procedure SaveListToFile(head: list; fName: string); var p: list; f: file of elementtype; begin if head = nil then begin Application.MessageBox('Список пуст','Ошибка',MB_ICONERROR+MB_OK); Exit; end; AssignFile(f, fName); Rewrite(f); p:= head; while( p <> nil) do begin write(f, p.element); p:= p.next; end; CloseFile(f); end; {загрузка списка из файла} procedure LoadListFromFile(var head: list; fName: string); var f: file of elementtype; begin if head <> nil then case Application.MessageBox('Список не пуст. Очистить его?','Внимание',MB_ICONQUESTION+MB_YESNO) of mrYes: begin MakeNull(head); MainForm.StringGrid1.RowCount:= 2; MainForm.StringGrid1.Rows[1].Clear; end; mrNO: Exit; end; AssignFile(f, fName); Reset(f); while not eof(f) do begin read(f,x); InsertValue(x,head,pos); end; CloseFile(f); end; {возвращает позицию элемента х в списке} function Locate(x: elementtype; head: list): list; var p: list; begin p:= head; while(p <> nil) do begin if (p.element.author = x.author) and (p.element.name = x.name) and (p.element.year = x.year) and (p.element.subject = x.subject) then begin Result:= p; Exit; end; p:= p.next; end; Result:= nil; end; {удаление элемента из списка} procedure DeleteValue(var pos, head: list); var p: list; begin if head = nil then Exit; if head.next = nil then begin MakeNull(head); Exit; end; if pos = head then begin head:= head.next; Exit; end; p:= head; while(p.next <> pos) do begin p:= p.next; if p = nil then Exit; end; p.next:= p.next.next; end; end. | Всего записей: 6 | Зарегистр. 13-10-2010 | Отправлено: 16:05 14-10-2010 | Исправлено: finnk, 16:10 14-10-2010 |
|