Содержание
1.            Задание

2.            Блок схема

3.            Листинг исходного файла программы

4.            Снимки с экрана при работе программы




1. Задание
Написать программу упорядочивания элементов файлов.

1)                Описать запись с именем Bill, содержащую следующие поля:

- расчётный счёт плательщика;

- расчётный счёт получателя;

- перечисляемая сумма в рублях.

2) Написать программу, выполняющую следующие действий:

- ввод данных с клавиатуры в массив, состоящий из 8 элементов типа Bill; записи должны быть упорядочены в алфавитном порядке по расчетным счетам плательщиков;

- вывод на экран информации о сумме снятой с расчётного счёта плательщика, введённого с клавиатуры; если такого расчётного счёта нет, вывести на экран соответствующие сообщение;

- запись массива в файл под заданным с клавиатуры именем.
2. Блок схема


Рис 1. Блок-схема алгоритма основной программы




Рис2. Блок-схема процедуры ввода данных в список


Рис 3. Блок-схема процедуры вывода данных из списка на дисплей






Рис4. Блок-схема процедуры ввода данных в список из файла записей


Рис5. Блок-схема процедуры поиска данных в списке






Рис 6. Блок-схема процедуры записи данных списка в файл
Листинг исходного файла программы
program Prog1;

uses

Crt;

const

MaxRecCount = 8;

type

TBill = record

ChetPlatel: string [30];

ChetPoluch: string [30];

SummaPlateja: real;

end;

TRecArr = array [1..MaxRecCount] of TBill;

var

RecArr: TRecArr;

Bill: TBill;

RecCount: integer;

FileName: string [15];

c: char;

procedure RecArrInit(var RecArr: TRecArr);

var

i: integer;

begin

for i:= 1 to MaxRecCount do

begin

RecArr[i].ChetPlatel:= '';

RecArr[i].ChetPoluch:= '';

RecArr[i].SummaPlateja:= 0

end

end;

function FillRecArr(var RecArr: TRecArr): integer;

var

i, n: integer;

c: char;

begin

FillRecArr:= 0;

i:= 0;

while i < MaxRecCount do

begin

c:= #0;

WriteLn('Do you want insert new record in list?(y/n)');

c:= ReadKey;

