8. Листинг программы

unit Unit1;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Grids, Vcl.Buttons, unit2;

type

PDisk = ^Disk;

Disk = Record

Data: string;

Name: string;

Author: string;

Price: integer;

Note: string;

Next: PDisk;

End;

TFrmMain = class(TForm)

Sg: TStringGrid;

PnlActions: TPanel;

BtnAdd: TButton;

BtnChange: TButton;

BtnDelete: TButton;

EdtAuthorSearch: TEdit;

BtnNameSearch: TButton;

EdtNameSearch: TEdit;

BtnAuthorSearch: TButton;

Rg: TRadioGroup;

LblSearch: TLabel;

LblOperations: TLabel;

PnlOperations: TPanel;

PnlSearch: TPanel;

BtnRefresh: TBitBtn;

procedure FormCreate(Sender: TObject);

procedure BtnAddClick(Sender: TObject);

procedure BtnChangeClick(Sender: TObject);

procedure BtnDeleteClick(Sender: TObject);

procedure BtnNameSearchClick(Sender: TObject);

procedure BtnRefreshClick(Sender: TObject);

procedure BtnAuthorSearchClick(Sender: TObject);

procedure RgClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure SgDrawCell(Sender: TObject; ACol, ARow: integer; Rect: TRect;

State: TGridDrawState);

private

{ Private declarations }

public

procedure Sort(SortType: integer);

{ Public declarations }

end;

var

FrmMain: TFrmMain;

Head: PDisk;

Correct: Boolean = true;

IsAdded: Boolean;

implementation

{$R *.dfm}

// процедура создания сортированного списка

procedure TFrmMain.Sort(SortType: integer);

var

H, N, NewHead, Temp: PDisk;

DiskType, NewDiskType, RowNum, ColNum: integer;

CurName, NewName: String;

begin

H := Head;

NewHead := nil;

// выполнять, пока не пройдёмся по всему текущему списку

while H <> nil do

begin

// DiskType - числовое значение типа текущего диска

if H^.Data = 'фильмы' then

DiskType := 0

else if H^.Data = 'музыка' then

DiskType := 1

else

DiskType := 2;

// если сортированный список не существует, то создаём

if NewHead = nil then

begin

New(NewHead);

NewHead^ := H^;

NewHead^.Next := nil;

end

else

// если сортированный список существует

begin

N := NewHead;

// NewDiskType - числовое значение типа диска из сортированного списка

if N^.Data = 'фильмы' then

NewDiskType := 0

else if N^.Data = 'музыка' then

NewDiskType := 1

else

NewDiskType := 2;

{ если сортированный список состоит только из 1го элемента и у диска из

сортированного списка приоритет выше чем у текущего, то добавляем

текущий после сортированного }

if (DiskType > NewDiskType) and (NewHead^.Next = nil) then

begin

New(N^.Next);

N^.Next^ := H^;

N^.Next^.Next := nil;

end

else

// если предыдущее условие не выполнено

begin

// если DiskType = NewDiskType, т.е. приоритеты дисков равны и список состоит из 1го диска

if NewHead^.Next = nil then

begin

{ SortType = 0, если сортируем по наименованию, 1 - если по автору.

CurName и NewName - строковые величины, которые будут сравниваются,

и в зависимости от типа сортировки могут обозначать

наименование(0) или автора(1) диска, CurName - текущий диск,

NewName - диск из сортированного списка }

if SortType = 0 then

begin

CurName := H^.Name;

NewName := N^.Name;

end

else

begin

CurName := H^.Author;

NewName := N^.Author;

end;

// добавляем в сортированный список элемент(диск) из текущего

if AnsiLowerCase(CurName) > AnsiLowerCase(NewName) then

begin

New(NewHead^.Next);

NewHead^.Next^ := H^;

NewHead^.Next^.Next := nil;

end

else

begin

Temp := NewHead;

New(NewHead);

NewHead^ := H^;

NewHead^.Next := Temp;

end;

end

// если в сортированном списке элементов больше, чем 1

else

begin

// обновляем приоритет диска из нового списка и сравниваемые величины

if N^.Data = 'фильмы' then

NewDiskType := 0

else if N^.Data = 'музыка' then

NewDiskType := 1

else

NewDiskType := 2;

if SortType = 0 then

begin

CurName := H^.Name;

NewName := N^.Name;

end

else

begin

CurName := H^.Author;

NewName := N^.Author;

end;

// проверяем 1ый элемент сортированного списка

if (DiskType = NewDiskType) and

(AnsiLowerCase(CurName) < AnsiLowerCase(NewName)) then

begin

Temp := NewHead;

New(NewHead);

NewHead^ := H^;

NewHead^.Next := Temp;

end

else

// проверяем остальные элементы

begin

repeat

// если следующего за отсортированным диском не существует, то добавляем после сортированного текущий

if N^.Next = nil then

begin

New(N^.Next);

N^.Next^ := H^;

N^.Next^.Next := nil;

break;

end;

// обновляем сравниваемые величины

