Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
5
Добавлен:
02.05.2014
Размер:
1.58 Кб
Скачать
Uses Crt, Zak_Rasp, Graph, Keyboard, Sprites, BmpRW, Strings;
const
n_len=640;
Step1=0.05;
var
Step2,Counter,r:longint;
Abs_Err, HTriangle, S_Prac, S_Teor, x:real;
n:array[0..n_len] of longint;
Bmp:BmpFile;
Str_Err:string;

function RealToStr(A:real):string;
var S:string;
begin
S:='';
Str(A:9:9,S);
RealToStr:=S;
end;

begin
SetSVGAMode(640,480,16,0);
MultiKeysInit;
HTriangle:=GetMaxY;
DirectVideo:=false;
while not(TestKey(Esc_Scan)) do
begin
S_Prac:=0;S_Teor:=0;
FillChar(n, SizeOf(n), 0);
ChangePage;
for r:=0 to n_len do
begin
PutPixel(r,round(GetMaxY-(HTriangle/2)*Simp_Disp(r,0,n_len)),RGBColor(0,0,155));
PutPixel(r+1,round(GetMaxY-(HTriangle/2)*Simp_Disp(r,0,n_len)),RGBColor(0,0,155));
end;
S_Teor:=n_len*HTriangle/2;
for Counter:=0 to n_len do
begin
x:=random+random;
for r:=0 to n_len do
if (r*Step1<=x) and (x<r*Step1+Step1) then inc(n[r]);
end;
Step2:=n_len div 40;
for r:=1 to n_len+1 do
begin
Rectangle(Step2*(r-1),GetMaxY-n[r]*Step2,Step2*(r-1)+Step2,GetMaxY,RGBColor(255,0,0));
S_Prac:=S_Prac+n[r]*Step2*Step2;
end;
line(0,0,0,GetMaxY);
line(0,GetMaxY,GetMaxX,GetMaxY);
OutTextXY(10,10,'Prac='+RealToStr(S_Prac)+'; Teor='+RealToStr(S_Teor)+'; Pogr='+RealToStr(((100*(S_Teor-S_Prac))/S_Prac))+'%');
if page then
begin
if TestKey(Space_Scan) then while TestKey(Space_Scan) do;
if TestKey(F1_Scan) then SaveFromScr('bmp19.bmp',Bmp,0,0,GetMaxX,GetMaxY);
end;
end;
end.
Соседние файлы в папке Симпсона