home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / tricks / hcdemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-11-06  |  3.0 KB  |  145 lines
  1. program mormvert;
  2.  
  3. uses hardcopybib,Graph;
  4. const
  5.     pxl=29; pyo=15; pxr=609; pyu=379;
  6.     xmin=-4; ymin=-0.1; xmax=4; ymax=0.4;
  7.  
  8. var
  9.   GraphDriver, GraphMode, n: integer;
  10.   j, m, x, y, x1, y1, x2, y2, mastx, masty: real;
  11.   xg, yg, xg1, yg1, xg2, yg2: word;
  12.   text: string;
  13.  
  14. procedure wxy(x,y: real);
  15.           begin
  16.           xg:=round(mastx*(x-xmin));
  17.           yg:=round(pyu+masty*(y-ymin));
  18.           end;
  19.  
  20. procedure wxy1(x1,y1,x2,y2: real);
  21.           begin
  22.           xg1:=round(mastx*(x1-xmin));
  23.           yg1:=round(pyu+masty*(y1-ymin));
  24.           xg2:=round(mastx*(x2-xmin));
  25.           yg2:=round(pyu+masty*(y2-ymin));
  26.           end;
  27.  
  28. procedure linew(x1,y1,x2,y2: real);
  29.           begin
  30.           wxy1(x1,y1,x2,y2);
  31.           line(xg1,yg1,xg2,yg2);
  32.          end;
  33. procedure linetow(x,y: real);
  34.           begin
  35.           wxy(x,y);
  36.           lineto(xg,yg);
  37.           end;
  38. procedure movetow(x,y: real);
  39.           begin
  40.           wxy(x,y);
  41.           moveto(xg,yg);
  42.           end;
  43. procedure outtextxyw(x,y: real; text: string);
  44.           begin
  45.           wxy(x,y);
  46.           outtextxy(xg,yg, text);
  47.           end;
  48.  
  49. procedure initiale;
  50.     begin
  51.     GraphDriver := Detect;
  52.     InitGraph(GraphDriver,GraphMode,'');
  53.     if GraphResult <> grOk then
  54.     Halt(1);
  55.  
  56.     mastx:=(pxr-pxl)/(xmax-xmin);
  57.     masty:=(pyo-pyu)/(ymax-ymin);
  58.     hardcopyon;
  59.     end;
  60. procedure viewport;
  61.     begin
  62.     setcolor(lightgreen);
  63.     setlinestyle(0,1,1);
  64.     Rectangle((pxl-29),(pyo-14),(pxr+29),(pyu+14));
  65.     Rectangle((pxl-24),(pyo-10),(pxr+24),(pyu+10));
  66.     SetViewPort(pxl, pyo, pxr, pyu, ClipOff);
  67.     end;
  68.  
  69. procedure xyachse;
  70.     begin
  71.     setcolor(yellow);
  72.     setlinestyle(0,1,1);
  73.     x1:=xmin; y1:=0; x2:=xmax; y2:=0;
  74.     linew(x1,y1,x2,y2);
  75.  
  76.     x1:=0; y1:=ymax; x2:=0; y2:=-0.02;
  77.     linew(x1,y1,x2,y2);
  78.     end;
  79.  
  80. procedure xskalschr;
  81.     begin
  82.     settextstyle(4,horizdir,1);
  83.     settextjustify(centertext,centertext);
  84.     for n:= xmin to xmax do
  85.       begin
  86.       x1:=n; y1:=0; x2:=n; y2:=-0.01;
  87.       linew(x1,y1,x2,y2);
  88.       x:=n; y:=-0.04;
  89.       str(n,text);
  90.       outtextxyw(x,y, text);
  91.       end;
  92.     end;
  93.  
  94. procedure yskalschr;
  95.     begin
  96.     for n:=1  to 10 do
  97.       begin
  98.       x1:=-0; y1:=n/10; x2:=0.2; y2:=n/10;
  99.       linew(x1,y1,x2,y2);
  100.       x:=1; y:=n/10;
  101.       str(n/10:1:1,text);
  102.       outtextxyw(x,y,text);
  103.       end;
  104.     end;
  105.  
  106. procedure Bezeich;
  107.     begin
  108.     settextstyle(4,horizdir,4);
  109.       setcolor(lightcyan);
  110.       x:=xmin/1.5; y:=ymax;
  111.       outtextxyw(x,y,'Normalverteilung');
  112.     end;
  113.  
  114. procedure Kurve;
  115.     begin
  116.     x:=xmin; y:=0;
  117.     movetow(x,y);
  118.  
  119.     setcolor(lightred);
  120.     setlinestyle(0,3,1);
  121.     m:=xmin;
  122.     for n:=0 to pxr-pxl do
  123.     begin
  124.       x:=m;
  125.       y:=1/sqrt(2*pi)*exp(-(x*x)/2);
  126.       linetow(x,y);
  127.       m:=m+(1/mastx);
  128.     end;
  129.     end;
  130.  
  131. { Hauptprogramm }
  132. begin
  133.     initiale;
  134.     viewport;
  135.     xyachse;
  136.     xskalschr;
  137.     yskalschr;
  138.     bezeich;
  139.     kurve;
  140.  
  141.   Readln;
  142.   CloseGraph;
  143.   hardcopyoff;
  144. end.
  145.