if SortType = 0 then

begin

CurName := H^.Name;

NewName := N^.Next^.Name;

end

else

begin

CurName := H^.Author;

NewName := N^.Next^.Author;

end;

{ если (приоритеты текущего диска и следующего сортированного диска

равны и не выполняется условие строкового(алфавитного) сравнения) или

(приоритет текущего диска больше приоритета следующего за сортированным

диска),то переходим на следующий сортированный диск и обновляем приоритет }

if ((DiskType = NewDiskType) and

(AnsiLowerCase(CurName) > AnsiLowerCase(NewName))) or

(DiskType > NewDiskType) then

begin

N := N^.Next;

if N^.Next <> nil then

begin

if N^.Next^.Data = 'фильмы' then

NewDiskType := 0

else if N^.Next^.Data = 'музыка' then

NewDiskType := 1

else

NewDiskType := 2;

end;

end

else

{ иначе, если (приоритеты текущего диска и следующего сортированного диска не

равны или выполняется условие строкового(алфавитного) сравнения) или

(приоритет текущего диска равен приоритету следующего за сортированным

диска),то добавляем текущий диск к сортированным }

begin

Temp := N^.Next;

New(N^.Next);

N^.Next^ := H^;

N^.Next^.Next := Temp;

break;

end;

// повторяем, пока не пройдемся по всему сортированному списку

until N = nil;

end;

end;

end;

end;

// переходим на следующий элемент(диск) текущего списка

H := H^.Next;

{ если прошлись уже по всему текущему списку, значит отсортированный список

готов, неотсортированный список больше не нужен, удаляем его

для экономии памяти(повышение эффективности программы) }

end;

if Head <> nil then

begin

while Head <> nil do

begin

Temp := Head;

Head := Head^.Next;

Dispose(Temp);

end;

Head := NewHead;

// печать отсортированного списка

if IsAdded = true then

Sg.RowCount := Sg.RowCount + 1;

H := Head;

with FrmMain do

for RowNum := 1 to Sg.RowCount - 1 do

begin

for ColNum := 0 to 4 do

begin

case ColNum of

0:

Sg.Cells[ColNum, RowNum] := H^.Data;

1:

Sg.Cells[ColNum, RowNum] := H^.Name;

2:

Sg.Cells[ColNum, RowNum] := H^.Author;

3:

Sg.Cells[ColNum, RowNum] := inttostr(H^.Price);

4:

Sg.Cells[ColNum, RowNum] := H^.Note;

end;

end;

H := H^.Next;

end;

end;

end;

// при нажатии на кнопку 'Добавить'

procedure TFrmMain.BtnAddClick(Sender: TObject);

begin

with FrmNewDisk do

begin

// очищаем поля компонентов на второй форме

CmbDiskType.ItemIndex := 0;

EdtName.Text := '';

EdtAuthor.Text := '';

EdtPrice.Text := '';

EdtNote.Text := '';

BtnAddNewDisk.Visible := true;

BtnChangeDisk.Visible := false;

IsAdded := true;

// открываем вторую форму

FrmNewDisk.ShowModal;

end;

end;

// процедура печати результата поиска

procedure PrintSearch(Searching: string; T: integer);

var

H, Temp, PrintDisk: PDisk;

Comparing: string;

begin

with FrmNewDisk do

with FrmMain do

begin

// PrintDisk - список дисков, которые удовлетворяют условию поиска

PrintDisk := nil;

H := Head;

// проходимся по всему списку

while H <> nil do

begin

{ параметр T передаём при вызове процедуры, если он = 1,

то ищем диски по наименованию, иначе по автору.

Comparing - наименование/автор текущего диска,

Searching - наименование/автор, которого мы хотим найти }

if T = 1 then

Comparing := H^.Name

else

Comparing := H^.Author;

// если строка Searching является строкой/подстрокой строки Comparing

if Pos(AnsiLowerCase(Searching), AnsiLowerCase(Comparing)) <> 0 then

begin

// если PrintDisk пустой, то создаём его и добавляем 1ый элемент(диск)

if PrintDisk = nil then

begin

New(PrintDisk);

PrintDisk^ := H^;

PrintDisk^.Next := nil;

end

else

// если не пустой, то добавляем элемент

begin

Temp := PrintDisk;

while Temp^.Next <> nil do

Temp := Temp^.Next;

New(Temp^.Next);

Temp^.Next^ := H^;

Temp^.Next^.Next := nil;

end;

end;

// проверяем следующий элемент(диск) списка

H := H^.Next;

end;

{ после того, как проверили весь список, если PrintDisk пустой,

показать соответствующее сообщение }

if PrintDisk = nil then

ShowMessage('По данному запросу дисков не найдено.')

else

begin

{ если PrintDisk не пустой, то выводим все его элементы на экран,

последовательно удаляя элементы PrintDisk'a для экономии памяти

(повышение эффективности программы) }

Sg.RowCount := 1;

while PrintDisk <> nil do

begin

Sg.RowCount := Sg.RowCount + 1;

