home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SUPRWIN3.ZIP / SUPERWIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  8.4 KB  |  340 lines
  1. unit SuperWin;
  2.  
  3. {
  4. SuperWin v. 3.0
  5. By William Russell, 07/19/89.
  6. SuperWin is a unit for creating nice looking text windows.
  7. }
  8.  
  9.  
  10. interface
  11.  
  12.  
  13. uses
  14.   CRT;
  15.  
  16.  
  17. const MaxColumns = 80;  { Columns accross the screen }
  18.  
  19.  
  20. type
  21.   TypeScreenString = string [MaxColumns];
  22.  
  23.  
  24. var Border : array [1..10] of string;
  25.  
  26.  
  27. procedure ClrWin (  X1,
  28.                     Y1,
  29.                     X2,
  30.                     Y2  : integer);
  31.  
  32. { Clears the area from the upper-left-hand corner (X1,Y1) to the
  33.   lower-right-hand corner, then sets the active window size to the size
  34.   of the entire screen. }
  35.  
  36.  
  37. function StringOf (    ASCIIValue,
  38.                        Times       : byte) : TypeScreenString;
  39.  
  40. { Returns a string composed of the character whose ASCII value is ASCIIValue
  41.   made up of Times characters. }
  42.  
  43.  
  44. procedure SolidWindow (    X1,
  45.                             Y1,
  46.                             X2,
  47.                             Y2     : byte;
  48.                             Border : string);
  49.  
  50. { Creates a window from (X1,Y1) to (X2,Y2) on the screen. The border of the
  51.   window is made of the characters in the string Border. }
  52.  
  53.  
  54. procedure PieceExplode ( X1,
  55.                          Y1,
  56.                          X2,
  57.                          Y2,
  58.                          Fore,
  59.                          Back,
  60.                          speed,
  61.                          jump      : byte;
  62.                          Border    : string;
  63.                          EffectsOn : Boolean );
  64.  
  65.  
  66. { Explodes horizontally first then vertical, the finsihed window has the
  67.   upper - left coordinates as ( x1, y1 ) and the lower right coordinates
  68.   of ( x2, y2 ).
  69.  
  70.                      Fore      -  the foreground color number
  71.                      Back      -  the background color number
  72.                      speed     -  the speed in which to open
  73.                      jump      -  skips the number of windows specified
  74.                      border    -  a six character string for the border
  75.                      EffectsOn -  put true if you want sound effects
  76.  
  77. }
  78.  
  79.  
  80. procedure ExplodeWindow (    X1,
  81.                               Y1,
  82.                               X2,
  83.                               Y2,
  84.                               Foreground,
  85.                               Background,
  86.                               Speed,
  87.                               Jump        : byte;
  88.                               Border      : String;
  89.                               EffectsOn   : boolean);
  90.  
  91. { Explodes a window onto the screen, the final window having the
  92.   upper - left coordinates of ( x1, y1 ) and the lower - right coordinates
  93.   of ( x2, y2 )
  94.  
  95.  
  96.                   Foreground -  the foreground color number
  97.                   Background -  the background color number
  98.                   speed      -  the speed in which to open
  99.                   jump       -  skips the number of windows specified
  100.                   border     -  a six character string for the border
  101.                   EffectsOn  -  put true if you want sound effects
  102.  
  103. }
  104.  
  105. implementation
  106.  
  107.  
  108. procedure ClrWin (  X1,
  109.                     Y1,
  110.                     X2,
  111.                     Y2  : integer);
  112.  
  113. begin
  114.   window (X1, Y1, X2, Y2);
  115.   textbackground ( 0 );
  116.   Clrscr;
  117.   window (1, 1, 80, 25)
  118. end;
  119.  
  120.  
  121. function StringOf (    ASCIIValue,
  122.                        Times       : byte) : TypeScreenString;
  123.  
  124. var
  125.   Counter    : byte;
  126.   TempString : TypeScreenString;
  127.  
  128. begin
  129.  TempString := '';
  130.  for Counter := 1 to Times do
  131.    TempString := TempString + chr ( ASCIIValue );
  132.  StringOf := TempString
  133. end;
  134.  
  135.  
  136. procedure SolidWindow (    X1,
  137.                             Y1,
  138.                             X2,
  139.                             Y2     : byte;
  140.                             Border : String);
  141. var
  142.   Top,
  143.   Bottom : TypeScreenString;
  144.   st,
  145.   fn,
  146.   i      : byte;
  147.  
  148. begin
  149.  Top := Border[1] + StringOf ( ord ( Border[5] ), ( X2-1 ) -X1 ) +Border[2];
  150.  Bottom := Border[3] + StringOf ( ord ( Border[5] ), ( X2-1 ) -X1 ) +Border[4];
  151.  st := Y1 + 1;
  152.  fn := Y2 - 1;
  153.  gotoxy ( X1, Y1 );
  154.  WriteLn ( output, Top);
  155.  for i := st to fn do
  156.   begin
  157.    gotoxy( X1, i );
  158.    write ( output, Border[6] );
  159.    gotoxy( X2,i );
  160.    writeln ( output, Border[6] );
  161.   end;
  162.  gotoxy ( X1, Y2 );
  163.  write ( output, Bottom );
  164. end;
  165.  
  166. procedure PieceExplode ( X1,
  167.                          Y1,
  168.                          X2,
  169.                          Y2,
  170.                          Fore,
  171.                          Back,
  172.                          speed,
  173.                          jump      : byte;
  174.                          Border    : string;
  175.                          EffectsOn : Boolean );
  176.  
  177. const
  178.   Max = 50;
  179.  
  180. var
  181.     x,
  182.     i,
  183.     midx,
  184.     midy   : byte;
  185.     hincx,
  186.     hincy  : real;
  187.     st,
  188.     fn,
  189.     nX1,
  190.     nY1,
  191.     nX2,
  192.     nY2    : array[1..Max] of byte;
  193.     tone   : integer;
  194.  
  195.  
  196.  
  197. begin
  198.  midx := round( ( X2-X1 ) /2 ) + X1;
  199.  midy := round( ( Y2-Y1 ) /2 ) + Y1;
  200.  hincx := ( ( X2-X1 ) /Speed ) /2;
  201.  hincy := ( ( Y2-Y1 ) /Speed ) /2;
  202.  Jump := Jump + 1;            { Jump can't equal 0 or program screws up }
  203.  Speed := Speed - 1;
  204.  
  205.  for i := Jump to Speed do
  206.   begin
  207.    nX1[i] := midx - ( round ( i*hincx ) );
  208.    nY1[i] := midy - ( round ( i*hincy ) );
  209.    nX2[i] := midx + ( round ( i*hincx ) );
  210.    nY2[i] := midy + ( round ( i*hincy ) );
  211.    st[i] := nY1[i] + 1;
  212.    fn[i] := nY2[i] - 1;
  213.   end;
  214.  
  215.  TextColor ( Fore );
  216.  TextBackground ( Back );
  217.  
  218.  If EffectsOn then
  219.   begin
  220.    for tone := 2000 downto 1000 do
  221.     sound ( tone );
  222.    for tone := 1000 to 2000 do
  223.     sound ( tone );
  224.    Nosound;
  225.   end;
  226.  
  227.  for i := Jump to Speed do         { Horizontal opening }
  228.   begin
  229.    GotoXy ( nX1[i], nY1[i] );
  230.    Write ( output, StringOf ( ord ( Border[5] ), (nX2[i]-nX1[i]) + 1 ) );
  231.    GotoXy ( nX1[i], nY2[i] );
  232.    Write ( output, StringOf ( ord ( Border[5] ), (nX2[i]-nX1[i]) + 1 ) );
  233.    Clrwin ( nx1[i], ny1[i], nx2[i], ny2[i] );
  234.   end;
  235.  
  236.  for i := Jump to Speed do         { Vertical Opening }
  237.   begin
  238.    Clrwin ( nx1[i], ny1[i], nx2[i], ny2[i] );
  239.     for x := st[i] to fn[i] do
  240.      begin
  241.       GotoXY ( nX1[i], x );
  242.       Write ( output, Border[6] );
  243.       GotoXY ( nX2[i], x );
  244.       Write ( output, Border[6] );
  245.     end;
  246.    end;
  247.  
  248.  NoSound;
  249.  TextColor ( Fore );
  250.  TextBackground ( Back );
  251.  ClrWin ( X1, Y1, X2, Y2 );
  252.  SolidWindow ( X1, Y1, X2, Y2, Border );
  253.  end;
  254.  
  255.  
  256.  
  257. procedure ExplodeWindow (     X1,
  258.                               Y1,
  259.                               X2,
  260.                               Y2,
  261.                               Foreground,
  262.                               Background,
  263.                               Speed,
  264.                               Jump        : byte;
  265.                               Border      : string;
  266.                               EffectsOn   : boolean);
  267.  
  268.  
  269. const
  270.   Max = 50;
  271.  
  272. var
  273.     i,
  274.     midx,
  275.     midy   : byte;
  276.     hincx,
  277.     hincy  : real;
  278.     st     : array[1..Max] of byte;
  279.     fn     : array[1..Max] of byte;
  280.     nX1    : array[1..Max] of byte;
  281.     nY1    : array[1..Max] of byte;
  282.     nX2    : array[1..Max] of byte;
  283.     nY2    : array[1..Max] of byte;
  284.     tone   : integer;
  285.  
  286. begin
  287.  midx := round( ( X2-X1 ) /2 ) + X1;
  288.  midy := round( ( Y2-Y1 ) /2 ) + Y1;
  289.  hincx := ( ( X2-X1 ) /Speed ) /2;
  290.  hincy := ( ( Y2-Y1 ) /Speed ) /2;
  291.  Jump := Jump + 1;            { Jump can't equal 0 or program screws up }
  292.  Speed := Speed - 1;
  293.  
  294.  for i := Jump to Speed do
  295.   begin
  296.    nX1[i] := midx - ( round ( i*hincx ) );
  297.    nY1[i] := midy - ( round ( i*hincy ) );
  298.    nX2[i] := midx + ( round ( i*hincx ) );
  299.    nY2[i] := midy + ( round ( i*hincy ) );
  300.    st[i] := nY1[i] + 1;
  301.    fn[i] := nY2[i] - 1;
  302.   end;
  303.  
  304.  If EffectsOn then
  305.   begin
  306.    for tone := 2000 downto 1000 do
  307.     sound ( tone );
  308.    for tone := 1000 to 2000 do
  309.     sound ( tone );
  310.    Nosound;
  311.   end;
  312.  
  313.  for i:=Jump to Speed do
  314.   begin
  315.    TextColor ( Foreground );
  316.    TextBackground ( Background );
  317.    SolidWindow ( nX1[i], nY1[i], nX2[i], nY2[i], Border );
  318.    ClrWin ( nX1[i], nY1[i], nX2[i], nY2[i] );
  319.   end;
  320.  
  321.  NoSound;
  322.  TextColor ( Foreground );
  323.  TextBackground ( Background );
  324.  SolidWindow( X1, Y1, X2, Y2, Border );
  325.  end;
  326.  
  327. begin
  328.   Border[1] := '++++-|';
  329.   Border[2] := '┌┐└┘─│';
  330.   Border[3] := '╔╗╚╝═║';
  331.   Border[4] := '╓╖╙╜─║';
  332.   Border[5] := '╒╕╘╛═│';       { All these can be edited from the main file }
  333.   Border[6] := '██████';
  334.   Border[7] := '░░░░░░';
  335.   Border[8] := '▒▒▒▒▒▒';
  336.   Border[9] := '▓▓▓▓▓▓';
  337.  
  338. { Border[10] is open for the user of the program to make }
  339.  
  340. end.