home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CNC11TP.ZIP / DFCTCIRC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-19  |  2.7 KB  |  100 lines
  1. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  2.  
  3. program DefectCount (output) ;
  4.  
  5.      {    DfctCirc - draw circle with a stroke routine,    }
  6.      {               erases reference circle, and count    }
  7.      {               remaining set pixels.                 }
  8.  
  9. uses GRAPH ;
  10.  
  11. var
  12.    xc,yc            : integer ; { center }
  13.    ar               : single ;  { aspect ratio }
  14.  
  15. {~~~~~~~~~~~~~~~~~~~~~ circle routines ~~~~~~~~~~~~~~~~~~~~}
  16.  
  17. {$I conic.pas }
  18.  
  19. {-$I circda2.pas  }
  20. {-$I circdaf.pas }
  21. {-$I circdai.pas }
  22. {-$I circdai2.pas }
  23. {-$I circdam2.pas }
  24. {-$I circdas.pas }
  25. {-$I circmb.pas }
  26. {$I circra.pas }
  27. {-$I circraf4.pas }
  28. {-$I circrai2.pas }
  29. {-$I circrair.pas }
  30. {-$I circram.pas }
  31. {-$I circras.pas }
  32.  
  33. {~~~~~~~~~~~~~~~~~~~ number of defects ~~~~~~~~~~~~~~~~~~~~}
  34.  
  35. function CountDefects ( r : integer ) : integer ;
  36. var
  37.    n,ix,iy : integer ;
  38. begin
  39.    n := 0 ;
  40.    for ix := xc-r-1 to xc+r+1 do
  41.       for iy := yc-Round(r*ar)-1 to yc+Round(r*ar)+1 do
  42.          if GetPixel(ix,iy) <> 0 then
  43.             Inc(n) ;
  44.    CountDefects := n
  45. end ;
  46.  
  47. {~~~~~~~~~~~~~~~~~~~~~ main program ~~~~~~~~~~~~~~~~~~~~~~~}
  48.  
  49. var
  50.    r                : word ;    { circle radius }
  51.    grDetect, grMode : integer ; { graph control parameters }
  52.    ixar,iyar        : word ;    { aspect ratio parameters }
  53.    Color            : word ;
  54.    i                : integer ;
  55.    nDefects         : array[8..24] of integer ;
  56.  
  57. begin
  58.                                 { prompt for radius }
  59.    repeat
  60.       write ('Radius: ') ;
  61.       readln (r)
  62.    until (r > 0) ;
  63.                                 { initiate graphics }
  64.    grDetect := Detect ;
  65.    InitGraph(grDetect,grMode,'') ;
  66.    GetAspectRatio(ixar,iyar) ;
  67.    ar := ixar/iyar ;
  68.                                 { center of display }
  69.    xc := (GetMaxX + 1) div 2 ;
  70.    yc := (GetMaxY + 1) div 2 ;
  71.                                 { performance }
  72.    for i := 8 to 24 do begin
  73.       idr := 2*i ;
  74.       dr := idr/64 ;
  75.       ClearDevice ;
  76.                                 { draw stroke circle }
  77.       StrokeCircle(xc,yc,r) ;
  78.                                 { clear TURBO BGI circle }
  79.       Color := GetColor ;
  80.       SetColor(0) ;
  81.       Circle(xc,yc,r) ;
  82.       SetColor(Color) ;
  83.                                 { count set pixels }
  84.       nDefects[i] := CountDefects(r)
  85.  
  86.    end ;
  87.                                 { pause }
  88.    CloseGraph ;
  89.                                 { show offset and defect count }
  90.    writeln (output,'Radius: ',r) ;
  91.    for i := 8 to 24 do begin
  92.       idr := 2*i ;
  93.       dr := idr/64 ;
  94.       writeln (output,idr:5,'   ',dr:5:2,' ',nDefects[i]:5)
  95.    end
  96.  
  97. end.
  98.  
  99. { Copyright (C) 1989 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  100.