home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / EXPLODIN.ZIP / EXPLODIN.INC next >
Encoding:
Text File  |  1986-06-10  |  3.0 KB  |  99 lines
  1. {      Module: Exploding Window V 01.02.00
  2.  
  3.    Programmer: Bryan Woodruff, Tucson Az.
  4.  Release date: 03-21-86
  5.       History: created 03-20-86
  6.                modified morning of 03-21-86
  7.  
  8.   Description: Exploding Window will expand a window from the center
  9.                of a box with given coordinates of Upper Left Hand corner
  10.                X and Y, and the Lower Right Hand corner X and Y. This module
  11.                uses a modified fastwrite procedure by Marshall Brain.
  12.  
  13.                Procedures included:
  14.  
  15.                Procedure Frame - given the upper left and lower right corners
  16.                                  and maskcode, will frame a window
  17.  
  18.                Procedure ExplodingWindow - expands window to given coordinates
  19.                                            with background and foreground
  20.                                            colors in maskcode
  21.  
  22.                Maskcode:=BackgroundColor * 16 + ForegroundColor
  23.  
  24.  
  25.                Send any inquiries to:
  26.  
  27.                Bryan Woodruff
  28.                8457 E. Beverly St.
  29.                Tucson, Az 85710                                               }
  30.  
  31. Type
  32.     string80 = string[80];
  33.  
  34. {$I FSTWRITE.INC}
  35.  
  36. Procedure Frame (UpperLeftX,
  37.                  UpperLeftY,
  38.                  LowerRightX,
  39.                  LowerRightY,
  40.                  maskcode:integer);
  41.    var
  42.       i: Integer;
  43.    begin
  44.       fastwrite(UpperLeftX,UpperLeftY,maskcode,Chr(213));
  45.       fastwrite(UpperLeftX,LowerRightY,maskcode,Chr(212));
  46.       fastwrite(LowerRightX,UpperLeftY,maskcode,Chr(184));
  47.       fastwrite(LowerRightX,LowerRightY,maskcode,Chr(190));
  48.       for I:=UpperLeftX+1 to LowerRightX-1 do
  49.           begin
  50.              fastwrite(I,UpperLeftY,maskcode,Chr(205));
  51.              fastwrite(I,LowerRightY,maskcode,Chr(205));
  52.           end;
  53.       for I:=UpperLeftY+1 to LowerRightY-1 do
  54.           begin
  55.              fastwrite(UpperLeftX,I,maskcode,Chr(179));
  56.              fastwrite(LowerRightX,I,maskcode,Chr(179));
  57.           end;
  58.    end;
  59.  
  60. Procedure ExplodingWindow ( UpperLeftX,
  61.                             UpperLeftY,
  62.                             LowerRightX,
  63.                             LowerRightY,
  64.                             maskcode:integer);
  65.    var
  66.       cx,cy,dx,dy,d,i,x1,x2,y1,y2:integer;
  67.       ix,iy: real;
  68.    begin
  69.       cx:=( UpperLeftX + LowerRightX ) div 2;
  70.       cy:=( UpperLeftY + LowerRightY ) div 2;
  71.       dx:=cx-UpperLeftX;
  72.       dy:=cy-UpperLeftY;
  73.       if dx>dy then
  74.          d:=dx div 4
  75.       else
  76.          d:=dy div 4;
  77.       ix:=dx / d; iy:=dy / d;
  78.       for i:=2 to d do
  79.           begin
  80.              x1:=round(cx-(ix*i));
  81.              x2:=round(cx+(ix*i));
  82.              y1:=round(cy-(iy*i));
  83.              y2:=round(cy+(iy*i));
  84.              Window(x1,y1,x2,y2);
  85.              textbackground(maskcode div 16);
  86.              clrscr;
  87.              Frame(x1,y1,x2,y2,maskcode);
  88.           end;
  89.    end;
  90.  
  91.   var maskcode:integer;
  92. BEGIN
  93.    clrscr;
  94.    maskcode:=red*16+blue;
  95.    ExplodingWindow(1,1,80,25,maskcode)
  96. END.
  97.  
  98.  
  99.