Содержание
1. Задание
2. Блок схема
3. Листинг исходного файла программы
4. Снимки с экрана при работе программы
1. Задание
Написать программу упорядочивания элементов файлов.
1) Описать запись с именем Bill, содержащую следующие поля:
- расчётный счёт плательщика;
- расчётный счёт получателя;
- перечисляемая сумма в рублях.
2) Написать программу, выполняющую следующие действий:
- ввод данных с клавиатуры в массив, состоящий из 8 элементов типа Bill; записи должны быть упорядочены в алфавитном порядке по расчетным счетам плательщиков;
- вывод на экран информации о сумме снятой с расчётного счёта плательщика, введённого с клавиатуры; если такого расчётного счёта нет, вывести на экран соответствующие сообщение;
- запись массива в файл под заданным с клавиатуры именем.
2. Блок схема
Рис 1. Блок-схема алгоритма основной программы
Рис2. Блок-схема процедуры ввода данных в список
Рис 3. Блок-схема процедуры вывода данных из списка на дисплей
Рис4. Блок-схема процедуры ввода данных в список из файла записей
Рис5. Блок-схема процедуры поиска данных в списке
Рис6. Блок-схема процедуры записи данных списка в файл
Листинг исходного файла программы
programProg1;
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
begi
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. Запись списка в файл