Две последние лабы(условия) (СписокЗаписей+ListBox ЛР11 2006)

Посмотреть архив целиком

3


С

/3

писок записей – односвязная очередь +ListBox Упр 2 по связным спискам ЛР 10 2008

unit Unit1;

interface

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

type

TForm1 = class(TForm)

ListBox1: TListBox; BitBtn1: TBitBtn;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog; BitBtn2: TBitBtn;

BitBtn3: TBitBtn; BitBtn4: TBitBtn;

BitBtn5: TBitBtn; BitBtn6: TBitBtn;

BitBtn7: TBitBtn; BitBtn8: TBitBtn;

Label1: TLabel; Edit1: TEdit;

Label2: TLabel; Edit2: TEdit;

Label3: TLabel; Edit3: TEdit;

Button1: TButton;

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn3Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure BitBtn8Click(Sender: TObject);

procedure BitBtn4Click(Sender: TObject);

procedure BitBtn5Click(Sender: TObject);

procedure BitBtn6Click(Sender: TObject);

procedure BitBtn7Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

end;

var Form1: TForm1;

implementation

{$R *.dfm}

type

TPBook = ^TBook;

TBook = record //тип элементов списка записей

avtor :string[15];

nazvanie:string[30];

god :integer;

next :TPBook;

end;

tf=file of TBook;//для хранения данных списка записей

tfunc=function(p1,p2:TPBook):integer;

//Эта функция сравнивает две записи типа TBook

//по полю god и используется для упорядочения

//элементов списка в обработчике TForm1.BitBtn6Click(Sender: TObject)

function func(p1,p2:TPBook):integer;

begin result:=p1^.god-p2^.god; end;

var

head:TPBook; //начало (голова) списка

tail:TPBook; //хвост (конец) списка

S:string;//специф-я файла для сохранения данных из списка

f:tf; //файловая перем-ая для сохранения данных из списка

p:TPBook; z:TBook;

procedure TForm1.BitBtn1Click(Sender: TObject);

begin //Создание пустого списка и сохранение в файле

if S<>'' then BitBtn3Click(Self);

//Очистить список записей

while head<>nil do begin

p:=head; head:=p^.next; dispose(p); end;

tail:=nil;

//Очистить список ListBox1

Form1.ListBox1.Clear;

//Работа с файлом

if not Form1.SaveDialog1.Execute then begin

MessageDlg('Вы не задали имя файла.'+#13+

'Файл не создан!',mtError,[mbOk],0);

exit end;

S:=Form1.SaveDialog1.FileName;

AssignFile(f,S); rewrite(f); closeFile(f);

Edit1.Clear; Edit2.Clear; Edit3.Clear;

end;// procedure TForm1.BitBtn1Click

procedure TForm1.BitBtn2Click(Sender: TObject);

var PBook:TPBook;

begin //Добавить в хвост списка

if Edit1.Text='' then begin

MessageDlg('Вы не задали данные по книге.'+#13+

'Введите их в поля Автор, Название,Год!',mtError,[mbOk],0);

exit end;

new(PBook);

PBook^.avtor:=Edit1.Text; PBook^.nazvanie:=Edit2.Text;

PBook^.god:=StrToInt(Edit3.Text); PBook^.next:=nil;

if head=nil then begin

head:=PBook; tail:=PBook; end;

tail^.next:=PBook;

tail:=PBook;

//Добавить строку в конец списка ListBox1

Form1.ListBox1.Items.Add(Edit3.Text+' '

+Edit2.Text+' '+Edit1.Text);

//== Form1.ListBox1.Items[ListBox1.Items.Count]

// :=Edit3.Text+' '+Edit2.Text+' '+Edit1.Text;

Edit1.Clear; Edit2.Clear; Edit3.Clear;

end;// procedure TForm1.BitBtn2Click

procedure TForm1.BitBtn3Click(Sender: TObject);

begin //Сохранить записи списка в файле

//if S='' then !!!всегда Сохранить как...

if not Form1.SaveDialog1.Execute then begin

MessageDlg('Вы не задали имя файла.'+#13+

'Список не сохранён!',mtError,[mbOk],0);

exit end

else

S:=Form1.SaveDialog1.FileName;

AssignFile(f,S); rewrite(f); p:=head;

while p<>nil do begin

write(f,p^); p:=p^.next; end;

closeFile(f); Edit1.Clear; Edit2.Clear; Edit3.Clear;

end;// procedure TForm1.BitBtn3Click

