Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted by Kail ( 19 years ago )
Program Lab1;
uses CRT, Graph;
Label Menu;
type MyType=array[1..320] of real; MyType2=array[1..6] of string;
MyType3=array[1..3] of integer;
var YMin,YMax:real; arrayX,arrayY:MyType; tochki:string; MenuText:MyType2;
NMenu, Fon, Sim, Rim,i,kod1,kod2:Integer; Colors:MyType3; f:text;
procedure showmenu1;
var i,a:integer;
begin
for i:=0 to 20 do begin
if i mod 4=0 then tochki:='';
clrscr;
WriteLn;
WriteLn(' ЪДДДДДДДДДДДДДДДДДДДДДДДДДДДДДї');
WriteLn(' Г Shershnev Mihail 311 var#23 ґ');
WriteLn(' ГДДДДДДДДДДДДДДДДДДДДДДДДДДДДДґ');
WriteLn(' Г Laboratornaya # 1 ґ');
WriteLn(' АДДДДДДДДДДДДДДДДДДДДДДДДДДДДДЩ ');
WriteLn;
WriteLn;
Writeln(' Idet zagruzka',tochki);
WriteLn(' Ostalos ',10-(i/2):1:0,' sekund' );
for a:=1 to 3 do delay(25000);
tochki:=tochki+'.';
end;
end;
procedure Zast(var x0,y0,r,x1,x,y:Integer);
begin
Circle(x0,y0,Round(1.5*r));
Circle(x0,y0,2+Round(1.5*r));
Circle(x0,y0,3);
Circle(x,y,3);
Circle(x1,y0,3);
Line(300,150,500,150);
Line(300,250,500,250);
Line(300,152,500,152);
Line(300,252,500,252);
Bar(x1,150,x1+10,250);
Bar(x1+10,195,500,205);
MoveTo(x0,y0);
LineTo(x,y);
LineTo(x1,y0);
end;
procedure Zastavka;
var a,i,x,y,x0,y0,x1,x10,r:Integer; GD,GM:Integer;
begin
GD:=Detect; GM:=2;
InitGraph(GD,GM,'');
SetBkColor(6); ClearDevice;
x0:=200; y0:=200; r:=30;
x10:=400;
OutTextXY(230,80,'Shershnev Mishail');
OutTextXY(230,100,'Gruppa 311 var#23');
for i:=1 to 3600 do
begin
x:=x0+Round(cos(i/25)*R);
y:=y0+Round(Sin(i/25)*R);
x1:=x10+x-x0;
SetFillStyle(2,4);
SetColor(4);
Zast(x0,y0,r,x1,x,y);
for a:=1 to 10 do delay(50);
SetFillStyle(2,6);
SetColor(6);
Zast(x0,y0,r,x1,x,y);
end;
CloseGraph;
end;
procedure Tab(var arrayX,arrayY:MyType);
var xn,xk,dx,xA,xB:real; i:integer;
begin
WriteLn;
Write(' Vvedite x-nachalnoe: '); ReadLn(xn);
Write(' Vvedite x-konechnoe: '); ReadLn(xk);
Write(' Vvedite koeficient A: '); ReadLn(xA);
Write(' Vvedite koeficient B: '); ReadLn(xB);
Write(' Vvedite tsvet texta: '); ReadLn(Colors[1]);
Write(' Vvedite tsvet ramki: '); ReadLn(Colors[2]);
Write(' Vvedite tsvet fona : '); ReadLn(Colors[3]);
TextBackGround(Colors[3]);
clrscr;
dx:=(xk-xn)/319;
for i:=1 to 320 do
begin
arrayX[i]:=xn;
arrayY[i]:=(xA*sin(xn)+xB*sin(3*xn));
xn:=xn+dx;
end;
end;
procedure Print_Tab(arrayX,arrayY:MyType);
var i:integer;
begin
clrscr;
WriteLn;
TextColor(Colors[2]);
WriteLn(' ЪДДДДДДДДДДДДДДДДДДДДДДДДї');
Write(' Г');
TextColor(Colors[1]);
Write(' # ');
TextColor(Colors[2]);
Write('Г');
TextColor(Colors[1]);
Write(' x ');
TextColor(Colors[2]);
Write('Г');
TextColor(Colors[1]);
Write(' F(x) ');
TextColor(Colors[2]);
WriteLn('ґ');
WriteLn(' ГДДДДДДДДДДДДДДДДДДДДДДДДґ');
for i:=1 to 16 do begin
Write(' Г ');
TextColor(Colors[1]);
Write(i*20:3);
TextColor(Colors[2]);
Write(' Г ');
TextColor(Colors[1]);
Write(arrayX[i*20]:5:1);
TextColor(Colors[2]);
Write(' Г ');
TextColor(Colors[1]);
Write(arrayY[i*20]:8:4);
TextColor(Colors[2]);
WriteLn(' ґ');
end;
WriteLn(' АДДДДДДДДДДДДДДДДДДДДДДДДЩ ');
end;
procedure Min_Max(arrayY:MyType; var YMin,YMax:real);
begin
YMin:=arrayY[1];
for i:=2 to 320 do if arrayY[i]<YMin then YMin:=arrayY[i];
YMax:=arrayY[1];
for i:=2 to 320 do if arrayY[i]>YMax then YMax:=arrayY[i];
end;
procedure Print_Min_Max(YMin,YMax:real);
begin
clrscr;
TextColor(Colors[2]);
WriteLn;
WriteLn(' ЪДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДї');
Write(' Г ');
TextColor(Colors[1]);
Write('Minimalnoe znachenie Y= ',Ymin:5:3);
TextColor(Colors[2]);
WriteLn(' ґ');
WriteLn(' ГДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДґ');
Write(' Г ');
TextColor(Colors[1]);
Write('Maximalnoe znachenie Y= ',Ymax:5:3);
TextColor(Colors[2]);
WriteLn(' ґ');
WriteLn(' АДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДЩ ')
end;
procedure Print_Graph(var YMin,YMax:real; var arrayX,arrayY:MyType);
var dx,dy:real; GD,GM:Integer;
begin
GD:=Detect; GM:=2;
InitGraph(GD,GM,'');
SetBkColor(7); ClearDevice;
SetColor(4); RecTangle(5,5,635,475);
SetColor(1); Line(320,470,320,10);
MoveTo(320,10); LineRel(-10,10);
MoveTo(320,10); LineRel(10,10);
SetTextStyle(1,0,4); OutTextXY(330,10,'Y');
Line(10,240,630,240);
MoveTo(630,240); LineRel(-10,10);
MoveTo(630,240); LineRel(-10,-10);
OutTextXY(625,245,'X');
If abs(Ymax)>abs(Ymin) then dy:=abs(Ymax) else dy:=abs(Ymin);
If abs(arrayX[1])>abs(arrayX[320]) then dx:=abs(arrayX[1]) else dx:=abs(arrayX[320]);
MoveTo((320+Round(arrayX[1]*310/dx)),(240+Round(-arrayY[1]*230/dy)));
for i:=2 to 320 do LineTo((320+Round((arrayX[i]*310/dx))),(240-Round(arrayY[i]*230/dy)));
readkey;
CloseGraph;
end;
procedure ASCII;
var i:Integer; s:string;
begin
clrscr;
Assign(f,'ASCII.txt');
Reset(f);
for i:=1 to 25 do
begin
ReadLn(f,s);
WriteLn(s);
end;
readln;
end;
procedure OnProgramStart(var Menu:MyType2; var NMenu,Fon,Sim,Rim:Integer);
begin
Menu[1]:='Tabulacia';
Menu[2]:='Minimum & Maximum';
Menu[3]:='Graphik';
Menu[4]:='About';
Menu[5]:='ASCII-ART';
Menu[6]:='Exit';
NMenu:=1; Fon:=7; Sim:=5; Rim:=6;
end;
begin
ShowMenu1;
OnProgramStart(MenuText,NMenu,Fon,Sim,Rim);
Menu:
repeat
TextBackGround(Fon); clrscr;
TextColor(Sim);
for i:=1 to 6 do begin
GoToXY(30, i+9); Write(MenuText[i]);
end;
TextBackGround(Rim);
TextColor(Fon);
GoToXY(30, Nmenu+9); Write(MenuText[Nmenu]);
kod1:=ord(ReadKey);
if kod1=0 then begin
kod2:=ord(Readkey);
if Kod2=80 then if NMenu<6 then NMenu:=NMenu+1 else NMenu:=1;
if Kod2=72 then if NMenu>1 then NMenu:=NMenu-1 else NMenu:=6;
end;
until kod1=13;
clrscr;
if NMenu=1 then
begin
Tab(arrayX,arrayY);
Print_Tab(ArrayX, ArrayY);
readkey;
Goto Menu;
end;
if NMenu=2 then
begin
Tab(arrayX,arrayY);
Min_Max(ArrayY, YMin, YMax);
Print_Min_Max(YMin, YMax);
readkey;
GoTo Menu;
end;
if NMenu=3 then
begin
Tab(arrayX,arrayY);
Min_Max(ArrayY, YMin, YMax);
Print_Graph(YMin,YMax,arrayX,arrayY);
GoTo Menu;
end;
if Nmenu=4 then begin Zastavka; GoTo Menu; end;
if NMenu=5 then begin ASCII; Goto Menu; end;
if NMenu=6 then Exit;
end.
Revise this Paste