Sg.Cells[0, Sg.RowCount - 1] := PrintDisk^.Data;

Sg.Cells[1, Sg.RowCount - 1] := PrintDisk^.Name;

Sg.Cells[2, Sg.RowCount - 1] := PrintDisk^.Author;

Sg.Cells[3, Sg.RowCount - 1] := inttostr(PrintDisk^.Price);

Sg.Cells[4, Sg.RowCount - 1] := PrintDisk^.Note;

Temp := PrintDisk;

PrintDisk := PrintDisk^.Next;

Dispose(Temp);

end;

end;

end;

end;

// процедура поиска и вывода на экран дисков, поиск производится по автору

procedure TFrmMain.BtnAuthorSearchClick(Sender: TObject);

begin

PrintSearch(EdtAuthorSearch.Text, 2);

end;

// при нажатии на кнопку 'Изменить'

procedure TFrmMain.BtnChangeClick(Sender: TObject);

var

H, Temp: PDisk;

RowNum, ColNum: integer;

begin

with FrmNewDisk do

begin

// если выделили не заглавную строку таблицы

if Sg.Row <> 0 then

begin

{ переносим значения из ячеек строки выделенной таблицы в поля компонентов

на другой форме для дальнейшей работы с изменяемым элементом списка(диском) }

if Sg.Cells[0, Sg.Row] = 'фильмы' then

CmbDiskType.ItemIndex := 0;

if Sg.Cells[0, Sg.Row] = 'музыка' then

CmbDiskType.ItemIndex := 1;

if Sg.Cells[0, Sg.Row] = 'софт' then

CmbDiskType.ItemIndex := 2;

EdtName.Text := Sg.Cells[1, Sg.Row];

EdtAuthor.Text := Sg.Cells[2, Sg.Row];

EdtPrice.Text := Sg.Cells[3, Sg.Row];

EdtNote.Text := Sg.Cells[4, Sg.Row];

BtnAddNewDisk.Visible := false;

BtnChangeDisk.Visible := true;

Correct := false;

// открываем вторую форму для корректировки диска

FrmNewDisk.ShowModal;

// если изменения не были произведены, тогда выходим из процедуры

if Correct = false then

begin

Exit;

end

else

// иначе

begin

H := Head;

// если корректируем 1ую строку (1ый диск списка)}

if Sg.Row = 1 then

begin

// если диск стал иметь тип 'фильмы'

if CmbDiskType.Text = 'фильмы' then

begin

H^.Data := CmbDiskType.Text;

H^.Name := EdtName.Text;

H^.Author := EdtAuthor.Text;

H^.Price := strtoint(EdtPrice.Text);

H^.Note := EdtNote.Text;

{ если ни одна из сортировок не активирована,

то меняем значенияполей в 1ой строке таблицы }

if Rg.ItemIndex = -1 then

begin

Sg.Cells[0, 1] := CmbDiskType.Text;

Sg.Cells[1, 1] := EdtName.Text;

Sg.Cells[2, 1] := EdtAuthor.Text;

Sg.Cells[3, 1] := EdtPrice.Text;

Sg.Cells[4, 1] := EdtNote.Text;

ShowMessage('Диск успешно отредактирован.');

Exit;

end;

end;

// если диск стал иметь тип 'музыка'

if CmbDiskType.Text = 'музыка' then

begin

// запоминаем в Temp меняющуюся строку, текущий диск извлекается из списка

Temp := H;

H := H^.Next;

Head := Head^.Next;

Temp^.Data := CmbDiskType.Text;

Temp^.Name := EdtName.Text;

Temp^.Author := EdtAuthor.Text;

Temp^.Price := strtoint(EdtPrice.Text);

Temp^.Note := EdtNote.Text;

{ если тип первого элемента(диска) списка 'музыка',

то Temp добавляется в список как 1ый диск }

if H^.Data = 'музыка' then

begin

Temp^.Next := H;

Head := Temp;

end

else

// иначе

begin

// если следующий диск в списке существует

if H^.Next <> nil then

// пока тип следующего диска не 'музыка' или не 'софт'

while (H^.Next^.Data <> 'музыка') and

(H^.Next^.Data <> 'софт') do

begin

{ если следующий диск не является последним в списке,

то переходим к следующему }

if H^.Next^.Next <> nil then

H := H^.Next

else

// иначе переходим к следующему и выходим из цикла

begin

H := H^.Next;

break;

end;

end;

// добавляем диск Temp как следующий за текущим

Temp^.Next := H^.Next;

H^.Next := Temp;

end;

end;

// если диск стал иметь тип 'софт'

if CmbDiskType.Text = 'софт' then

begin

// запоминаем в Temp меняющуюся строку, текущий диск извлекается из списка

Temp := H;

H := H^.Next;

Head := Head^.Next;

Temp^.Data := CmbDiskType.Text;

Temp^.Name := EdtName.Text;

Temp^.Author := EdtAuthor.Text;

Temp^.Price := strtoint(EdtPrice.Text);

Temp^.Note := EdtNote.Text;

