Category : Pascal Source Code
Archive   : EDITOR.ZIP
Filename : SUPERWIN.PAS

unit SuperWin;

{
SuperWin v. 3.0
By William Russell, 07/19/89.
SuperWin is a unit for creating nice looking text windows.
}


interface


uses
CRT;


const MaxColumns = 80; { Columns accross the screen }


type
TypeScreenString = string [MaxColumns];


var Border : array [1..10] of string[8];
MenuChoice : array [1..20] of string[MaxColumns];
CallChars : array [1..20] of char;
Largest,
MaxChoices : byte;


procedure ClrWin ( X1,
Y1,
X2,
Y2,
BackColor : integer);

{ Clears the area from the upper-left-hand corner (X1,Y1) to the
lower-right-hand corner, then sets the active window size to the size
of the entire screen. }


function StringOf ( ASCIIValue,
Times : byte) : TypeScreenString;

{ Returns a string composed of the character whose ASCII value is ASCIIValue
made up of Times characters. }


procedure SolidWindow ( X1,
Y1,
X2,
Y2 : byte;
Border : string);

{ Creates a window from (X1,Y1) to (X2,Y2) on the screen. The border of the
window is made of the characters in the string Border. }


procedure PieceExplode ( X1,
Y1,
X2,
Y2,
Fore,
Back,
FullBack,
speed,
jump : byte;
Border : string;
EffectsOn : Boolean );


{ Explodes horizontally first then vertical, the finsihed window has the
upper - left coordinates as ( x1, y1 ) and the lower right coordinates
of ( x2, y2 ).

Fore - the foreground color number
Back - the background color number of border
FullBack - the windows full background color
speed - the speed in which to open
jump - skips the number of windows specified
border - a six character string for the border
EffectsOn - put true if you want sound effects

}


procedure ExplodeWindow ( X1,
Y1,
X2,
Y2,
Foreground,
Background,
FullBack,
Speed,
Jump : byte;
Border : String;
EffectsOn : boolean);

{ Explodes a window onto the screen, the final window having the
upper - left coordinates of ( x1, y1 ) and the lower - right coordinates
of ( x2, y2 )


Foreground - the foreground color number
Background - the background color number of the border
FullBack - the full background color of the window
speed - the speed in which to open
jump - skips the number of windows specified
border - a six character string for the border
EffectsOn - put true if you want sound effects

}

implementation


procedure ClrWin ( X1,
Y1,
X2,
Y2,
BackColor : integer);

begin
window (X1, Y1, X2, Y2);
textbackground ( BackColor );
Clrscr;
window (1, 1, 80, 25)
end;


function StringOf ( ASCIIValue,
Times : byte) : TypeScreenString;

var
Counter : byte;
TempString : TypeScreenString;

begin
TempString := '';
for Counter := 1 to Times do
TempString := TempString + chr ( ASCIIValue );
StringOf := TempString
end;


procedure SolidWindow ( X1,
Y1,
X2,
Y2 : byte;
Border : String);
var
Top,
Bottom : TypeScreenString;
st,
fn,
i : byte;

begin
Top := Border[1] + StringOf ( ord ( Border[5] ), ( X2-1 ) -X1 ) +Border[2];
Bottom := Border[3] + StringOf ( ord ( Border[5] ), ( X2-1 ) -X1 ) +Border[4];
st := Y1 + 1;
fn := Y2 - 1;
gotoxy ( X1, Y1 );
WriteLn ( output, Top);
for i := st to fn do
begin
gotoxy( X1, i );
write ( output, Border[6] );
gotoxy( X2,i );
writeln ( output, Border[6] );
end;
gotoxy ( X1, Y2 );
write ( output, Bottom );
end;

procedure PieceExplode ( X1,
Y1,
X2,
Y2,
Fore,
Back, { Background of Border }
FullBack, { Windowed Background }
speed,
jump : byte;
Border : string;
EffectsOn : Boolean );

const
Max = 50;

var
x,
i,
midx,
midy : byte;
hincx,
hincy : real;
st,
fn,
nX1,
nY1,
nX2,
nY2 : array[1..Max] of byte;
tone : integer;



