home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / UTILITYS / PUDD.ARC / PUDD-01.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-11  |  4KB  |  150 lines
  1.  
  2. procedure PointSet(    size      :integer; {.....set and draw a point }
  3.                    var x1,y1     :integer;
  4.                        Xpoz,Ypoz :integer);
  5.        begin
  6.             moveto(xpoz,ypoz);
  7.             offxhair(size,xpoz,ypoz);
  8.             x1 := xpoz;
  9.             y1 := ypoz;
  10.             drawto(xpoz,ypoz);
  11.             initxhair(size,xpoz,ypoz);
  12.            end;
  13.  
  14.  
  15. procedure MoveCross(size,speed  :integer;
  16.                     direction   :char;
  17.                     var  Xpoz,Ypoz   :integer );
  18. var multi    :integer;
  19. begin
  20.  if speed = 1 then
  21.   multi := 1
  22.  else
  23.   multi := 2;
  24.       case direction of
  25.        '4':begin
  26.             xpoz := xpoz - speed*multi;
  27.            end;
  28.        '7':begin
  29.             xpoz := xpoz - speed*multi;
  30.             ypoz := ypoz + speed;
  31.            end;
  32.        '8':begin
  33.             ypoz := ypoz + speed;
  34.            end;
  35.        '9':begin
  36.             xpoz := xpoz + speed*multi;
  37.             ypoz := ypoz + speed;
  38.            end;
  39.        '6':begin
  40.             xpoz := xpoz + speed*multi;
  41.            end;
  42.        '3':begin
  43.             xpoz := xpoz + speed*multi;
  44.             ypoz := ypoz - speed;
  45.            end;
  46.        '2':begin
  47.             ypoz := ypoz - speed;
  48.            end;
  49.        '1':begin
  50.             xpoz := xpoz - speed*multi;
  51.             ypoz := ypoz - speed;
  52.            end;
  53.       end;     {....................................case                     }
  54.       if Xpoz < 0 then Xpoz := 0;
  55.       if XPoz > 639 then Xpoz := 639;
  56.       if Ypoz < 0 then Ypoz := 0;
  57.       if Ypoz > 239 then Ypoz := 239;
  58.       movXhair(size,xpoz,ypoz);
  59.  
  60. end;
  61.  
  62.  
  63. {----------------- Notes on cross hair use ----------------------------------
  64.   The first time the crosshair is used in a program it must be called by
  65.   the procedure 'initXhair'.  Each following reference to the crosshair can
  66.   be done by 'movXhair'.  The exception is when any other reference is made to
  67.   any of the graphics calls.  Once another call has been made the crosshair
  68.   must be re-initalized.  This is done by calling 'reInitXhair'.  The cross-
  69.   hair is turned off by 'offXhair'.  The size is set by a constant in the
  70.   toolbox.  It can be any size.
  71.  ----------------------------------------------------------------------------}
  72.  
  73.  
  74. procedure DrawNext(    size      :integer;   {...Draws line from last point }
  75.                    var x1,y1     :integer;
  76.                        Xpoz,Ypoz :integer);  { and updates point            }
  77. begin
  78.   moveto(x1,y1);
  79.   offxhair(size,xpoz,ypoz);
  80.   drawto(xpoz,ypoz);
  81.   initxhair(size,xpoz,ypoz);
  82.   x1 := xpoz;
  83.   y1 := ypoz;
  84. end;
  85.  
  86.  
  87. procedure LineNext(    size      :integer;   {...Draws line from last point }
  88.                        x1,y1     :integer;
  89.                        Xpoz,Ypoz :integer);
  90. begin
  91.   moveto(x1,y1);
  92.   offxhair(size,xpoz,ypoz);
  93.   drawto(xpoz,ypoz);
  94.   initxhair(size,xpoz,ypoz);
  95. end;
  96.  
  97.  
  98.  
  99. procedure InitDefault;  {......... all var's are global }
  100. begin
  101.  clrscr;
  102.  gotoXY(20,20);
  103.  write('Your Num-Lock must be on !!!');
  104.  delay(2000);
  105.  clrscr;
  106.  vLineStyle := 'Solid';
  107.  vLineColor := 'White';
  108.  vFillStyle := 'Solid';
  109.  vFillIndex := 1;
  110.  vFillColor := 'White';
  111.  vWriteMode := 'Replace';
  112.  Size := 5;
  113.  speed := 1;
  114.  Xpoz := 0;
  115.  Ypoz := 0;
  116.  x1   := 0;
  117.  y1   := 0;
  118.  MoveTo(Xpoz,Ypoz);
  119. end;
  120.  
  121.  
  122.  
  123. procedure SetTypes; {.......sorry, everything is global }
  124.  
  125. var i,j,k      :integer;
  126. begin
  127.  if vLineStyle =  'Solid'       then SetLine(1);
  128.  if vLineStyle =  'Dashed'      then SetLine(2);
  129.  if vLineStyle =  'Dotted'      then SetLine(3);
  130.  if vLineStyle =  'Dash-Dot'    then SetLine(4);
  131.  if vLineStyle =  'Long-Dash'   then SetLine(5);
  132.  if vLineStyle =  'Short-Dash'  then SetLine(6);
  133.  if vLineStyle =  'Dot-Dot-Dash' then SetLine(7);
  134.  if vLineStyle =  'Long-Dot'     then SetLine(8);
  135.  
  136.  if vLineColor = 'White' then LineColor(1)
  137.  else LineColor(0);
  138.  if vFillColor = 'White' then  i := 1
  139.  else  i := 0;
  140.  if vFillStyle = 'Hollow'  then FillTypes(0,vFillIndex,i);
  141.  if vFillStyle = 'Solid'   then FillTypes(1,vFillIndex,i);
  142.  if vFillStyle = 'Pattern' then FillTypes(2,vFillIndex,i);
  143.  if vFillStyle = 'Hatched' then FillTypes(3,vFillIndex,i);
  144.  if vWriteMode = 'Replace'     then WriteMode(1);
  145.  if vWriteMode = 'Fill'        then WriteMode(2);
  146.  if vWriteMode = 'OverWrite'   then WriteMode(3);
  147.  if vWriteMode = 'Reverse'     then WriteMode(4);
  148. end;
  149.  
  150.