Тестирование данного продукта показало хорошую работоспособность и отсутствие ошибок и недочётов в программе, а также в выполнении требований задания курсового проекта. Были изучены базовая структура данных типа вектор и пирамидальный метод сортировки.

Литература

1 Структуры и организация данных в компьютере. Учебное пособие / Лакин В.И., Романов А.В. - Мн.: БНТУ, 2004 - 176 с.

2 Архангельский А.Я. Delphi 6. Справочное пособие. М.: ЗАО «Издательсво БИНОМ», 2001. 1024 с.

3 Вирт Н. Алгоритмы и структуры данных. СПб: Невский диалект, 2001. 352 с.

4 Гук М. Аппаратные средства IBM PC. Энциклопедия. СПб: Питер, 2003. 928 с.

5 Кнут Д.Э. Искусство программирования, том 1. Основные алгоритмы. М.: Издательский дом «Вильямс», 2002. 720 с.

6 Кнут Д.Э. Искусство программирования, том 3. Сортировка и поиск. М.: Издательский дом «Вильямс», 2001.  832 с.

7 Лэнгсам Й., Огенстайн М., Тененбаум А. Структура данных для персональных ЭВМ. - М.: Мир, 1989. - 475 с.

8 Фаронов В. Система программирования DELPHI. СПб.: «БВХ-Петербург», 2004. 887 с.

Приложение 1

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

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls, Grids, Menus, StdCtrls, ExtCtrls;

type

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

SRow=array [0..5] of String[30];

TForm1 = class(TForm)

PageControl1: TPageControl;

TabSheet1: TTabSheet;

XDgrid: TStringGrid;

TabSheet2: TTabSheet;

WTKgrid: TStringGrid;

TabSheet3: TTabSheet;

BANKgrid: TStringGrid;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

btnSearch: TButton;

txtSearch: TEdit;

TabSheet4: TTabSheet;

NDgrid: TStringGrid;

N4: TMenuItem;

CheckBox1: TCheckBox;

btnDel: TButton;

GroupBox1: TGroupBox;

btnSort1: TButton;

btnSort2: TButton;