procedure TForm1.FormCreate(Sender: TObject);

begin //Создание формы

Edit1.Clear; Edit2.Clear; Edit3.Clear;

end;// procedure TForm1.FormCreate

procedure TForm1.BitBtn8Click(Sender: TObject);

begin //Выход из программы

close end;

procedure TForm1.BitBtn4Click(Sender: TObject);

var p1:TPBook;

begin //Загрузка списков из файла

if not Form1.OpenDialog1.Execute then begin

MessageDlg('Вы не задали имя файла.'+#13+

'Список не сохранён!',mtError,[mbOk],0);

exit end

else

S:=Form1.OpenDialog1.FileName;

AssignFile(f,S); reset(f); head:=nil; tail:=nil;

Form1.ListBox1.Clear;

if FileSize(f)>0 then begin

read(f,z);

new(p); p^:=z; p^.next:=nil;

head:=p; tail:=p;

Form1.ListBox1.Items.Add(p^.avtor

+' '+p^.nazvanie+' '+IntToStr(p^.god));

while not eof(f) do begin

read(f,z);

new(p1); p1^:=z; tail:=p1;

p^.next:=p1; p:=p1;

Form1.ListBox1.Items.Add(p^.avtor

+' '+p^.nazvanie+' '+IntToStr(p^.god));

end;// while not eof(f)

end;// while not eof(f)

closeFile(f); Edit1.Clear; Edit2.Clear; Edit3.Clear;

end;// procedure TForm1.BitBtn4Click

procedure TForm1.BitBtn5Click(Sender: TObject);

var pp, pDelItem:TPBook; i,iDelItem:integer; s1:string;

begin //Удаление элемента списка с заданным номером

s1:=InputBox('Удаление элемента 0..'

+IntToStr(Form1.ListBox1.Items.Count-1)

,'Введите номер удаляемого элемента','');

try

iDelItem:=StrToInt(s1);

except