{ если тип первого элемента(диска) списка 'софт',

то Temp добавляется в список как 1ый диск }

if Head^.Data = 'софт' then

begin

Temp^.Next := Head;

Head := Temp;

end

else

// иначе

begin

// если следующий диск в списке существует

if H^.Next <> nil then

// пока тип следующего диска не 'софт'

while H^.Next^.Data <> 'софт' do

begin

{ если следующий диск не является последним в списке,

то переходим к следующему }

if H^.Next^.Next <> nil then

H := H^.Next

else

// иначе переходим к следующему и выходим из цикла

begin

H := H^.Next;

break;

end;

end;

// добавляем диск Temp как следующий за текущим

Temp^.Next := H^.Next;

H^.Next := Temp;

end;

end;

end

else

// если корректируем не 1ую строку (не 1ый диск списка)}

begin

// запоминаем в Temp меняющуюся строку, текущий диск извлекается из списка

while (H^.Next^.Data <> Sg.Cells[0, Sg.Row]) or

(H^.Next^.Name <> Sg.Cells[1, Sg.Row]) or

(H^.Next^.Author <> Sg.Cells[2, Sg.Row]) or

(inttostr(H^.Next^.Price) <> Sg.Cells[3, Sg.Row]) or

(H^.Next^.Note <> Sg.Cells[4, Sg.Row]) do

H := H^.Next;

Temp := H^.Next;

H^.Next := H^.Next^.Next;

Temp^.Data := CmbDiskType.Text;

Temp^.Name := EdtName.Text;

Temp^.Author := EdtAuthor.Text;

Temp^.Price := strtoint(EdtPrice.Text);

Temp^.Note := EdtNote.Text;

// вставляем её на вершину своего типа

// если диск стал иметь тип 'фильмы'

if CmbDiskType.Text = 'фильмы' then

begin

Temp^.Next := Head;

Head := Temp;

end;

// если диск стал иметь тип 'музыка'

if CmbDiskType.Text = 'музыка' then

begin

H := Head;

{ если тип первого элемента(диска) списка 'музыка',

то Temp добавляется в список как 1ый диск }

if Head^.Data = 'музыка' then

begin

Temp^.Next := Head;

Head := Temp;

end

else

// иначе

begin

// если следующий диск в списке существует

if H^.Next <> nil then

// пока тип следующего диска не 'музыка' или не 'софт'

while (H^.Next^.Data <> 'музыка') and

(H^.Next^.Data <> 'софт') do

begin

{ если следующий диск не является последним в списке,

то переходим к следующему }

if H^.Next^.Next <> nil then

H := H^.Next

else

// иначе переходим к следующему и выходим из цикла

begin

H := H^.Next;

break;

end;

end;

// добавляем диск Temp как следующий за текущим

Temp^.Next := H^.Next;

H^.Next := Temp;

end;

end;

// если диск стал иметь тип 'софт'

if CmbDiskType.Text = 'софт' then

begin

H := Head;

{ если тип первого элемента(диска) списка 'софт',

то Temp добавляется в список как 1ый диск }

if Head^.Data = 'софт' then

begin

Temp^.Next := Head;

Head := Temp;

end

else

// иначе

begin

// если следующий диск в списке существует

if H^.Next <> nil then

// пока тип следующего диска не 'софт'

while H^.Next^.Data <> 'софт' do

begin

{ если следующий диск не является последним в списке,

то переходим к следующему }

if H^.Next^.Next <> nil then

H := H^.Next

else

// иначе переходим к следующему и выходим из цикла

begin

H := H^.Next;

break;

end;

end;

// добавляем диск Temp как следующий за текущим

Temp^.Next := H^.Next;

H^.Next := Temp;

end;

end;

end;

{ если активирована сортировка по наименованию, сортируем

соответствующим образом и выводим на экран список }

if Rg.ItemIndex = 0 then

begin

IsAdded := false;

Sort(0);

ShowMessage('Диск успешно отредактирован.');

Exit;

end;

{ если активирована сортировка по автору, сортируем

соответствующим образом и выводим на экран список }

if Rg.ItemIndex = 1 then

begin

IsAdded := false;

Sort(1);

ShowMessage('Диск успешно отредактирован.');

Exit;

end;

// если никакая сортировка не активирована, то выводим на экран список

H := Head;

for RowNum := 1 to Sg.RowCount - 1 do

begin

for ColNum := 0 to 4 do

begin

case ColNum of

0:

Sg.Cells[ColNum, RowNum] := H^.Data;

1:

Sg.Cells[ColNum, RowNum] := H^.Name;

2:

Sg.Cells[ColNum, RowNum] := H^.Author;

3:

Sg.Cells[ColNum, RowNum] := inttostr(H^.Price);

4:

Sg.Cells[ColNum, RowNum] := H^.Note;

end;

end;

H := H^.Next;

end;

ShowMessage('Диск успешно отредактирован.');

end;

end;

end;

end;

// удаление строки из таблицы

procedure GridDeleteRow(RowNumber: integer);

