home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 10 / ldm / pgraph.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-06  |  13.8 KB  |  418 lines
  1. UNIT PGRAPH;
  2. INTERFACE
  3. USES Crt,Graph;
  4. CONST
  5.   {$IFDEF CPU87} MaxInt=2147483647; {$ENDIF}
  6.   nmax=200;
  7. CONST
  8.   Black:BYTE=0;     Blue:BYTE=1;          Green:BYTE=2;       Cyan:BYTE=3;
  9.   Red:BYTE=4;       Magenta:BYTE=5;       Brown:BYTE=6;       LightGray:BYTE=7;
  10.   DarkGray:BYTE=8;  LightBlue:BYTE=9;     LightGreen:BYTE=10; LightCyan:BYTE=11;
  11.   LightRed:BYTE=12; LightMagenta:BYTE=13; Yellow:BYTE=14;     White:BYTE=15;
  12. TYPE
  13.   {$IFDEF CPU87} REAL=EXTENDED; {$ELSE}
  14.   DOUBLE=REAL; SINGLE=REAL; EXTENDED=REAL; COMP=REAL; {$ENDIF}
  15.   GeraetTyp = (Bildschirm,Drucker,Plotter);
  16.   Vektor = ARRAY[1..nmax] OF REAL;
  17.   strg80 = STRING[80];
  18. VAR
  19.   Geraet:GeraetTyp;   { fuer AngleTrueScale }
  20.   GraphDriver,GraphMode,ErrorCode:INTEGER;
  21.   OldExitProc:Pointer;
  22.   Xaxmin,Xaxmax,Yaxmin,Yaxmax:REAL;      { fuer USCALE }
  23.   Uaxmin,Uaxmax,Vaxmin,Vaxmax:INTEGER;   { fuer Graphikwindow }
  24.  
  25.   PROCEDURE AngleTrueScale(VAR x1,x2,y1,y2:REAL);
  26.   PROCEDURE CloseGraphik;
  27.   PROCEDURE Curve(VAR x,y:Vektor; n,Lintyp,Thickness,Color:WORD);
  28.   PROCEDURE Curvex(VAR x,y:Vektor; n:WORD; Color:BYTE);
  29.   FUNCTION  EXP10(x:REAL):REAL;
  30.   FUNCTION  Exponent(x:REAL):INTEGER;
  31.   PROCEDURE Extrema(z:Vektor; n:WORD; VAR zmin,zmax:REAL);
  32.   PROCEDURE GraphikText(Text:strg80; Font, Size, TxtCol, Line:BYTE);
  33.   PROCEDURE GraphikWindow(x1,x2,y1,y2:INTEGER);
  34.   PROCEDURE LinaxScale(VAR a,b,dx,Ex:REAL; Density:BYTE; VAR ExpStrg:strg80);
  35.   FUNCTION  LOG10(x:REAL):REAL;
  36.   PROCEDURE LogXAxis(LogX1,LogX2:REAL; XText:strg80; Font,Size:WORD);
  37.   PROCEDURE LogYAxis(LogY1,LogY2:REAL; YText:strg80; Font,Size:WORD);
  38.   PROCEDURE OpenGraphik;
  39.   FUNCTION  RealToString(x:REAL):strg80;
  40.   PROCEDURE Scale(x,y:REAL; VAR u,v:INTEGER);
  41.   PROCEDURE Uscale(VAR x1,x2,y1,y2:REAL; Origin,AngleTrue:BOOLEAN; Expans:REAL);
  42.   PROCEDURE XAxis(x1,x2:REAL; XText:strg80; Font,Size:WORD);
  43.   PROCEDURE Xgrid(x:REAL);
  44.   PROCEDURE Xmark(x:REAL; VAR u:INTEGER; Len:BYTE);
  45.   PROCEDURE YAxis(y1,y2:REAL; YText:strg80; Font,Size:WORD);
  46.   PROCEDURE Ymark(y:REAL; VAR v:INTEGER; Len:BYTE);
  47.   PROCEDURE Ygrid(y:REAL);
  48.  
  49. IMPLEMENTATION
  50.  
  51. PROCEDURE AngleTrueScale;  { Winkeltreue Skalierung }
  52. VAR   C,dx,dy,xx,yy,xm,ym,F:REAL; Xasp,Yasp:WORD;
  53. BEGIN
  54.   IF Geraet=Bildschirm THEN BEGIN  { Laenge/Breite-Faktor }
  55.     GetAspectRatio(Xasp,Yasp);
  56.     F:=(Xasp/Yasp)*(Abs(Uaxmin-Uaxmax)/Abs(Vaxmin-Vaxmax)); END
  57.   ELSE BEGIN
  58.     F:=(2/3)*(Abs(Uaxmin-Uaxmax)/Abs(Vaxmin-Vaxmax))
  59.   END;
  60.   dx:=Abs(x2-x1);
  61.   dy:=Abs(y2-y1);
  62.   IF dx>=dy THEN BEGIN
  63.     yy:=0.5*dx/F;    IF y1>y2 THEN yy:=-yy;   { y-Achse strecken }
  64.     ym:=0.5*(y1+y2); y1:=ym-yy; y2:=ym+yy; END
  65.   ELSE BEGIN
  66.     xx:=0.5*dy*F;    IF x1>x2 THEN xx:=-xx;   { x-Achse strecken }
  67.     xm:=0.5*(x1+x2); x1:=xm-xx; x2:=xm+xx;
  68.   END;
  69. END;
  70.  
  71. {$F+} PROCEDURE CloseGraphik;  { Graphik beenden }
  72. BEGIN
  73.   ExitProc:=OldExitProc;
  74.   SetBkColor(Black);
  75.   CloseGraph;
  76.   DirectVideo:=TRUE;
  77.   Window(1,1,80,25);
  78. END; {$F-}
  79.  
  80. PROCEDURE Curve;   { Polygonzug }
  81. VAR i,u1,v1,u2,v2:INTEGER;
  82. BEGIN
  83.   SetLineStyle(Lintyp,0,Thickness); SetColor(Color);
  84.   Scale(x[1],y[1],u1,v1);
  85.   FOR i:=2 TO n DO BEGIN
  86.     Scale(x[i],y[i],u2,v2); Line(u1,v1,u2,v2);
  87.     u1:=u2; v1:=v2;
  88.   END;
  89. END;
  90.  
  91. PROCEDURE Curvex;   { Punkte auftragen }
  92. VAR i,u,v:INTEGER;
  93. BEGIN
  94.   FOR i:=1 TO n DO BEGIN
  95.     Scale(x[i],y[i],u,v); PutPixel(u,v,Color);
  96.   END;
  97. END;
  98.  
  99. FUNCTION EXP10;
  100. VAR S:STRING[80]; E:REAL; Code:WORD;
  101. BEGIN
  102.   IF x=Int(x) THEN BEGIN   { 10 hoch Integer }
  103.     Str(Trunc(x),S);
  104.     Val(('1.0E'+S),E,Code); EXP10:=E; Exit;
  105.   END;
  106.   EXP10:=Exp(x*Ln(10));   { 10 hoch Real }
  107. END;
  108.  
  109. FUNCTION Exponent;   { Groessenordnung }
  110. VAR Ex,S:STRING[80]; n,Code:INTEGER; {   einer Zahl    }
  111. BEGIN
  112.   Str(x,S); Ex:=Copy(S,Pos('E',S)+1,Length(S));
  113.   Val(Ex,n,Code); Exponent:=n;
  114. END;
  115.  
  116. PROCEDURE Extrema;  { Maximum und Minimum }
  117. VAR i:WORD;         { des Vektors z[1..n] }
  118. BEGIN
  119.   zmin:=z[1]; zmax:=z[1];
  120.   FOR i:=2 TO n DO BEGIN
  121.     IF z[i]<zmin THEN zmin:=z[i];
  122.     IF z[i]>zmax THEN zmax:=z[i];
  123.   END;
  124. END;
  125.  
  126. PROCEDURE GraphikText;  { Textausgabe ins }
  127. VAR Xpos,Ypos:INTEGER;  {  Graphikfenster }
  128. BEGIN
  129.   IF (Font>4)  OR (Font<0) THEN Font:=1;
  130.   IF (Size>10) OR (Size<1) THEN Size:=1;
  131.   IF (Line>24) THEN Line:=24;                 { Zeile 1..24 }
  132.   IF (Line<1)  THEN Line:=1;
  133.   IF Font=2 THEN Size:=Size*2;
  134.   SetViewPort(0,0,GetMaxX,GetMaxY,ClipOn);
  135.   SetColor(TxtCol);
  136.   SetTextStyle(Font,HorizDir,Size);
  137.   SetTextJustify(CenterText,CenterText);      { Zentrieren }
  138.   Xpos:=Succ(GetMaxX) DIV 2;
  139.   Ypos:=Line*(GetMaxY DIV 25);
  140.   OutTextXY(Xpos,Ypos,Text);
  141. END;
  142.  
  143. PROCEDURE GraphikWindow;   { Graphikfenster }
  144. VAR h:INTEGER;
  145. BEGIN
  146.   SetLineStyle(SolidLn,0,NormWidth); SetColor(White);
  147.   IF x1>x2 THEN BEGIN h:=x1; x1:=x2; x2:=h; END;
  148.   IF y1>y2 THEN BEGIN h:=y1; y1:=y2; y2:=h; END;
  149.   Line(x1,GetMaxY-y1,x2,GetMaxY-y1);             { Rahmen }
  150.   Line(x2,GetMaxY-y1,x2,GetMaxY-y2);
  151.   Line(x2,GetMaxY-y2,x1,GetMaxY-y2);
  152.   Line(x1,GetMaxY-y2,x1,GetMaxY-y1);
  153.   Uaxmin:=x1; Uaxmax:=x2; Vaxmin:=y1; Vaxmax:=y2; { Fensterkoordinaten }
  154. END;
  155.  
  156. PROCEDURE LinaxScale;  { Hilfsroutine fuer }
  157. VAR  x1,x2:REAL;       {  Xaxis und Yaxis  }
  158. BEGIN
  159.   IF Abs(a)<Abs(b) THEN Ex:=Exponent(b) ELSE Ex:=Exponent(a);
  160.   x1:=a; x2:=b; dx:=0.25*EXP10(Exponent(b-a));
  161.   ExpStrg:='0';
  162.   IF Abs(Ex)>3 THEN BEGIN                         { Exponent abtrennen }
  163.     a:=a*EXP10(-Ex); b:=b*EXP10(-Ex); dx:=dx*EXP10(-Ex);
  164.     Str(Ex:4:0,ExpStrg); WHILE ExpStrg[1]=#32 DO Delete(ExpStrg,1,1);
  165.   END;
  166.   WHILE ((b-a)/dx)>=Density DO dx:=2*dx;  { Skalendichte }
  167.   IF b<a THEN dx:=-dx;
  168.   IF a=b THEN BEGIN a:=a-dx; b:=b+dx; END;
  169.   a:=dx*Round(a/dx);                      { Guenstig runden }
  170.   b:=dx*Round(b/dx);
  171.   IF a<b THEN BEGIN
  172.     IF a<x1 THEN a:=a+dx; IF b>x2 THEN b:=b-dx; END
  173.   ELSE BEGIN
  174.     IF a>x1 THEN a:=a-dx; IF b<x2 THEN b:=b+dx;
  175.   END;
  176. END;
  177.  
  178. FUNCTION LOG10;   { dekad. Logarithmus }
  179. BEGIN
  180.   IF x<>0 THEN LOG10:=Ln(Abs(x))/Ln(10.0) ELSE LOG10:=0;
  181. END;
  182.  
  183. PROCEDURE LogXAxis;     { Log. x-Achse }
  184. CONST Density=10;       { Skalendichte }
  185. VAR dn,n1,n2,n,k,u,v:INTEGER; x:REAL; S:STRING[6];
  186. BEGIN
  187.   Line(Uaxmin,GetMaxY-Vaxmin,Uaxmax,GetMaxY-Vaxmin);
  188.   u:=(Uaxmax+Uaxmin) DIV 2;
  189.   v:=GetMaxY-(Vaxmin-3*TextHeight(XText));
  190.   SetTextStyle(Font,HorizDir,Size);
  191.   SetTextJustify(CenterText,CenterText);
  192.   OutTextXY(u,v,XText);                     { Achsenbeschriftung }
  193.   n1:=Trunc(LogX1); n2:=Trunc(LogX2);
  194.   IF n1>n2 THEN BEGIN k:=n1; n1:=n2; n2:=k; END;
  195.   dn:=1; WHILE (n2-n1) DIV dn>=Density DO dn:=Density*dn;
  196.   IF dn=1 THEN BEGIN                              { Log-Skala }
  197.     FOR n:=n1-1 TO n2+1 DO
  198.     FOR k:=2 TO 9 DO BEGIN x:=n+LOG10(k); Xmark(x,u,3); END;
  199.   END;
  200.   FOR n:=n1 TO n2 DO BEGIN
  201.    IF (dn<>1) AND ((n MOD (dn DIV 10))=0) THEN Xmark(n,u,3);
  202.    IF (n MOD dn)=0 THEN BEGIN
  203.     Xmark(n,u,4);
  204.     Str(n,S);
  205.     OutTextXY(u+TextWidth(S)*4 DIV 5,GetMaxY-Vaxmin+(TextHeight('0') DIV 2),S);
  206.     OutTextXY(u-TextWidth('0') DIV 2,GetMaxY-Vaxmin+TextHeight('0'),'10');
  207.    END;
  208.   END;
  209. END;
  210.  
  211. PROCEDURE LogYAxis;       { log. y-Achse }
  212. CONST Density=10;       { Skalendichte }
  213. VAR dn,n1,n2,n,k,u,v:INTEGER; y:REAL; S:STRING[6];
  214. BEGIN
  215.   Line(Uaxmin,GetMaxY-Vaxmin,Uaxmin,GetMaxY-Vaxmax);
  216.   u:=Uaxmin-3*TextHeight(YText);
  217.   v:=(Vaxmax-Vaxmin) DIV 2;
  218.   SetTextStyle(Font,VertDir,Size);
  219.   SetTextJustify(CenterText,CenterText);
  220.   OutTextXY(u,v,YText);                       { Achsenbeschriftung }
  221.   n1:=Trunc(LogY1); n2:=Trunc(LogY2);
  222.   IF n1>n2 THEN BEGIN k:=n1; n1:=n2; n2:=k; END;
  223.   dn:=1; WHILE (n2-n1) DIV dn>=Density DO dn:=Density*dn;
  224.   IF dn=1 THEN BEGIN                            { Log-Skala }
  225.     FOR n:=n1-1 TO n2+1 DO
  226.     FOR k:=2 TO 9 DO BEGIN y:=n+LOG10(k); Ymark(y,v,3); END;
  227.   END;
  228.   FOR n:=n1 TO n2 DO BEGIN
  229.     IF (dn<>1) AND ((n MOD (dn DIV 10))=0) THEN Ymark(n,u,3);
  230.     IF (n MOD dn)=0 THEN BEGIN
  231.       Ymark(n,v,4);
  232.       Str(n,S);
  233.       OutTextXY(Uaxmin-TextHeight('0'),v-TextWidth(S)*3 DIV 4,S);
  234.       OutTextXY(Uaxmin-TextHeight('0') DIV 2,v+TextWidth('0') DIV 2,'10');
  235.     END;
  236.   END;
  237. END;
  238.  
  239. PROCEDURE OpenGraphik;      { Graphik starten }
  240. BEGIN
  241.   DirectVideo:=FALSE;                { Graphik- und Textmode }
  242.   OldExitProc:=ExitProc; ExitProc:=Addr(CloseGraphik);
  243.   GraphDriver:=Detect;
  244.   InitGraph(GraphDriver,GraphMode,'');
  245.   ErrorCode:=GraphResult;
  246.   IF ErrorCode<>grOk THEN BEGIN
  247.     WriteLn('Graphics error: ',GraphErrorMsg(ErrorCode)); ReadLn;
  248.     Halt(1);
  249.   END;
  250.   IF GraphDriver=7 THEN BEGIN
  251.     Black:=0;     Blue:=15;         Green:=15;      Cyan:=15;
  252.     Red:=15;      Magenta:=15;      Brown:=15;      LightGray:=15;
  253.     DarkGray:=15; LightBlue:=15;    LightGreen:=15; LightCyan:=15;
  254.     LightRed:=15; LightMagenta:=15; Yellow:=15;     White:=15;
  255.   END;
  256.   IF Geraet IN [Bildschirm,Drucker,Plotter] THEN ELSE Geraet:=Drucker;
  257.   Uaxmin:=0; Uaxmax:=GetMaxX; Vaxmin:=0; Vaxmax:=GetMaxY;
  258. END;
  259.  
  260. FUNCTION RealToString;        { Reelle Zahl in    }
  261. VAR S:strg80; Code:WORD;      { handlichen String }
  262. BEGIN
  263.   Str(x:16:10,S);
  264.   WHILE S[1]=#32 DO Delete(S,1,1);
  265.   WHILE S[Length(S)]='0' DO BEGIN Delete(S,Length(S),1); END;
  266.   IF Pos('.',S)=Length(S) THEN Delete(S,Length(S),1);
  267.   Val(S,x,Code); IF x=0 THEN S:='0';
  268.   RealToString:=S;
  269. END;
  270.  
  271. PROCEDURE Scale;       { Absolute Skalierung }
  272. BEGIN
  273.   u:= Uaxmin+Round((x-Xaxmin)/(Xaxmax-Xaxmin)*(Uaxmax-Uaxmin));
  274.   v:=GetMaxY-Round((y-Yaxmin)/(Yaxmax-Yaxmin)*(Vaxmax-Vaxmin))-Vaxmin;
  275. END;
  276.  
  277. PROCEDURE Uscale;       { Benutzer- }
  278. VAR xx,yy:REAL;         { koordinatensystem }
  279. CONST Tol = 0.01;
  280. BEGIN
  281.   Expans:=Abs(Expans);
  282.   xx:=Abs(x2-x1)*0.005*Expans; IF x1>x2 THEN xx:=-xx;  { 1. Ausweiten }
  283.   x1:=x1-xx; x2:=x2+xx;
  284.   IF Abs(x2-x1)<1E-8 THEN
  285.   BEGIN x1:=x1*(1-0.01*Expans); x2:=x2*(1+0.01*Expans); END;
  286.   yy:=Abs(y2-y1)*0.005*Expans; IF y1>y2 THEN yy:=-yy;
  287.   y1:=y1-yy; y2:=y2+yy;
  288.   IF Abs(y2-y1)<1E-8 THEN
  289.   BEGIN y1:=y1*(1-0.01*Expans); y2:=y2*(1+0.01*Expans); END;
  290.   IF Origin THEN BEGIN         { 2. Ursprung }
  291.     IF x1<=x2 THEN BEGIN
  292.       IF x2<0 THEN x2:=0;
  293.       IF x1>0 THEN x1:=0; END
  294.     ELSE BEGIN
  295.       IF x2>0 THEN x2:=0;
  296.       IF x1<0 THEN x1:=0;
  297.     END;
  298.     IF y1<=y2 THEN BEGIN
  299.       IF y2<0 THEN y2:=0;
  300.       IF y1>0 THEN y1:=0; END
  301.     ELSE BEGIN
  302.       IF y2>0 THEN y2:=0;
  303.       IF y1<0 THEN y1:=0;
  304.     END;
  305.   END;
  306.   IF AngleTrue THEN AngleTrueScale(x1,x2,y1,y2);  { 3. Winkeltreue }
  307.   IF Abs((x2-x1)/x2)<Tol THEN BEGIN               { 4. Minimalausdehnung }
  308.     IF x1<x2 THEN
  309.     BEGIN x1:=x1*(1-Tol); x2:=x2*(1+Tol); END
  310.     ELSE BEGIN x2:=x2*(1-Tol); x1:=x1*(1+Tol); END;
  311.   END;
  312.   IF Abs((y2-y1)/y2)<Tol THEN BEGIN
  313.     IF y1<y2 THEN
  314.     BEGIN y1:=y1*(1-Tol); y2:=y2*(1+Tol); END
  315.     ELSE BEGIN y2:=y2*(1-Tol); y1:=y1*(1+Tol); END;
  316.   END;
  317.   Xaxmin:=x1; Xaxmax:=x2;
  318.   Yaxmin:=y1; Yaxmax:=y2;
  319. END;
  320.  
  321. PROCEDURE XAxis;   { lineare x-Achse }
  322. VAR   Xpos,Ypos:INTEGER;
  323.       Ex,u,v,a,b,x,dx,h:REAL; E,S:strg80;
  324. CONST Density=6;                        { Skalendichte }
  325. BEGIN
  326.   Line(Uaxmin,GetMaxY-Vaxmin,Uaxmax,GetMaxY-Vaxmin);
  327.   Xpos:=(Uaxmax+Uaxmin) DIV 2;
  328.   Ypos:=GetMaxY-(Vaxmin-3*TextHeight(XText));
  329.   a:=x1; b:=x2; IF a>b THEN BEGIN h:=b; b:=a; a:=b; END;
  330.   LinaxScale(x1,x2,dx,Ex,Density,E);
  331.   IF x1>x2 THEN BEGIN h:=x1; x1:=x2; x2:=h; dx:=Abs(dx); END;
  332.   SetTextStyle(Font,HorizDir,Size);
  333.   SetTextJustify(CenterText,CenterText);
  334.   IF E='0' THEN                            { Achsenbeschriftung }
  335.     OutTextXY(Xpos,Ypos,XText)
  336.   ELSE BEGIN
  337.     u:=Xaxmin; v:=Xaxmax;
  338.     OutTextXY(Xpos,Ypos,XText+' *E'+E);
  339.     a:=a*EXP10(-Ex); b:=b*EXP10(-Ex); Xaxmin:=a; Xaxmax:=b;
  340.   END;
  341.   x:=x1;                                   { lineare Skala }
  342.   Xmark(x-dx/2,Xpos,3);
  343.   REPEAT
  344.     Xmark(x+dx/2,Xpos,3);
  345.     Xmark(x,Xpos,3);
  346.     S:=RealToString(x);
  347.     Line(Xpos,GetMaxY-Vaxmin,Xpos,GetMaxY-Vaxmin-3);
  348.     IF Length(S)<6 THEN OutTextXY(Xpos,GetMaxY-Vaxmin+TextHeight('0'),S);
  349.     x:=x+dx;
  350.   UNTIL (x>=b) OR (x<=a);
  351.   IF E<>'0' THEN BEGIN Xaxmin:=u; Xaxmax:=v; END;
  352. END;
  353.  
  354. PROCEDURE Xgrid;  { Parallele zur }
  355. VAR u,v:INTEGER;  {    x-Achse    }
  356. BEGIN
  357.   Scale(x,0,u,v);
  358.   IF u>Uaxmin THEN Line(u,GetMaxY-Vaxmin,u,GetMaxY-Vaxmax);
  359. END;
  360.  
  361. PROCEDURE Xmark;                                  {  x-Achsenmarken:   }
  362. VAR v:INTEGER;                                    { Hilfsroutine fuer  }
  363. BEGIN   { Xaxis und LogXAxis }
  364.   Scale(x,Yaxmin,u,v);
  365.   IF (u>=Uaxmin) AND (u<=Uaxmax) THEN
  366.   Line(u,GetMaxY-Vaxmin,u,GetMaxY-Vaxmin-Len);
  367. END;
  368.  
  369. PROCEDURE YAxis;   { lineare y-Achse }
  370. VAR   Xpos,Ypos:INTEGER;
  371.       Ex,u,v,a,b,y,dy,h:REAL; E,S:strg80;
  372. CONST Density=8;                                  { Skalendichte }
  373. BEGIN
  374.   Line(Uaxmin,GetMaxY-Vaxmin,Uaxmin,GetMaxY-Vaxmax);
  375.   Xpos:=Uaxmin-3*TextHeight(YText);
  376.   Ypos:=(Vaxmax-Vaxmin) DIV 2;
  377.   a:=y1; b:=y2; IF a>b THEN BEGIN h:=b; b:=a; a:=b; END;
  378.   LinaxScale(y1,y2,dy,Ex,Density,E);
  379.   IF y1>y2 THEN BEGIN h:=y1; y1:=y2; y2:=h; dy:=Abs(dy); END;
  380.   SetTextStyle(Font,VertDir,Size);
  381.   SetTextJustify(CenterText,CenterText);
  382.   IF E='0' THEN                                { Achsenbeschriftung }
  383.     OutTextXY(Xpos,Ypos,YText)
  384.   ELSE BEGIN
  385.     u:=Yaxmin; v:=Yaxmax;
  386.     OutTextXY(Xpos,Ypos,YText+' *E'+E);
  387.     a:=a*EXP10(-Ex); b:=b*EXP10(-Ex); Yaxmin:=a; Yaxmax:=b;
  388.   END;
  389.   y:=y1;                               { lineare Skala }
  390.   Ymark(y-dy/2,Ypos,3);
  391.   REPEAT
  392.     Ymark(y+dy/2,Ypos,3);
  393.     S:=RealToString(y);
  394.     Ymark(y,Ypos,3);
  395.     IF Length(S)<6 THEN OutTextXY(Uaxmin-TextHeight('0'),Ypos,S);
  396.     y:=y+dy;
  397.   UNTIL (y>=b) OR (y<=a);
  398.   IF E<>'0' THEN BEGIN Yaxmin:=u; Yaxmax:=v; END;
  399. END;
  400.  
  401. PROCEDURE Ygrid;       { Parallele zur }
  402. VAR u,v:INTEGER;       {    y-Achse    }
  403. BEGIN
  404.   Scale(0,y,u,v);
  405.   IF v<GetMaxY-Vaxmin THEN Line(Uaxmin,v,Uaxmax,v);
  406. END;
  407.  
  408. PROCEDURE Ymark;       {  y-Achsenmarken:   }
  409. VAR u:INTEGER;        { Hilfsroutine fuer  }
  410. BEGIN         { Yaxis und LogYAxis }
  411.   Scale(Xaxmin,y,u,v);
  412.   IF (v<GetMaxY-Vaxmin) AND (v>GetMaxY-Vaxmax) THEN
  413.   Line(Uaxmin,v,Uaxmin+Len,v);
  414. END;
  415.  
  416. END.
  417.  
  418.