Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
7
Добавлен:
02.05.2014
Размер:
2 Кб
Скачать
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.
Соседние файлы в папке Симпсона