home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / dos / prg / vidal / pascal / cercle.pas next >
Encoding:
Pascal/Delphi Source File  |  1994-07-21  |  2.0 KB  |  100 lines
  1. { programme de tracage de cercle utilisant algorythme de michelob
  2.   cette algorythme a l'avantage d'etre incremental , et utilise
  3.   que des entiers d'ailleur aucune difference avec la procedure
  4.   circle du pascal comme le montre ce programme
  5. }
  6.  
  7. program test;
  8. uses crt,graph;
  9. const xp1=50;
  10.       xp2=100;
  11.       xp3=10;
  12.       yp1=10;
  13.       yp2=30;
  14.       yp3=150;
  15.       cstlgdr=500;
  16.  
  17. type  coord= RECORD
  18.               x : integer;
  19.               y : integer;
  20.             END;
  21.      droite= RECORD
  22.              d: array[1..cstlgdr] of integer;
  23.              l: word;
  24.              END;
  25. var a:char;
  26.      d1,d2,d3 : droite;
  27.      point: array[1..3] of coord;
  28.      s: integer;
  29. procedure trace(x1,y1,x2,y2:integer;c:byte);
  30. BEGIN
  31.  putpixel(x1,y1,c);
  32.  {line(x1,y1,x2,y2);}
  33. END;
  34.  
  35.  
  36. procedure arccercle(rayon:integer);
  37. var critere : integer;
  38.     x,y: integer;
  39. BEGIN
  40.  x:=0;
  41.  y:=rayon;
  42.  critere:=3-2*rayon;
  43.   while x<=y do
  44.   BEGIN
  45.    if x<>y then BEGIN
  46.    putpixel(x+200,200-y,4);
  47.    putpixel(200-y,200-x,4);
  48.    putpixel(200-x,200+y,4);
  49.    putpixel(200+y,200+x,4);
  50.    END;
  51.    if x<>0 then
  52.    BEGIN
  53.    putpixel(x+200,200+y,4);
  54.    putpixel(200+y,200-x,4);
  55.    putpixel(200-x,200-y,4);
  56.    putpixel(200-y,200+x,4);
  57.    END;
  58.    if critere<0 then
  59.       critere:=critere+4*x+6
  60.    else
  61.    BEGIN
  62.    critere:=critere+4*(x-y)+10;dec(y);
  63.    END;
  64.    inc(x);
  65.   END;
  66. END;
  67.  
  68.  
  69. PROCEDURE graphisme ;
  70. VAR
  71.     GraphDriver , GraphMode ,CodeErreur : integer ;
  72. BEGIN
  73.     GraphDriver := Detect ;
  74.     InitGraph (GraphDriver,GraphMode,'c:\t7\bgi\') ;
  75.     clearviewport;
  76.     CodeErreur  := GraphResult ;
  77.     If CodeErreur <> GrOk Then
  78.       Begin
  79.          Writeln ('Erreur en mode graphique : ',GraphErrorMsg (GraphDriver));
  80.          Readln ;
  81.          Halt (1) ;
  82.        End ;
  83. END ;
  84. BEGIN
  85. a:=' ';
  86. s:=0;
  87. graphisme;
  88. clearviewport;
  89. randomize;
  90. setcolor(0);
  91. repeat
  92. arccercle(s);
  93. circle(200,200,s);
  94. inc(s);
  95. until s=200;
  96. repeat
  97. until keypressed;
  98. a:=readkey;
  99. end.
  100.