var

i: integer;

begin

with FrmMain do

begin

Sg.Row := RowNumber;

// если удаляется последняя строка таблицы

if Sg.Row = Sg.RowCount - 1 then

Sg.RowCount := Sg.RowCount - 1

else

begin

// не последняя

for i := RowNumber to Sg.RowCount - 1 do

Sg.Rows[i] := Sg.Rows[i + 1];

Sg.RowCount := Sg.RowCount - 1;

end;

end;

end;

// при нажатии на кнопку 'Удалить'

procedure TFrmMain.BtnDeleteClick(Sender: TObject);

var

H, Temp: PDisk;

begin

H := Head;

// если выделена не заглавная строка таблицы

if Sg.Row <> 0 then

begin

{ если данные первого в списке диска совпадают с данными диска

выделенной строки таблицы, то удаляем первый элемент(диск) из списка,

а также очищаем занимаемую им память }

if (H^.Data = Sg.Cells[0, Sg.Row]) and (H^.Name = Sg.Cells[1, Sg.Row]) and

(H^.Author = Sg.Cells[2, Sg.Row]) and

(inttostr(H^.Price) = Sg.Cells[3, Sg.Row]) and

(H^.Note = Sg.Cells[4, Sg.Row]) then

begin

Temp := Head;

Head := Head^.Next;

Dispose(Temp);

end

else

{ в противном случае ищем совпадения данных текущего диска с данными диска

в выделенной строке таблицы, после чего удаляем этот элемент(диск) из списка

и очищаем занимаемую им память }

begin

while (H^.Next^.Data <> Sg.Cells[0, Sg.Row]) or

(H^.Next^.Name <> Sg.Cells[1, Sg.Row]) or

(H^.Next^.Author <> Sg.Cells[2, Sg.Row]) or

(inttostr(H^.Next^.Price) <> Sg.Cells[3, Sg.Row]) or

(H^.Next^.Note <> Sg.Cells[4, Sg.Row]) do

H := H^.Next;

Temp := H^.Next;

H^.Next := H^.Next^.Next;

Dispose(Temp);

end;

// после физического удаления элемента(диска) из списка удаляем данные о нём из таблицы

GridDeleteRow(Sg.Row);

end;

end;

// процедура поиска и вывода на экран дисков, поиск производится по наименованию

procedure TFrmMain.BtnNameSearchClick(Sender: TObject);

begin

PrintSearch(EdtNameSearch.Text, 1);

end;

{ при нажатии на кнопку 'Обновить' выводит на экран весь список,

а также очищает поля поиска }

procedure TFrmMain.BtnRefreshClick(Sender: TObject);

var

H: PDisk;

begin

H := Head;

Sg.RowCount := 1;

while H <> nil do

begin

Sg.RowCount := Sg.RowCount + 1;

Sg.Cells[0, Sg.RowCount - 1] := H^.Data;

Sg.Cells[1, Sg.RowCount - 1] := H^.Name;

Sg.Cells[2, Sg.RowCount - 1] := H^.Author;

Sg.Cells[3, Sg.RowCount - 1] := inttostr(H^.Price);

Sg.Cells[4, Sg.RowCount - 1] := H^.Note;

H := H^.Next;

end;

EdtNameSearch.Text := '';

EdtAuthorSearch.Text := '';

end;

// при закрытие формы

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);

var

F: TextFile;

begin

AssignFile(F, 'Data.txt');

if Head <> nil then

begin

// создаём новый файл

Rewrite(F);

// проходимся по каждому диску списка

while Head <> nil do

begin

// записываем информацию о диске в файл

if Head^.Data = 'фильмы' then

write(F, '0 ')

else if Head^.Data = 'музыка' then

write(F, '1 ')

else

write(F, '2 ');

write(F, Head^.Name, ' ');

write(F, Head^.Author, ' ');

write(F, inttostr(Head^.Price), ' ');

{ если текущий диск является последним, то просто дописываем в файл последнее поле диска('примечание') }

if Head^.Next = nil then

write(F, Head^.Note)

else

{ если текущий диск не является последним в списке, то после записи последнего

поля диска('примечание') в файл переходим на следующую строку файла }

writeln(F, Head^.Note);

// переходим к следующему диску

Head := Head^.Next;

end;

// закрываем файл

CloseFile(F);

end

else if FileExists('Data.txt') then

Erase(F);

end;

// при создании формы

procedure TFrmMain.FormCreate(Sender: TObject);

var

F: TextFile;

C: char;

S: string;

H: PDisk;

i: integer;

begin

{ присваиваем заглавным ячейкам таблицы имена,

а также устанавливаем ширину некоторых её столбцов }

Sg.ColWidths[1] := 250;

Sg.ColWidths[2] := 150;

Sg.ColWidths[4] := 495;

Sg.Cells[0, 0] := ' Тип';

Sg.Cells[1, 0] := ' Наименование';

Sg.Cells[2, 0] := ' Автор';

Sg.Cells[3, 0] := ' Цена';