procedure FormCreate(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure btnSearchClick(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure CheckBox1Click(Sender: TObject);

procedure btnDelClick(Sender: TObject);

procedure btnSort2Click(Sender: TObject);

procedure btnSort1Click(Sender: TObject);

private

{ Private declarations }

XDar: array [1..70] of String[30]; {массив для ХД}

WTKar: array [1..150] of String[30]; {массив для ВТК}

BANKar: array [1..50] of String[30]; {массив для БА}

public

{ Public declarations }

procedure LoadFromFiles;

procedure InitGrids;

procedure FillArrays;

procedure SaveInFiles;

procedure FillNDgrid;

procedure Sort;

procedure Sort2;

procedure SweepRows(r1,r2:word);

procedure SaveRow(var sr:SRow;r:word);

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

{Процедура загрузки файлоы в массивы}

procedure TForm1.LoadFromFiles;

var

F:TextFile;

i:integer;

begin

{Файл - 'XD.txt'}

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

AssignFile(F,'XD.txt');

Reset(F);

if IOResult <> 0 then

// ошибка открытия файла!

begin

{$I+}

MessageBox(0,'Ошибка!','Не возможно открыть файл XD.txt!',MB_OK);

exit;

end;

{$I+}

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

i:=1;

while not(SeekEof(F))do

begin

ReadLn(F,XDar[i]);

inc(i);

end;

CloseFile(F); // закрыть файл

{Файл - 'WTK.txt'}

{$I-}

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

AssignFile(F,'WTK.txt');

Reset(F);

if IOResult <> 0 then

// ошибка открытия файла!

begin

{$I+}

MessageBox(0,'Ошибка!','Не возможно открыть файл WTK.txt!',MB_OK);

exit;

end;

{$I+}

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

i:=1;

while not(SeekEof(F))do

begin

ReadLn(F,WTKar[i]);

inc(i);

end;

CloseFile(F); // закрыть файл

{Файл - 'BANK.txt'}

{$I-}

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

AssignFile(F,'BANK.txt');

Reset(F);

if IOResult <> 0 then

// ошибка открытия файла!

begin

{$I+}

MessageBox(0,'Ошибка!','Не возможно открыть файл BANK.txt!',MB_OK);

exit;

end;

{$I+}

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

i:=1;

while not(SeekEof(F))do

begin

ReadLn(F,BANKar[i]);

inc(i);

end;

CloseFile(F); // закрыть файл

end;

{Процедура инициализации таблицы и заполнение ее в соответсвии с массивами}

procedure TForm1.InitGrids;

var i,j:integer;

begin

XDgrid.Cells[0,0]:='Номер договора';

XDgrid.Cells[1,0]:='Дата заключения';

XDgrid.Cells[2,0]:='Дата завершения';

XDgrid.Cells[3,0]:='Тема договора';

XDgrid.Cells[4,0]:='Организация';

XDgrid.Cells[5,0]:='Признак завершения';

XDgrid.Cells[6,0]:='Cтоимость';

WTKgrid.Cells[0,0]:='Фамилия';

WTKgrid.Cells[1,0]:='Имя';

WTKgrid.Cells[2,0]:='Отчество';

WTKgrid.Cells[3,0]:='Год рождения ';

WTKgrid.Cells[4,0]:='Код ХД ';

WTKgrid.Cells[5,0]:='Признак';

WTKgrid.Cells[6,0]:='Сумма вознаграждения ';

WTKgrid.Cells[7,0]:='Домашний адрес ';

WTKgrid.Cells[8,0]:='Номер сбербанка';

WTKgrid.Cells[9,0]:='Расчетный счет ';

BANKgrid.Cells[0,0]:='Номер отделения';

BANKgrid.Cells[1,0]:='Город';

BANKgrid.Cells[2,0]:='Адрес ';

BANKgrid.Cells[3,0]:='Наименование отделения ';

BANKgrid.Cells[4,0]:='Банковский код ';

NDgrid.Cells[0,0]:='Номер договора';

NDgrid.Cells[1,0]:='Дата заключения';

NDgrid.Cells[2,0]:='Дата завершения';

NDgrid.Cells[3,0]:='Тема договора';

NDgrid.Cells[4,0]:='Организация';

NDgrid.Cells[5,0]:= 'Кол-во членов ВТК';

for i:=1 to 10 do

begin

for j:=1 to 7 do

XDgrid.Cells[j-1,i]:=XDar[(i-1)*7+j];

end;

for i:=1 to 15 do

begin

for j:=1 to 10 do

WTKgrid.Cells[j-1,i]:=WTKar[(i-1)*10+j];

end;

for i:=1 to 10 do

begin

for j:=1 to 5 do

BANKgrid.Cells[j-1,i]:=BANKar[(i-1)*5+j];

end;

end;

{Заполним массивы в соответсвии с данными в таблице}

procedure TForm1.FillArrays;

var i:integer;

begin

for i:=0 to 69 do

begin

XDar[i+1]:=XDgrid.Cells[(i mod 7),(i div 7)+1];

end;

for i:=0 to 149 do

begin

WTKar[i+1]:=WTKgrid.Cells[(i mod 10),(i div 10)+1];

end;

for i:=0 to 49 do

begin

BANKar[i+1]:=BANKgrid.Cells[(i mod 5),(i div 5)+1];

end;

end;

{Сохраним данные из массивов в файл}

procedure TForm1.SaveInFiles;

var

F:TextFile; // текстовый файл

i:integer;

begin

{XD.txt}

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

AssignFile(F,'XD.txt');

Rewrite(F);

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

for i:=1 to 70 do

WriteLn(F,XDar[i]);

CloseFile(F); // закрыть файл

{WTK.txt}

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

AssignFile(F,'WTK.txt');

Rewrite(F);

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

for i:=1 to 150 do

WriteLn(F,WTKar[i]);

CloseFile(F); // закрыть файл

{BANK.txt}

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

AssignFile(F,'BANK.txt');

Rewrite(F);

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

for i:=1 to 50 do

WriteLn(F,BANKar[i]);

CloseFile(F); // закрыть файл

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

LoadFromFiles; // загрузка данных из файла в массивы

InitGrids; // инициализация таблицы

FillNDgrid; // заполнить таблицу незавершенных договоров

end;

{Выход}

procedure TForm1.N2Click(Sender: TObject);

begin

Halt;

end;

{Сохранить}

procedure TForm1.N3Click(Sender: TObject);

begin

FillArrays; // сначала заполним массивы в соответсвии с таблицами

SaveInFiles; // теперь сохраним в файл

end;

{Поиск}

procedure TForm1.btnSearchClick(Sender: TObject);

var

myRect: TGridRect;

Grid: TStringGrid;

nCol,i,j:integer;

st:String;

begin

st:=txtSearch.Text; // строка для поиска

// определяем активную закладку

case PageControl1.ActivePageIndex of

0: begin Grid:= XDgrid; nCol:=7; end;

1: begin Grid:=WTKgrid; nCol:=10; end;

2: begin Grid:=BANKgrid; nCol:=5; end;

end;

myRect.Left := 11;

myRect.Top := 11;

myRect.Right := 11;

myRect.Bottom := 11;

Grid.Selection:= myRect;

if(st=' ') or (st='') then exit;

// поиск

for i:=1 to 10 do

for j:=0 to nCol-1 do

if Grid.Cells[j,i]=st then

begin

myRect.Left := j;

myRect.Top := i;

myRect.Right := j;

myRect.Bottom := i;

Grid.Selection := myRect;

exit;

end;

end;

{Заполнить таблицу незавершенных договоров в соответсвии с

XDgrid, WTKgrid, BANKgrid}

procedure TForm1.FillNDgrid;

var i,j,y,n:integer;

code:string;

st:string;

begin

j:=1;

for i:=1 to 10 do

if(XDGrid.Cells[5,i]='незавершен') then

begin

NDgrid.Cells[0,j]:=XDGrid.Cells[0,i];

NDgrid.Cells[1,j]:=XDGrid.Cells[1,i];

NDgrid.Cells[2,j]:=XDGrid.Cells[2,i];

NDgrid.Cells[3,j]:=XDGrid.Cells[3,i];

NDgrid.Cells[4,j]:=XDGrid.Cells[4,i];

// составим код договора

code:= NDgrid.Cells[0,j]+'/'+ NDgrid.Cells[1,j][9]+ NDgrid.Cells[1,j][10];

// найдем сколько человек состоит именно в этом ВТК

n:=0;

for y:=1 to 15 do

if(WTKgrid.Cells[4,y]=code) then inc(n);

str(n,st);

NDgrid.Cells[5,j]:=st;

inc(j);

end;

end;

{Обновить - обновить таблицу незавершенных договоров}

procedure TForm1.N4Click(Sender: TObject);

var i,j:integer;

begin

for i:=1 to 10 do

for j:=0 to 5 do

NDgrid.Cells[j,i]:='';

FillNDgrid;

end;

{Переключение флага редактирования}

procedure TForm1.CheckBox1Click(Sender: TObject);

var opt:TGridOptions;

begin

opt:=XDgrid.Options;

if CheckBox1.Checked=false then

begin

Include(opt,goRowSelect);

Exclude(opt,goEditing);

btnDel.Enabled := true;

end

else

begin

Exclude(opt,goRowSelect);

Include(opt,goEditing);

btnDel.Enabled := false;

end;

XDgrid.Options := opt;

WTKgrid.Options := opt;

BANKgrid.Options := opt;

end;

{Удалить}

procedure TForm1.btnDelClick(Sender: TObject);

var

myRect: TGridRect;

Grid: TStringGrid;

nCol,i,j:integer;

begin

// определяем активную закладку

case PageControl1.ActivePageIndex of

0: begin Grid:= XDgrid; nCol:=7; end;

1: begin Grid:=WTKgrid; nCol:=10; end;

2: begin Grid:=BANKgrid; nCol:=5; end;

end;

if(Grid.Row>0) and (Grid.Row<10) then

for i:=Grid.Row to 10 do

begin

for j:=0 to nCol-1 do

Grid.Cells[j,i]:=Grid.Cells[j,i+1];

end;

end;

{пирамидальная сортировка таблицы NDgrid по возростанию}

procedure TForm1.Sort;

var

l,r:word;

x,n,n1,n2,c,y:integer;

s:string;

sr:SRow;

procedure Sift;

label l3;

var i,j,y:word;

begin

i:=l;j:=2*i;s:=NDgrid.Cells[5,i];SaveRow(sr,i);

while j<=r do

begin

if j<r then

begin

Val(NDgrid.Cells[5,j],n1,c);

Val(NDgrid.Cells[5,j+1],n2,c);

if n1<n2 then j:=j+1;

end;

Val(s,n1,c);

Val(NDgrid.Cells[5,j],n2,c);

if n1>=n2 then goto l3;

for y:=0 to 5 do

NDgrid.Cells[y,i]:=NDgrid.Cells[y,j];

i:=j; j:=2*i;

end;

l3:

for y:=0 to 5 do

begin

NDgrid.Cells[y,i]:=sr[y];

end;

end; // Sift

begin

n:=0;

for y:=1 to 10 do

if (NDgrid.Cells[5,y]<>'') and (NDgrid.Cells[5,y]<>' ') then

inc(n);

l:=(n div 2)+1;r:=n;

while l>1 do

begin

l:=l-1; Sift;

end;

while r>1 do

begin

SaveRow(sr,1);

s:=NDgrid.Cells[5,1];

SweepRows(1,r);

r:=r-1; Sift;

end;

end; // Sort

{пирамидальная сортировка таблицы NDgrid по убыванию}

procedure TForm1.Sort2;

var

l,r:word;

x,n,n1,n2,c,y:integer;

s:string;

sr:SRow;

procedure Sift;

label l3;

var i,j,y:word;

begin

i:=l;j:=2*i;s:=NDgrid.Cells[5,i];SaveRow(sr,i);

while j<=r do

begin

if j<r then

begin

Val(NDgrid.Cells[5,j],n1,c);

Val(NDgrid.Cells[5,j+1],n2,c);

if n1>n2 then j:=j+1;

end;

Val(s,n1,c);

Val(NDgrid.Cells[5,j],n2,c);

if n1<=n2 then goto l3;

for y:=0 to 5 do

NDgrid.Cells[y,i]:=NDgrid.Cells[y,j];

i:=j; j:=2*i;

end;

l3:

for y:=0 to 5 do

begin

NDgrid.Cells[y,i]:=sr[y];

end;

end; // Sift

begin

n:=0;

for y:=1 to 10 do

if (NDgrid.Cells[5,y]<>'') and (NDgrid.Cells[5,y]<>' ') then

inc(n);

l:=(n div 2)+1;r:=n;

while l>1 do

begin

l:=l-1; Sift;

end;

while r>1 do

begin

SaveRow(sr,1);

s:=NDgrid.Cells[5,1];

SweepRows(1,r);

r:=r-1; Sift;

end;

end; // Sort2

{поменять местами строки r1 и r2 в таблице NDgrid}

procedure TForm1.SweepRows(r1,r2:word);

var s: array [0..5] of String[30];

i:integer;

begin

for i:=0 to 5 do

s[i]:=NDgrid.Cells[i,r1];

for i:=0 to 5 do

NDgrid.Cells[i,r1]:=NDgrid.Cells[i,r2];

for i:=0 to 5 do

NDgrid.Cells[i,r2]:=s[i];

end;

{сохранить строку номер r таблицы NDgrid в sr}

procedure TForm1.SaveRow(var sr:SRow;r:word);

var i:integer;

begin

for i:=0 to 5 do

sr[i]:=NDgrid.Cells[i,r];

end;

procedure TForm1.btnSort2Click(Sender: TObject);

begin

Sort;

end;

procedure TForm1.btnSort1Click(Sender: TObject);

begin

Sort2;

end;

end.

Страницы: 1, 2, 3