if (c in ['n', 'N', #27]) then Break;

ClrScr;

Inc(i);

Write('Please get Pay #', i, ' :');

ReadLn(RecArr[i].ChetPlatel);

Write('Please get Dest #', i, ' :');

ReadLn(RecArr[i].ChetPoluch);

repeat

Write('Please get summ :');

{$I-}

ReadLn(RecArr[i].SummaPlateja);

{$I+}

n:= IOResult;

if n <> 0 then

WriteLn('The summ is fault.Try again.');

until n = 0;

ClrScr

end;

FillRecArr:= i;

end;

procedure PrintRecArr(RecArr: TRecArr);

var

i: integer;

begin

ClrScr;

for i:= 1 to MaxRecCount do

if RecArr[i].ChetPlatel <> '' then

begin

WriteLn('Pay #', i, ' : ', RecArr[i].ChetPlatel);

WriteLn('Dest #', i, ' : ', RecArr[i].ChetPoluch);

WriteLn('Pay summ', i, ' : ', RecArr[i].SummaPlateja:8:2);

WriteLn('--------------------------');

end

end;

procedure FindInRecArr(RecArr: TRecArr);

var

i: integer;

isFind: boolean;

s: string [30];

summ: real;

begin

isFind:= false;

summ:= 0;

ClrScr;

Write('Get payment num(q for quit):');

ReadLn(s);

if s = 'q' then Exit;

for i:= 1 to MaxRecCount do

if Pos(RecArr[i].ChetPlatel, s) <> 0 then

begin

summ:= summ + RecArr[i].SummaPlateja;

isFind:= true

end;

if not isFind then

begin

WriteLn('Current record not found. Try again.');

ReadLn;

FindInRecArr(RecArr)

end;

WriteLn('Summa = ',summ:8:2)

end;

procedure SortRecArr(var RecArr: TRecArr);

var

i, j: integer;

TmpRec: TBill;
begin

for i:= 1 to MaxRecCount do

for j:= 1 to MaxRecCount - 1 do

if RecArr[j].ChetPlatel[1] > RecArr[j + 1].ChetPlatel[1] then

begin

TmpRec:= RecArr[j];

RecArr[j]:= RecArr[j + 1];

RecArr[j + 1]:= TmpRec

end

end;

function RecArrSaveToFile(FileName: string; RecArr: TRecArr): integer;

var

TmpFile: file of TBill;

i, n: integer;

begin

RecArrSaveToFile:= 0;

Assign(TmpFile, FileName);

{$I-}

Rewrite(TmpFile);

{$I+}

if IOResult <> 0 then

begin

WriteLn('File ', FileName, ' create error.');

Exit

end;

n:= 0;

for i:= 1 to MaxRecCount do

if RecArr[i].ChetPlatel <> '' then

begin

Inc(n);

Write(TmpFile, RecArr[i])

end;

Close(TmpFile);

RecArrSaveToFile:= n

end;

function RecArrLoadFromFile(FileName:string; var RecArr: TRecArr): integer;

var

TmpFile: file of TBill;

i: integer;

begin

RecArrLoadFromFile:= 0;

Assign(TmpFile, FileName);

{$I-}

Reset(TmpFile);

{$I+}

if IOResult <> 0 then

begin

WriteLn('File ', FileName, ' open error.');

Exit

end;

i:= 1;

Seek(TmpFile, 0);

while (not Eof(TmpFile)) and (i <= MaxRecCount) do

begin

Read(TmpFile, RecArr[i]);

Inc(i)

end;

Close(TmpFile);

RecArrLoadFromFile:= i

end;

function ViewMenu: char;

var

c: char;

begin

ViewMenu:= '0';

ClrScr;

WriteLn;

WriteLn;

WriteLn('_________________________________');

WriteLn('| Menu |');

WriteLn('---------------------------------');

WriteLn('| 1. Input records to list |');

WriteLn('| |');

WriteLn('| 2. Load list from file |');

WriteLn('| |');

WriteLn('| 3. Find need records in list |');

WriteLn('| |');

WriteLn('| 4. Save list to file |');

WriteLn('| |');

WriteLn('| 5. Print list |');

WriteLn('| |');

WriteLn('| 6. Quit |');

WriteLn('---------------------------------');

repeat

c:= ReadKey;

until (c in ['1', '2','3', '4', '5', '6', #27]) ;

ViewMenu:= c

end;

begin

c:= #0;

RecCount:= 0;

FileName:= '';

ClrScr;

Window(23,15,75,30);

while true do

begin

c:= ViewMenu;

ClrScr;

case c of

'1': begin

RecArrInit(RecArr);

RecCount:= FillRecArr(RecArr);

SortRecArr(RecArr);

WriteLn('Input ', RecCount, ' records in list.')

end;

'2': begin

Write('Get file name :');

ReadLn(FileName);

FileName:= '.\' + FileName;

RecArrInit(RecArr);

RecCount:= RecArrLoadFromFile(FileName, RecArr);

WriteLn('Load ', RecCount, ' records in list.')

end;

'3': begin

if RecCount > 0 then

FindInRecArr(RecArr)

else

WriteLn('List is empty.')

end;

'4': begin

if RecCount > 0 then

begin

Write('Input file name :');

ReadLn(FileName);

FileName:= '.\' + FileName;

RecCount:= RecArrSaveToFile(FileName, RecArr);

WriteLn('Save ', RecCount, ' records from file ', FileName, '.')

end

else

WriteLn('List is empty.')

end;

'5': begin

if RecCount > 0 then

PrintRecArr(RecArr)

else

WriteLn('List is empty.')

end;

'6', #27: Break;

end;

WriteLn;

WriteLn('Please press any key and go to menu>');

repeat until KeyPressed

end;

end.


Снимки с экрана при работе программы


Рис 7. Главное меню программы


Рис 8. Запрос на добавление нового элемента в список


Рис 9. Окно ввода значений в элемент списка




Рис 10. Запрос на ввод имени файла для загрузки данных в список


Рис 11. Окно вывода элементов списка


Рис 12. Окно поиска элемента списка по значению его поля




Рис 13. Сообщение об отсутствии искомого элемента в списке


Рис 14. Запись списка в файл