Sg.Cells[4, 0] :=

' Примечание';

// если существует файл с данными

if FileExists('Data.txt') then

begin

// открываем файл F для чтения

AssignFile(F, 'Data.txt');

Reset(F);

// i - номер печатающейся строки

i := 1;

// пока не конец файла

while not Eof(F) do

begin

// если список пуст

if Head = nil then

begin

// создаём список, считываем данные о первом диске из файла

New(Head);

Read(F, C);

case strtoint(C) of

0:

Head^.Data := 'фильмы';

1:

Head^.Data := 'музыка';

2:

Head^.Data := 'софт';

end;

Read(F, C, C);

S := '';

while C <> ' ' do

begin

S := S + C;

Read(F, C);

end;

Head^.Name := S;

S := '';

Read(F, C);

while C <> ' ' do

begin

S := S + C;

Read(F, C);

end;

Head^.Author := S;

S := '';

Read(F, C);

while C <> ' ' do

begin

S := S + C;

Read(F, C);

end;

Head^.Price := strtoint(S);

S := '';

Read(F, C);

while not((Ord(C) = 13) or (Ord(C) = 26)) do

begin

S := S + C;

Read(F, C);

end;

Head^.Note := S;

Head^.Next := nil;

// вывод списка(первого элемента) на экран

Sg.RowCount := Sg.RowCount + 1;

Sg.Cells[0, 1] := Head^.Data;

Sg.Cells[1, 1] := Head^.Name;

Sg.Cells[2, 1] := Head^.Author;

Sg.Cells[3, 1] := inttostr(Head^.Price);

Sg.Cells[4, 1] := Head^.Note;

end

else

// если список не пуст

begin

// добавляем диск в список, считывая данные о нём из файла

Readln(F);

H := Head;

while H^.Next <> nil do

H := H^.Next;

New(H^.Next);

H := H^.Next;

Read(F, C);

case strtoint(C) of

0:

H^.Data := 'фильмы';

1:

H^.Data := 'музыка';

2:

H^.Data := 'софт';

end;

Read(F, C, C);

S := '';

while C <> ' ' do

begin

S := S + C;

Read(F, C);

end;

H^.Name := S;

S := '';

Read(F, C);

while C <> ' ' do

begin

S := S + C;

Read(F, C);

end;

H^.Author := S;

S := '';

Read(F, C);

while C <> ' ' do

begin

S := S + C;

Read(F, C);

end;

H^.Price := strtoint(S);

S := '';

Read(F, C);

while not((Ord(C) = 13) or (Ord(C) = 26)) do

begin

S := S + C;

Read(F, C);

end;

H^.Note := S;

H^.Next := nil;

// вывод на экран очередного диска

Sg.RowCount := Sg.RowCount + 1;

i := i + 1;

Sg.Cells[0, i] := H^.Data;

Sg.Cells[1, i] := H^.Name;

Sg.Cells[2, i] := H^.Author;

Sg.Cells[3, i] := inttostr(H^.Price);

Sg.Cells[4, i] := H^.Note;

end;

end;

// закрываем файл

CloseFile(F);

end;

end;

// при нажатии на вид сортировки

procedure TFrmMain.RgClick(Sender: TObject);

begin

IsAdded := false;

if Rg.ItemIndex = 0 then

// сортируем по наименованию

Sort(0);

if Rg.ItemIndex = 1 then

// сортируем по автору

Sort(1);

end;

end.

unit Unit2;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids;

type

TFrmNewDisk = class(TForm)

EdtName: TEdit;

CmbDiskType: TComboBox;

EdtAuthor: TEdit;

EdtPrice: TEdit;

EdtNote: TEdit;

BtnAddNewDisk: TButton;

BtnChangeDisk: TButton;

LblData: TLabel;

LblName: TLabel;

LblAuthor: TLabel;

LblPrice: TLabel;

LblNote: TLabel;

procedure BtnAddNewDiskClick(Sender: TObject);

procedure BtnChangeDiskClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmNewDisk: TFrmNewDisk;

implementation

{$R *.dfm}

uses unit1;

{ функция проверки списка на наличие диска с полями, заполненными так же,

как поля компонентов формы }

function CheckDisk(H: PDisk): boolean;

var

s: string;

begin

Result := false;

with FrmNewDisk do

// проходимся по всему списку

while H <> nil do

begin

case CmbDiskType.ItemIndex of

0:

s := 'фильмы';

1:

s := 'музыка';

2:

s := 'софт';

end;

{ если в списке имеется диск с полями, заполненными так же,

как поля компонентов формы, тогда функции присваивается

соответственный результат, а также выходим из функции }

if (H^.Data = s) and (H^.Name = EdtName.Text) and

(H^.Author = EdtAuthor.Text) and (inttostr(H^.Price) = EdtPrice.Text)

and (H^.Note = EdtNote.Text) then

begin

Result := true;

Exit;

end

else

// иначе проверяем следующий элемент

H := H^.Next;

end;

end;

// процедура добавления диска в список

procedure AddDisk(H: PDisk);

