Информатика_всем
.pdf
9. Записной тип данных. СУБД |
245 |
{процедура вывода титульного листа} procedure TitulnyList;
begin clrScr;
textbackground(COLOR1);
textcolor(COLOR2);
clrScr;
GotoXY(14,2);
write('ВОЛГОГРАДСКИЙ ГОСУДАРСТВЕННЫЙ ТЕХНИЧЕСКИЙ УНИВЕРСИТЕТ');
GotoXY(24,4);
write('КАФЕДРА "ВЫЧИСЛИТЕЛЬНАЯ ТЕХНИКА"'); GotoXY(32,8);
write('СЕМЕСТРОВАЯ РАБОТА'); GotoXY(45,16);
write('ВЫПОЛНИЛ СТУДЕНТ ГРУППЫ: ',group); GotoXY(45,17);
write(NAME);
GotoXY(45,19); write('ПРОВЕРИЛ:'); GotoXY(45,20); write('ПЕТРОВ А.Р.'); GotoXY(33,24); write('ВОЛГОГРАД, 2007'); readKey;
end;
{процедура вывода заголовка при вводе записи} procedure IFF(var R:Trec);
var k:integer; c:char;
begin clrScr;
write(FLD[1],' (',OUTCOD,' - конец ввода): '); readln(r.f1);
end;
{процедура ввода даты}
procedure InputDate(var D:TDate); begin
writeLn; write('День: '); readln(D.d); write('Месяц: '); readln(D.m); write('Год: '); readln(D.y);
end;
246 9.3 Пример программы реализующей файлы записей
{процедура ввода записи} procedure InputRecord(var R:Trec); begin
write(FLD[2],': '); InputDate(R.f2); write(FLD[3],': '); readln(R.f3); write(FLD[4],': '); InputDate(R.f4); write(FLD[5],': '); readln(R.f5); write(FLD[6],': '); readln(R.f6); write(FLD[7],': '); readln(R.f7);
end;
{процедура, которая вызывает ввод записи и проверяет признак конца ввода}
procedure CF(var F:TDB); begin
IFF(R);
while R.f1<>OUTCOD do begin
InputRecord(R);
write(F,R);
IFF(R);
end;
end;
{процедура, которая создает файл и производит вызов процедуры его заполнения}
procedure VV(var F:TDB); begin
clrScr;
rewrite(F);
CF(F);
close(F);
end;
{процедура, вывода экземпляра записи} procedure PrintRecord(R:Trec);
begin clrScr;
writeLn(FLD[1],': ',r.f1);
writeLn(FLD[2],': ',r.f2.d,'.',r.f2.m,'.',r.f2.y); writeLn(FLD[3],': ',r.f3);
writeLn(FLD[4],': ',r.f4.d,'.',r.f4.m,'.',r.f4.y); writeLn(FLD[5],': ',r.f5);
9. Записной тип данных. СУБД |
247 |
writeLn(FLD[6],': ',r.f6); writeLn(FLD[7],': ',r.f7);
end;
{процедура печати базы} procedure PrintBase(var F:TDB); begin
reset(F);
while not eof(F) do begin
read(F,R);
PrintRecord(R);
readKey;
end;
close(F);
end;
{процедура добавления записи} procedure AddRecords(var F:TDB); begin
clrScr;
reset(F);
seek(F,Filesize(F));
CF(F);
close(F);
end;
{процедура удаления записи} procedure DeleteRecords(var F:TDB); var
I:Longint; begin
reset(F);
while not eof(F) do begin
read(F,R);
PrintRecord(R); writeLn('Удалить ? (1-Да)'); C:=readKey;
if C='1' then begin
I:=filepos(F)-1; While not eof(f) do
begin read(F,R);
seek(F,filepos(F)-2); write(F,R); seek(F,filepos(F)+1);
end;
248 9.3 Пример программы реализующей файлы записей
seek(F,filesize(F)-1); truncate(F); seek(F,I);
end;
end;
close(F);
end;
{процедура корректировки записи} procedure CorrectRecords(var F:TDB); begin
reset(F);
while not eof(F) do begin
read(F,R);
PrintRecord(R); writeLn('Корректировать ? (1-Да)'); C:=readKey;
If C='1' then begin
IFF(R);
InputRecord(R); seek(F,Filepos(F)-1); write(F,R);
end;
end;
close(F);
end;
{процедура выделения цветом пункта меню} procedure SetLineColor(NP,NS: Byte); begin
if NP=NS then begin
textbackground(COLOR2);
textcolor(COLOR1); end
else begin
textbackground(COLOR1);
textcolor(COLOR2); end
end;
9. Записной тип данных. СУБД |
249 |
{функция меню запроса} function MenuZ(X,Y:Byte):byte; var k:Byte;
begin k:=1; repeat
textbackground(COLOR1);
textcolor(COLOR2);
clrScr;
for i:=1 to NZ do begin
GotoXY(X,Y+i-1);
SetLineColor(k,i);
write(Z[i]);
end;
C:=readKey; case Ord(C) of
72:begin
if k=1 then k:=NZ else k:=k-1
end;
80:begin
if k=NZ then k:=1 else k:=k+1
end;
end;
until Ord(C)=13; MenuZ:=k;
end;
{логическая функция сравнения полей записи} function Logic(r,r1:TRec):boolean;
begin Logic:=(r.f2.y>r1.f2.y) OR
(
(r.f2.y=r1.f2.y) AND (r.f2.m>r1.f2.m) ) OR
(
(r.f2.y=r1.f2.y) AND (r.f2.m=r1.f2.m) AND(r.f2.d>r1.f2.d) );
end;
250 9.3 Пример программы реализующей файлы записей
{процедура сортировки файла с записями} procedure SortFile(var f:TDB);
var r1:Trec; l:boolean;
begin repeat
reset(f);
L:=true;
read(f,r);
while NOT EOF(f) do begin
read(f,r1);
if Logic(r,r1) then begin
seek(f,filepos(f)-2); write(f,r1); write(f,r); l:=false;
end else
r:=r1;
end; until L; end;
{процедура формирования нового файла} procedure Z1(var F:TDB);
var g:tdb; begin
clrScr;
reset(f);
assign(g,'g.db');
rewrite(g);
while not EOF(f) do begin
read(f,r);
write(g,r);
end;
SortFile(g);
PrintBase(g);
end;
9. Записной тип данных. СУБД |
251 |
{процедура запроса по родителям} procedure Z3(var F:TDB);
var s:string[70]; begin
clrScr;
write('Введите данные о родителях: '); readln(s);
writeLn;
reset(f);
While not eof(f) do begin
read(f,r);
if r.f6=s then begin PrintRecord(R); readKey;
end;
end;
close(F)
end;
{процедура запроса по дате регистрации} procedure Z2(var F:TDB);
var s:TDate; begin
clrScr;
write('Введите дату регистрации: '); InputDate(s);
writeLn;
reset(f);
while not eof(f) do begin
read(f,r);
if (r.f4.d=s.d) and (r.f4.m=s.m) and (r.f4.y=s.y) then begin
PrintRecord(R);
readKey;
end;
end;
close(F);
end;
252 9.3 Пример программы реализующей файлы записей
{процедура для работы с вложенным меню} procedure Z0(var F:TDB);
var x,y,ml:integer; begin
ml:=length(z[1]); for i:=1 to NZ do
if length(z[i])>ml then ml:=length(z[i]);
y:=((MX-NZ) div 2) + 1; x:=((MY-ml) div 2) + 1; repeat
D:=MenuZ(x,y); case D of
1:z1(F);
2:z2(F);
3:z3(f);
end;
until D=NZ; end;
{функция вывода главного меню} function Menu(X,Y:Byte):byte; var k:Byte;
begin k:=1; repeat
textbackground(COLOR1);
textcolor(COLOR2);
clrScr;
for I:=1 to NM do begin
GotoXY(X,Y+I-1);
SetLineColor(k,I);
write(M[I]);
end;
C:=readKey; case Ord(C) of
72:begin
if k=1 then k:=NM else k:=k-1;
end;
80:begin
if k=NM then k:=1 else k:=k+1;
end end;
until Ord(C)=13; Menu:=k;
end;
