Данный алгоритм содержит в себе главные основы в паскале, как работать с файлами, использование разного типа переменных, использование меню.

Код »

program myprg;
uses crt;
type user=record
number:string;
percode:string;
fname:string;
lname:String;
adress:string;
diag:string;
end;
{--}
const
dBase='database.dat';
var
i,z,m,en:integer;
answ,answ1:char;
s,r:string;
f:text;
users:array[1..10] of user;
{-----}
procedure checkData;
begin
assign(f,dBase);
{$I-}reset(f);{$I+}
if IoResult<>0 then rewrite(f);
close(f);
end;
{-----}
procedure add;
begin
assign(f,dBase);
append(f);
clrscr;
writeln('Pievienot pie saraksta jaunus pacientus');
writeln('');
for i:=1 to 3 do
begin
 writeln('Informacija par paciantu (',i,'/3):');
 write('Numuru(ID):');
 readln(users[i].number);
 writeln(f,users[i].number);
 write('Personas kods:');
 readln(users[i].percode);
 writeln(f,users[i].percode);
 write('Vards:');
 readln(users[i].fname);
 writeln(f,users[i].fname);
 write('Uzvards:');
 readln(users[i].lname);
 writeln(f,users[i].lname);
 write('Adrese:');
 readln(users[i].adress);
 writeln(f,users[i].adress);
 write('Slimiba:');
 readln(users[i].diag);
 writeln(f,users[i].diag);
 writeln(f,'==NEXT==');
 if(i<3) then
 begin
 writeln('');
 write('Pievienot informaciju par citu pacientu? Izvele(y/n):');
 readln(answ);
 if(answ='n') then break;
 end
 else
 begin
 writeln('');
 writeln('***********************************************************');
 writeln('*Atvainojiet, viena reizi var pievienot tikai 3 pierakstus*');
 writeln('***********************************************************');
 writeln('');
 end;
end;
close(f);
writeln('');
end;
{-----}
procedure search;
begin
clrscr;
writeln('Pacientu meklesana');
writeln('');
write('Ievadiet klienta numuru:');
readln(s);
writeln('');
assign(f,dBase);
reset(f);
i:=0;
en:=0;
repeat
inc(i);
readln(f,r);
if(i=1) and (r=s) then en:=1;
if(i=1) and (en=1) then writeln('Clienta numurs (ID):',r);
if(i=2) and (en=1) then writeln('Personas code:',r);
if(i=3) and (en=1) then writeln('Vards:',r);
if(i=4) and (en=1) then writeln('Uzvards:',r);
if(i=5) and (en=1) then writeln('Adress:',r);
if(i=6) and (en=1) then writeln('Diagnoss:',r);
if(r='==NEXT==') then begin i:=0; if en=1 then break; end;
until eof(f);
writeln('');
writeln('');
close(f);
if(en=0) then writeln('Atvainojiet, pacientu ar tadu numuru nav');
writeln('');
writeln('');
write('Meklet citu pacientu?(y/n):');
readln(answ);
if(answ='y') then search;

end;
{-----}
procedure exit;
begin
while (answ1<>'n') and (answ1<>'y') do
begin
write('Iziet no programmas? Izvele(y/n):');
readln(answ1);
end;
end;
{-----}
procedure viewAll;
begin
clrscr;
writeln('Parskats par pacientiem:');
writeln('');
assign(f,dBase);
reset(f);
i:=0;
en:=0;
while eof(f)=false do begin
inc(i);
readln(f,r);
en:=1;
if(i=1) then writeln('Pacienta numurs (ID):',r);
if(i=2) then writeln('Personas code:',r);
if(i=3) then writeln('Vards:',r);
if(i=4) then writeln('Uzvards:',r);
if(i=5) then writeln('Adress:',r);
if(i=6) then writeln('Diagnoss:',r);
if(r='==NEXT==') then begin i:=0;writeln('');writeln('   ***   ');writeln(''); end;
end;
writeln('');
close(f);
if(en=0) then writeln('Nav informacijas');
writeln('');
end;
{-----}
procedure clearData;
begin
clrscr;
writeln('Visu datu dzesana');
writeln('');
write('Dzest visu informaciju? (y/n):');
readln(answ);
writeln('');
if(answ='y') then
begin
assign(f,dBase);
rewrite(f);
close(f);
writeln('Visa informacija tika dzesta!');
end;
writeln('');
writeln('');
end;
{-----}
procedure menu;
begin
answ1:='0';
clrscr;
checkData;
writeln('Menu:');
writeln('1.Pievienot jaunu lietotaju');
writeln('2.Parskatit visus pacientus');
writeln('3.Meklet paciantu');
writeln('4.Dzest visu informaciju');
writeln('5.Iziet');
write('Jusu izvele:');
readln(m);
if(m<>1) and (m<>2) and (m<>3) and (m<>4) and (m<>5) then menu;
case m of
1:add;
2:viewAll;
3:search;
4:clearData;
end;
 if(m<>5) then begin
 writeln('');
 write('Pariet pie galvena satura? Izvele(y/n):');
 readln(answ);
 if(answ='y') then menu;
 end;
 writeln('');
 writeln('');
 exit;
 if answ1='n' then menu;

end;
{-----}
begin
menu;
{readln;  }
end.

Автор: LLIypuk

Добавить комментарий