1: input_baza(l,baza);
2: Delete(l,baza);
3: begin
Clrscr;
output_baza(l,baza);
end;
4: begin
search(l,baza,Pole,klFind, masFind);
clrscr;
WriteLn('результат поиска ',Pole,':');
output_baza(klFind,masFind)
end;
5: begin
dispose(baza);
dispose(masFind);
exit
end;
end;
until false;
end.
program lab3;
uses crt;
const
n=10;
k=5;
a:array[1..k] of string=(
'добавить запись',
'удалить запись',
'вывести запись',
'поиск',
'выход');
type
bazarec=record
tabnom:string[20];
month:string[20];
vidnach:string[20];
sum:real;
nalog:real;
nomotd:integer;
end;
bazarecs=array[1..n] of bazarec;
dinbazarecs=^bazarecs;
var
baza,masFind:dinbazarecs;
choose,klFind,l:byte;
Pole:string;
procedure Menu(n,LeftX,LeftY,RightX,RightY:byte; a:array of string; var result:byte);
var
i,nowPoz:byte;
choose:boolean;
answer:char;
begin
nowPoz:=0;
choose:=false;
window(LeftX,LeftY,RightX,RightY);
Repeat
clrscr;
For i:=0 to n-1 do
if i=nowPoz then
begin
textattr:=$09;
WriteLn(chr(16),' ',a[i],' ':(17-length(a[i])),chr(17));
end
else
begin
textAttr:=$07;
WriteLn(' ',a[i]);
end;
answer:=readkey;
Case answer of
#80{Down} :If nowPoz<n-1 then
nowPoz:=nowPoz+1
Else
nowPoz:=0;
#72{Up} :If nowPoz>0 then
nowPoz:=nowPoz-1
Else
nowPoz:=n-1;
#13{Enter}:begin
result:=nowPoz+1;
choose:=true
end;
end;
Until choose;
textattr:=$07;
clrscr;
window(1,1,80,25);
end;
procedure input_baza (var n:byte;var list:dinbazarecs);
var
i,j:integer;
f:boolean;
begin
clrscr;
WriteLn('ввод записей:');
Write('сколько записей ввести: ');
f:=false;
Repeat
{$I-}
ReadLn(i);
if (ioresult=0) and (i>0) then
f:=true
else
begin
WriteLn('неверный ввод ');
readkey;
gotoxy(1,3);
clreol;
gotoxy(35,2);
clreol;
end;
{$I+}
Until f;
For j:=n+1 to n+i do
With list^[j] do
begin
WriteLn('запись №',j,': ');
Write(' введи табельний номер: ');
Readln(tabnom);
Write(' введи месяц: ');
Readln(month);
Write(' введи вид начисления: ');
Readln(vidnach);
Write(' введи сумму: ');
Readln(sum);
Write(' введи налоги: ');
Readln(nalog);
Write(' введи номер отдела: ');
Readln(nomotd);
end;
n:=j;
end;
procedure output_baza(n:byte; var list:dinbazarecs);
var
i:byte;
begin
if l=0 then
begin
WriteLn('сначала введи запись');
readkey;
exit;
end;
for i:= 1 to n do
with list^[i] do
begin
writeln ('╔══════════════╤════════════════════╗');
writeln ('║табел-ый номер│ ',tabnom:18,' ║');
writeln ('║месяц │ ',month:18,' ║');
writeln ('║вид начисления│ ',vidnach:18,' ║');
writeln ('║сумма │ ',sum:18:2,' ║');
writeln ('║налоги │ ',nalog:18:2,' ║');
writeln ('║номер отдела │ ',nomotd:18,' ║');
writeln ('╚══════════════╧════════════════════╝');
readln;
clrscr;
end;
end;
procedure Delete(var n:byte;var list:dinbazarecs);
var
i,j:byte;
f:char;
begin
clrscr;
if l=0 then
begin
WriteLn('сначала надо ввести запись');
readkey;
exit;
end;
Write('введи номер записи для удаления: ');
ReadLn(j);
with list^[j] do
begin
writeln ('╔══════════════╤════════════════════╗');
writeln ('║табел-ый номер│ ',tabnom:18,' ║');
writeln ('║месяц │ ',month:18,' ║');
writeln ('║вид начисления│ ',vidnach:18,' ║');
writeln ('║сумма │ ',sum:18:2,' ║');
writeln ('║налоги │ ',nalog:18:2,' ║');
writeln ('║номер отдела │ ',nomotd:18,' ║');
writeln ('╚══════════════╧════════════════════╝');
readln;
end;
Writeln('удалить запись? (y/n): ');
Readln(f);
if f<>'y' then exit;
if (j>n) or (j<1) then
begin
WriteLn('неправильный номер');
readkey;
exit;
end;
if (j=n) then
begin
WriteLn('запись',j,' удалена');
readkey;
dec(n);
exit;
end;
For i:=j to n-1 do
list^[i]:=list^[i+1];
WriteLn('запись ',j,' удалена');
readkey;
dec(n);
end;
procedure search(n:byte;list:dinbazarecs;var Pole:string;var k:byte;var masFind:dinbazarecs);
const
z=1;
Men:array[1..z] of string=('name');
var
i,t:byte;
srchrec:string[20];
begin
clrscr;
if l=0 then
begin
WriteLn('сначала введи запись');
readkey;
exit;
end;
Write('введи табельный номер записи для поиска ');
ReadLn(srchrec);
k:=0;
t:=0;
For i:=1 to n do
begin
if list^[i].tabnom=srchrec then
begin
inc(k);
with masFind^[k] do
begin
tabnom:=list^[i].tabnom;
month:=list^[i].month;
vidnach:=list^[i].vidnach;
sum:=list^[i].sum;
nalog:=list^[i].nalog;
nomotd:=list^[i].nomotd;
inc(t);
end;
end;
end;
if t=0 then begin
writeln('нет такой записи ');
readkey;
end;
end;
begin
new(baza);
new(masFind);
l:=0;
Repeat
clrscr;
Menu(k,1,WhereY+1,25,WhereY+1+k,a,choose);
Case choose of
1: input_baza(l,baza);
2: Delete(l,baza);
3: begin
Clrscr;
output_baza(l,baza);
end;
4: begin
search(l,baza,Pole,klFind, masFind);
clrscr;
WriteLn('результат поиска ',Pole,':');
output_baza(klFind,masFind)
end;
5: begin
dispose(baza);
dispose(masFind);
exit
end;
end;
until false;
end.
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.