begin
midx := round( ( X2-X1 ) /2 ) + X1;
midy := round( ( Y2-Y1 ) /2 ) + Y1;
hincx := ( ( X2-X1 ) /Speed ) /2;
hincy := ( ( Y2-Y1 ) /Speed ) /2;
Jump := Jump + 1; { Jump can't equal 0 or program screws up }
Speed := Speed - 1;

for i := Jump to Speed do
begin
nX1[i] := midx - ( round ( i*hincx ) );
nY1[i] := midy - ( round ( i*hincy ) );
nX2[i] := midx + ( round ( i*hincx ) );
nY2[i] := midy + ( round ( i*hincy ) );
st[i] := nY1[i] + 1;
fn[i] := nY2[i] - 1;
end;

If EffectsOn then
begin
for tone := 2000 downto 1000 do
sound ( tone );
for tone := 1000 to 2000 do
sound ( tone );
Nosound;
end;

for i := Jump to Speed do { Horizontal opening }
begin
TextColor ( Fore );
TextBackground ( Back );
GotoXy ( nX1[i], nY1[i] );
Write ( output, StringOf ( ord ( Border[5] ), (nX2[i]-nX1[i]) + 1 ) );
GotoXy ( nX1[i], nY2[i] );
Write ( output, StringOf ( ord ( Border[5] ), (nX2[i]-nX1[i]) + 1 ) );
Clrwin ( nx1[i], ny1[i], nx2[i], ny2[i], FullBack );
end;

for i := Jump to Speed do { Vertical Opening }
begin
Clrwin ( nx1[i], ny1[i], nx2[i], ny2[i], FullBack );
TextColor ( Fore );
TextBackGround ( Back );
for x := st[i] to fn[i] do
begin
GotoXY ( nX1[i], x );
Write ( output, Border[6] );
GotoXY ( nX2[i], x );
Write ( output, Border[6] );
end;
end;

NoSound;
ClrWin ( X1, Y1, X2, Y2, FullBack );
TextColor ( Fore );
TextBackground ( Back );
SolidWindow ( X1, Y1, X2, Y2, Border );
end;



procedure ExplodeWindow ( X1,
Y1,
X2,
Y2,
Foreground,
Background, { Back color of border }
FullBack, { Windowed background }
Speed,
Jump : byte;
Border : string;
EffectsOn : boolean);


const
Max = 50;

var
i,
midx,
midy : byte;
hincx,
hincy : real;
st : array[1..Max] of byte;
fn : array[1..Max] of byte;
nX1 : array[1..Max] of byte;
nY1 : array[1..Max] of byte;
nX2 : array[1..Max] of byte;
nY2 : array[1..Max] of byte;
tone : integer;

begin
midx := round( ( X2-X1 ) /2 ) + X1;
midy := round( ( Y2-Y1 ) /2 ) + Y1;
hincx := ( ( X2-X1 ) /Speed ) /2;
hincy := ( ( Y2-Y1 ) /Speed ) /2;
Jump := Jump + 1; { Jump can't equal 0 or program screws up }
Speed := Speed - 1;

for i := Jump to Speed do
begin
nX1[i] := midx - ( round ( i*hincx ) );
nY1[i] := midy - ( round ( i*hincy ) );
nX2[i] := midx + ( round ( i*hincx ) );
nY2[i] := midy + ( round ( i*hincy ) );
st[i] := nY1[i] + 1;
fn[i] := nY2[i] - 1;
end;

If EffectsOn then
begin
for tone := 2000 downto 1000 do
sound ( tone );
for tone := 1000 to 2000 do
sound ( tone );
Nosound;
end;

for i:=Jump to Speed do
begin
TextColor ( Foreground );
TextBackground ( Background );
SolidWindow ( nX1[i], nY1[i], nX2[i], nY2[i], Border );
ClrWin ( nX1[i], nY1[i], nX2[i], nY2[i], FullBack );
end;

NoSound;
ClrWin ( X1, Y1, X2, Y2, FullBack );
TextColor ( Foreground );
TextBackground ( Background );
SolidWindow( X1, Y1, X2, Y2, Border );
end;

begin
Border[1] := '++++-|[]';
Border[2] := 'Ú¿ÀÙij´Ã';
Border[3] := 'ɻȼͺµÆ';
Border[4] := 'ַӽĺ´Ã';
Border[5] := 'ոԾͳµÆ';
Border[6] := 'ÛÛÛÛÛÛÛÛ';
Border[7] := '°°°°°°°°';
Border[8] := '±±±±±±±±';
Border[9] := '²²²²²²²²';
Border[10]:= 'xxxxxxxx';


{ Border[10] is open for the user of the program to make }


end.