var

i, j: integer;

Temp: PDisk;

begin

{ если в списке имеется диск с полями, заполненными так же,

как поля компонентов формы, выводим соответствующее сообщение }

if CheckDisk(Head) = true then

begin

ShowMessage('Данный диск уже имеется.');

Exit;

end

else

// иначе

with FrmNewDisk do

// если список не существует

if H = nil then

begin

// создаём список

New(Head);

with Head^ do

begin

case CmbDiskType.ItemIndex of

0:

Data := 'фильмы';

1:

Data := 'музыка';

2:

Data := 'софт';

end;

Name := EdtName.Text;

Author := EdtAuthor.Text;

Price := strtoint(EdtPrice.Text);

Note := EdtNote.Text;

Next := nil;

with FrmMain do

begin

// вывод на экран списка, состоящего из 1 элемента(диска)

Sg.RowCount := Sg.RowCount + 1;

Sg.Cells[0, Sg.RowCount - 1] := Head^.Data;

Sg.Cells[1, Sg.RowCount - 1] := Head^.Name;

Sg.Cells[2, Sg.RowCount - 1] := Head^.Author;

Sg.Cells[3, Sg.RowCount - 1] := inttostr(Head^.Price);

Sg.Cells[4, Sg.RowCount - 1] := Head^.Note;

ShowMessage('CD/DVD диск добавлен.');

end;

end;

end

else

begin

// если список существует и добавляем фильм, то добавляем элемент(диск) в список

if CmbDiskType.ItemIndex = 0 then

begin

New(H);

H^.Data := 'фильмы';

H^.Name := EdtName.Text;

H^.Author := EdtAuthor.Text;

H^.Price := strtoint(EdtPrice.Text);

H^.Note := EdtNote.Text;

H^.Next := Head;

Head := H;

with FrmMain do

begin

{ если активирована сортировка по наименованию, сортируем

соответствующим образом и выводим на экран список }

if Rg.ItemIndex = 0 then

begin

Sort(0);

ShowMessage('CD/DVD диск добавлен.');

Exit;

end;

{ если активирована сортировка по автору, сортируем

соответствующим образом и выводим на экран список }

if Rg.ItemIndex = 1 then

begin

Sort(1);

ShowMessage('CD/DVD диск добавлен.');

Exit;

end;

{ если никакая сортировка не активирована,

вставляем в таблицу добавленный элемент(диск) }

Sg.RowCount := Sg.RowCount + 1;

For i := Sg.RowCount - 2 downto 1 do

Sg.Rows[i + 1] := Sg.Rows[i];

Sg.Cells[0, 1] := Head^.Data;

Sg.Cells[1, 1] := Head^.Name;

Sg.Cells[2, 1] := Head^.Author;

Sg.Cells[3, 1] := inttostr(Head.Price);

Sg.Cells[4, 1] := Head^.Note;

ShowMessage('CD/DVD диск добавлен.');

Exit;

end;

end;

// если список существует и добавляем музыку

if CmbDiskType.ItemIndex = 1 then

begin

// j - счётчик строки, в которую будем добавлять новый элемент(диск) списка

j := 1;

// если первый элемент(диск) в списке относится к типу фильмов

if Head^.Data = 'фильмы' then

begin

// пока следующий элемент(диск) списка существует

while H^.Next <> nil do

begin

{ если у следующего диска его тип относится к фильмам,

то переходим к следующему диску, увеличивая счётчик на 1 }

if H^.Next^.Data = 'фильмы' then

begin

H := H^.Next;

j := j + 1;

end

else

{ если у следующего диска его тип не относится к фильмам,

то увеличиваем счётчик на 1 и выходим из цикла }

begin

j := j + 1;

break;

end;

end;

// если дошли до последнего элемента(диска) списка, то увеличиваем счётчик на 1

if H^.Next = nil then

j := j + 1;

// добавляем элемент(диск) в список

Temp := H^.Next;

New(H^.Next);

with H^.Next^ do

begin

Data := 'музыка';

Name := EdtName.Text;

Author := EdtAuthor.Text;

Price := strtoint(EdtPrice.Text);

Note := EdtNote.Text;

Next := Temp;

end;

end

else

// если первый элемент(диск) в списке не относится к типу фильмов

begin

// добавляем в список новый элемент(диск) как первый элемент списка

New(H);

H^.Data := 'музыка';

H^.Name := EdtName.Text;

H^.Author := EdtAuthor.Text;

H^.Price := strtoint(EdtPrice.Text);

H^.Note := EdtNote.Text;

H^.Next := Head;

Head := H;

end;

with FrmMain do

begin

{ если активирована сортировка по наименованию, сортируем

соответствующим образом и выводим на экран список }

if Rg.ItemIndex = 0 then

begin

Sort(0);

ShowMessage('CD/DVD диск добавлен.');

Exit;

end;

{ если активирована сортировка по автору, сортируем

соответствующим образом и выводим на экран список }

if Rg.ItemIndex = 1 then

begin

Sort(1);

