ВУЗ: Не указан

Категория: Не указан

Дисциплина: Не указана

Добавлен: 19.09.2024

Просмотров: 24

Скачиваний: 0

ВНИМАНИЕ! Если данный файл нарушает Ваши авторские права, то обязательно сообщите нам.

begin

assign(f1,'bolnica2.dat');

reset(f); rewrite(f1);

for i:=1 to filesize(f) do

begin

read(f,z);

if filepos(f)<>k then write(f1,z);

end;

close(f1); close(f);

erase(f); rename(f1,'bolnica.dat');

write('Zapis udalena');

end;

readkey;

end;

procedure Redakt;

begin

clrscr;

k:=1;

reset(f);

while not (eof(f)) do

begin

read(f,z);

write(k,'.');

gotoxy(5,wherey); write(z.s);

gotoxy(15,wherey); write(z.n);

gotoxy(25,wherey); write(z.diag);

gotoxy(35, wherey); write(z.doctor);

gotoxy(46,wherey); write(z.day);

gotoxy(48,wherey); write('.',z.month);

gotoxy(51,wherey); write('.',z.year);

writeln;

k:=k+1;

end;

close(f);

reset(f);

writeln('Vvedite nomer zapisi'); readln(k);

if k>filesize(f) then write('Takoy zapisi net!')

else

begin

seek(f,k-1);

writeln('Vvedite dannie ',k,' bolnogo');

write('Vvedite familiju: '); readln(z.s);

write('Vvedite imia: '); readln(z.n);

write('Vvedite diagnoz: '); readln(z.diag);

write('Vvedite familiju lechashego vracha: '); readln(z.doctor);

writeln('Vvedite datu naveshenia vracha: ');

write('Den(1-30): '); readln(z.day);

write('Mesyac(1-12): '); readln(z.month);

write('God(2000-2012): '); readln(z.year);

write(f,z);

k:=k+1;

write('Zapis izmenena!');

end;

readkey;

close(f);

end;

procedure Poisk1;

begin

clrscr;

write('Vvedite familiu bolnogo: '); readln(fam);

x:=0;

reset(f);

writeln;

while not eof(f) do

begin

read(f,z);

if fam=z.s then x:=x+1

end;

close(f);

reset(f);

if x=0 then writeln('Takogo bolnogo net!')

else

begin

writeln('Poisk bolnogo ',fam);

while not (eof(f)) do

begin

read(f,z);

if fam=z.s then

begin

write(z.s);

gotoxy(15,wherey); write(z.doctor);

gotoxy(27,wherey); write(z.diag);

gotoxy(42,wherey); write(z.day);

gotoxy(43,wherey); write('.',z.month);

gotoxy(45,wherey); write('.',z.year);

writeln;

end;

end;

end;

readkey;

close(f);

end;

procedure Poisk2;

begin

clrscr;

write('Vvedite familiu vracha: '); readln(docfam);

q:=0;

reset(f);

writeln;

while not eof(f) do

begin

read(f,z);

if docfam=z.doctor then q:=q+1

end;

close(f);

reset(f);

if q=0 then write('U takogo vracha netu bolnih v kartoteke')

else

writeln('U vracha ',docfam,' ',q,' bolnih');


readkey;

close(f);

end;

end.


Додаток в (обов’язковий) Лістинг модуля gr.

unit gr;

interface

uses graph,crt;

var Gd,Gm,i: integer;

procedure open1;

procedure close1;

implementation

procedure open1;

begin

Gd:=Detect;

initgraph(Gd, Gm, '');

setbkcolor(blue);

setcolor(yellow);

rectangle(10,10,630,470);

rectangle (15,15,625,465);

setcolor(yellow);

outtextxy(17,17,'Denis Visocky, 4 variant.');

settextstyle(1,0,5);

outtextxy(150,150,'Zdrastvuite!');

settextstyle(1,0,2);

outtextxy(150,260,'Dlya raboti v programme');

outtextxy(150,300,'najmite >Enter<.');

readkey;

closegraph;

end;

procedure close1;

begin

Gd:=Detect;

initgraph(Gd, Gm, '');

setbkcolor(blue);

setcolor(yellow);

rectangle(10,10,630,470);

rectangle (15,15,625,465);

settextstyle(1,0,3);

outtextxy(150,160,'Programma zavershena!!!');

settextstyle(1,0,2);

outtextxy(150,280,'Dlya vihoda najmite enter.');

readkey;

closegraph;

end;

end.