MessageDlg('Вы неправильно задали номер элемента.'

+ #13+'Элемент не удалён!',mtError,[mbOk],0);

exit;

end;

if (iDelItem<0)

or (iDelItem>Form1.ListBox1.Items.Count-1) then begin

MessageDlg('Вы неправильно задали номер элемента.'

+#13+ 'Элемент не удалён!',mtError,[mbOk],0);

exit;

end;

pDelItem:=head;//будет указатель на удаляемый

pp:=nil; //указатель на предыдущий удаляемому

for i:=0 to iDelItem-1 do begin

pp:=pDelItem;

pDelItem:=pp^.next;

end;

if pDelItem=head then begin //удалить голову

pp:=head; head:=pp^.next;

if pp^.next=nil then

tail:=nil;

dispose(pp);

end

else begin

if pDelItem^.next=nil then

tail:=pp;

pp^.next:=pDelItem^.next;

dispose(pDelItem^.next);

end;

Form1.ListBox1.Items.Delete(iDelItem);

end;// procedure TForm1.BitBtn5Click

procedure TForm1.BitBtn6Click(Sender: TObject);

var i,j,imax:integer; p1, p2, pMax:TPBook; s1:string;

begin //Сортировка списков Методом поиска минимального

//элемента, вычисляемому по отношению следования, функ-ей //func(p1,p1:TPBook):int;>0,=0,<0. При Form1.ListBox1.Sorted //:=true; это свойство сортирует только ListBox1

p1:=head;

for i:=0 to Form1.ListBox1.Count-2 do begin

pMax:=p1; iMax:=i; p2:=p1^.next;

for j:=i+1 to Form1.ListBox1.Count-1 do begin

if func(pMax,p2)>0 then begin

pMax:=p2; imax:=j;

end;

p2:=p2^.next;

end;// for j:=i+1 to Form1.ListBox1.Count-1

if p1<>pMax then begin

s1:=p1^.avtor; p1^.avtor:=pMax^.avtor; pMax^.avtor:=s1;

s1:=p1^.nazvanie; p1^.nazvanie:=pMax^.nazvanie;

pMax^.nazvanie:=s1;

j:=p1^.god; p1^.god:=pMax^.god; pMax^.god:=j;

Form1.ListBox1.Items.Exchange(i,imax);

end;// if p1<>pMax then

p2:=p2^.next;

end;// for i:=0 to Form1.ListBox1.Count-2

end;// procedure TForm1.BitBtn6Click

procedure TForm1.BitBtn7Click(Sender: TObject);

var pp,PBook,pInsItem:TPBook; i,iInsItem:integer; s1:string;

begin //Вставить элемент в список

s1:=InputBox('Вставить элемента 0..'

+IntToStr(Form1.ListBox1.Items.Count)

,'Введите номер вставляемого элемента','');

if s1='' then begin

MessageDlg('Вы не задали номер элемента.'

+#13+'Элемент не вставлен!',mtError,[mbOk],0);

exit;

end;

try

iInsItem:=StrToInt(s1);

except

MessageDlg('Вы неправильно задали номер элемента.'

+#13+ 'Элемент не вставлен!',mtError,[mbOk],0);

exit;

end;

try

iInsItem:=StrToInt(Edit3.Text);

except

MessageDlg('Вы неправильно задали год издания.'

+#13+ 'Элемент не вставлен!',mtError,[mbOk],0);

exit;

end;

if (iInsItem<0) or (iInsItem>Form1.ListBox1.Items.Count) then begin

MessageDlg('Вы неправильно задали номер элемента.'

+#13+ 'Элемент не удалён!',mtError,[mbOk],0);

exit;

end; new(PBook);

PBook^.avtor:=Edit1.Text;

PBook^.nazvanie:=Edit2.Text;

PBook^.god:=StrToInt(Edit3.Text);

PBook^.next:=nil;

if head=nil then begin

head:=PBook; tail:=PBook;

end

else if iInsItem=0 then begin

PBook^.next:=head; head:=PBook;

end

else if iInsItem=ListBox1.Count then begin

tail^.next:=PBook; tail:=PBook;

end

else begin

pInsItem:=head;//будет указатель на удаляемый

pp:=nil; //указатель на предыдущий удаляемому

for i:=0 to iInsItem-1 do begin

pp:=pInsItem;

pInsItem:=pp^.next;

end;//for

PBook^.next:=pp^.next; pp^.next:=PBook

end;//if ... else

ListBox1.Items.Insert(iInsItem,Edit3.Text

+' '+Edit2.Text+' '+Edit1.Text);

end;// procedure TForm1.BitBtn7Click

p
rocedure TForm1.Button1Click(Sender: TObject);

var pp,pMoveItem:TPBook; i:integer;

begin //Переместить выделенный элемент в начало

if (ListBox1.ItemIndex<=0) or (ListBox1.Items.Count<=1) then

exit;

pMoveItem:=head;//будет указатель на удаляемый

pp:=nil; //указатель на предыдущий удаляемому

for i:=0 to ListBox1.ItemIndex-1 do begin

pp:=pMoveItem; pMoveItem:=pp^.next;

end;

if ListBox1.ItemIndex=ListBox1.Items.Count-1 then begin

pp^.next:=nil;

tail^.next:=head;

head:=tail;

tail:=pp;

end

else begin

pp^.next:=pMoveItem^.next;

pMoveItem^.next:=head;

head:=pMoveItem;

end;;

ListBox1.Items.Move(ListBox1.ItemIndex, 0);

end;

end.// procedure TForm1.Button1Click



Макет формы



СПРАВКА ПО LISTBOX

TListBox.Sorted:=true – выполнить сортировку строк списка

TListBox.Clear; - очистить список

TListBox. Count – количество элементов списка

TListBox. ItemIndex – 0, 1,… индекс выделенного эл-та списка, минус единица (-1), если нет выделения

TListBox. Items: TStrings – массив эл-тов списка

TListBox. Items[i] – i-тый эл-т списка

TListBox.Selected[i] = true, если выделен i-тый эл-т списка, TListBox.Selected[i]:=true – выдалить i-тый эл-т программно

TListBox. Visible:=true\false – программно отобразить\спрятать

TListBox. procedure AddItem(Item: String; AObject: TObject);

добавить объект в список и текст Item для отображения

TListBox. Items. Count – кол-во эл-тов списка

TListBox. Items. Add(const S: string): Int – добавить S в список

TListBox. Items. AddStrings(Strings: TStrings) – – добавить строки в список

TListBox. Items. Delete(Index: Integer) – удалить эл-т списка

TListBox. Items. Exchange(Index1, Index2: Integer) – поменять эл-ты списка местами

TListBox. Items. Insert(Index: Integer; const S: string) – вставить строку в список

TListBox. Items. Move(CurIndex, NewIndex: Integer) – переместить эл-т списка в новую позицию



Случайные файлы

Файл
184003.doc
50403.rtf
160883.rtf
61841.rtf
38438.rtf