ShowMessage('CD/DVD диск добавлен.');

Exit;

end;

{ если никакая сортировка не активирована,

вставляем в таблицу добавленный элемент(диск) }

Sg.RowCount := Sg.RowCount + 1;

For i := Sg.RowCount - 2 downto j do

Sg.Rows[i + 1] := Sg.Rows[i];

Sg.Cells[0, j] := 'музыка';

Sg.Cells[1, j] := EdtName.Text;

Sg.Cells[2, j] := EdtAuthor.Text;

Sg.Cells[3, j] := EdtPrice.Text;

Sg.Cells[4, j] := EdtNote.Text;

ShowMessage('CD/DVD диск добавлен.');

Exit;

end;

end;

// если список существует и добавляем софт

if CmbDiskType.ItemIndex = 2 then

begin

// j - счётчик строки, в которую будем добавлять новый элемент(диск) списка

j := 1;

// если первый элемент(диск) в списке не относится к типу софт

if Head^.Data <> 'софт' then

begin

// пока следующий элемент(диск) списка существует

while H^.Next <> nil do

begin

{ если у следующего диска его тип не относится к софту,

то переходим к следующему диску, увеличивая счётчик на 1 }

if H^.Next^.Data <> 'софт' then

begin

H := H^.Next;

j := j + 1;

end

else

{ если у следующего диска его тип относится к софту,

то увеличиваем счётчик на 1 и выходим из цикла }

begin

j := j + 1;

break;

end;

end;

// если дошли до последнего элемента(диска) списка, то увеличиваем счётчик на 1

if H^.Next = nil then

j := j + 1;

// добавляем элемент(диск) в список

Temp := H^.Next;

New(H^.Next);

with H^.Next^ do

begin

Data := 'софт';

Name := EdtName.Text;

Author := EdtAuthor.Text;

Price := strtoint(EdtPrice.Text);

Note := EdtNote.Text;

Next := Temp;

end;

end

else

// если первый элемент(диск) в списке относится к типу софт

begin

New(H);

H^.Data := 'софт';

H^.Name := EdtName.Text;

H^.Author := EdtAuthor.Text;

H^.Price := strtoint(EdtPrice.Text);

H^.Note := EdtNote.Text;

H^.Next := Head;

Head := H;

end;

with FrmMain do

begin

{ если активирована сортировка по наименованию, сортируем

соответствующим образом и выводим на экран список }

if Rg.ItemIndex = 0 then

begin

Sort(0);

ShowMessage('CD/DVD диск добавлен.');

Exit;

end;

{ если активирована сортировка по автору, сортируем

соответствующим образом и выводим на экран список }

if Rg.ItemIndex = 1 then

begin

Sort(1);

ShowMessage('CD/DVD диск добавлен.');

Exit;

end;

{ если никакая сортировка не активирована,

вставляем в таблицу добавленный элемент(диск) }

Sg.RowCount := Sg.RowCount + 1;

For i := Sg.RowCount - 2 downto j do

Sg.Rows[i + 1] := Sg.Rows[i];

Sg.Cells[0, j] := 'софт';

Sg.Cells[1, j] := EdtName.Text;

Sg.Cells[2, j] := EdtAuthor.Text;

Sg.Cells[3, j] := EdtPrice.Text;

Sg.Cells[4, j] := EdtNote.Text;

ShowMessage('CD/DVD диск добавлен.');

Exit;

end;

end;

end;

end;

// при нажатии на кнопку 'Добавить'

procedure TFrmNewDisk.BtnAddNewDiskClick(Sender: TObject);

begin

// если поля компонентов формы правильно заполнены

if (EdtName.Text <> '') and (EdtAuthor.Text <> '') and (EdtPrice.Text <> '')

and (CmbDiskType.ItemIndex <> -1) then

begin

if (pos(' ', EdtName.Text) = 0) and (pos(' ', EdtAuthor.Text) = 0) then

AddDisk(Head)

else

ShowMessage

('Поле ''''наименование'''' и ''''автор'''' не должны содержать пробел.');

end

else

// иначе показываем сообщение о незаполненности обязательных полей

ShowMessage('Заполните обязательные поля.');

end;

// при нажатии на кнопку 'Изменить'

procedure TFrmNewDisk.BtnChangeDiskClick(Sender: TObject);

begin

// если поля компонентов формы правильно заполнены

if (EdtName.Text <> '') and (EdtAuthor.Text <> '') and (EdtPrice.Text <> '')

and (CmbDiskType.ItemIndex <> -1) then

begin

// если никаких изменений не было произведено, вывести соответственное сообщение

if CheckDisk(Head) = true then

begin

ShowMessage

('Никаких изменений не произведено либо данный диск уже имеется.');

end

else

// если Correct = true, значит изменения были произведны

// возвращаемся к главной форме

begin

Correct := true;

FrmNewDisk.Close;

end;

end

// если поля компонентов неправильно заполнены, вывести соответственное сообщене

else

ShowMessage('Заполните обязательные поля.');

end;

end.