program Medicine_database; uses crt, graph; type Lekarstva=record name: string [20]; year: integer; vipusk: string; bolesn: string; end; var otv:byte; const Shapka = 'Title Year of release Form of release Sickness'; procedure Image; var gd, gm : integer; y : integer; begin gd := 0; initgraph(gd,gm,'..\bgi'); SetColor(white); OutTextXY(180,450,'To start the programm press ENTER'); rectangle(265,80,325,350); rectangle(290,350,300,400); SetColor(black); line(291,350,299,350); SetColor(white); for y := 100 to 340 do begin if y/4=int(y/4) then line(289,y,301,y); if y/20=int(y/20) then line(285,y,305,y); end; SetColor(red); rectangle(293,395,297,90); {} SetFillStyle(1,black); FloodFill(296,91,red); SetColor(white); OutTextXY(307,337,'35'); OutTextXY(270,337-40,'36'); OutTextXY(307,337-80,'37'); OutTextXY(270,337-120,'38'); OutTextXY(307,337-160,'39'); OutTextXY(270,337-200,'40'); OutTextXY(307,337-240,'41'); SetTextStyle(DefaultFont, HorizDir, 2); OutTextXY(230,20,'Medicine'); repeat SetColor(red); SetFillStyle(1,red); for y := 300 downto 150 do begin rectangle(294,394,296,y); floodfill(295,393,red); delay(300); end; SetFillStyle(1,black); SetColor(black); for y := 150 to 300 do begin rectangle(296,91,294,y); floodfill(295,90,red); delay(300); end; until keypressed; readln; CloseGraph; end; procedure Vivod(viv : Lekarstva); begin writeln(viv.name:15,viv.year:12,viv.vipusk:16,viv.bolesn:35); end; procedure create; var f: file of Lekarstva; s: Lekarstva; b: integer; begin clrscr; assign (f,'c:\lekarstva.dat'); rewrite (f); repeat write ('Enter title of medicine '); readln (s.name); write ('Enter year of release '); readln (s.year); write ('Enter form of release '); readln (s.vipusk); write ('Enter sickness '); readln (s.bolesn); write (f,s); write ('Continue? (1-yes, 2-no) '); readln (b); until b=2; close (f); end; procedure add; var f,f1: file of Lekarstva; s: Lekarstva; begin clrscr; assign (f,'c:\lekarstva.dat'); reset (f); assign (f1,'c:\tempr.dat'); rewrite (f1); while not (eof(f)) do begin read (f,s); write (f1,s); end; write ('Enter title of medicine '); readln (s.name); write ('Enter year of release '); readln (s.year); write ('Enter form of release '); readln (s.vipusk); write ('Enter sickness '); readln (s.bolesn); write (f1,s); close (f); erase (f); close (f1); assign(f1,'c:\tempr.dat'); reset(f1); rename (f1,'c:\lekarstva.dat'); close (f1); write ('Done! '); repeat until keypressed; end; procedure view; var viv : Lekarstva; f: file of Lekarstva; begin clrscr; assign (f,'c:\lekarstva.dat'); reset(f); writeln(Shapka); while not EOF(f) do begin read(f,viv); vivod(viv); end; writeln('To return to main menu press Enter'); readln; Close(f); end; procedure find; var a : string [20]; f : file of Lekarstva; s : Lekarstva; i,j : integer; p : boolean; begin clrscr; assign (f, 'c:\Lekarstva.dat'); reset (f); write ('Enter title of medicine you want to find'); readln (a); p:=false; writeln(Shapka); while (not (eof(f))) do begin read (f,s); if s.name=a then begin for i:=length(s.name) to 20 do s.name:=s.name + ' '; for i:=(s.year) to 20 do s.year:=s.year; for i:=length(s.vipusk) to 20 do s.vipusk:=s.vipusk + ' '; for i:=length(s.bolesn) to 20 do s.bolesn:=s.bolesn + ' '; j:=j+1; writeln (s.name,s.year,' ' ,s.vipusk,s.bolesn); p:=true; end; end; if p=false then write ('Results not found!'); repeat until keypressed; end; procedure edit; var s,t: Lekarstva; f,f1: file of Lekarstva; otv: string; begin clrscr; assign (f,'c:\Lekarstva.dat'); reset (f); assign (f1,'c:\tempr.dat'); rewrite (f1); writeln ('Enter title of medicine you want to correct'); readln (otv); while not(eof(f)) do begin read (f,s); if s.name=otv then begin write ('Enter title of medicine '); readln (s.name); write ('Enter year of release '); readln (s.year); write ('Enter form of release '); readln (s.vipusk); write ('Enter sickness '); readln (s.bolesn); end; write(f1,s); end; close (f); erase (f); close(f1); assign(f1,'c:\tempr.dat'); reset(f1); rename (f1,'c:\Lekarstva.dat'); close (f1); write ('Done. To return to main menu press Enter'); repeat until keypressed; end; procedure sort; var f,f1: file of Lekarstva; s,t,p: Lekarstva; log: boolean; k,i,j,n: integer; a: array [1..10] of Lekarstva ; z: string; b: integer; begin clrscr; assign (f,'c:\Lekarstva.dat'); reset (f); n:=filesize(f); i:=0; while not eof(f) do begin read (f,s); a[i]:=s; i:=i+1; end; repeat log:=true; for i:=0 to n-2 do if (a[i].year)>(a[i+1].year) then begin b:=a[i].year; a[i].year:=a[i+1].year; a[i+1].year:=b; z:=a[i].name; a[i].name:=a[i+1].name; a[i+1].name:=z; z:=a[i].vipusk; a[i].vipusk:=a[i+1].vipusk; a[i+1].vipusk:=z; z:=a[i].bolesn; a[i].bolesn:=a[i+1].bolesn; a[i+1].bolesn:=z; log:=false end; until log; clrscr; writeln (Shapka); for i:=0 to n-1 do begin for j:=length(a[i].name) to 20 do a[i].name:=a[i].name + ' '; writeln (':',a[i].name,':',a[i].year,':',a[i].vipusk,' :',a[i].bolesn); end; close (f); repeat until keypressed; end; begin Image; TextColor(white); repeat clrscr; writeln ('Choose procedure (1-8)'); writeln ('1 - Create Database'); writeln ('2 - Add Data'); writeln ('3 - List Database'); writeln ('4 - Search'); writeln ('5 - Correction'); writeln ('6 - Sort by year'); writeln ('7 - Search min & max'); writeln ('8 - Exit'); readln (otv); if otv=1 then create; if otv=2 then add; if otv=3 then view; if otv=4 then find; if otv=5 then edit; if otv=6 then sort; if otv=7 then ; until otv=8; end.