399 lines
9.2 KiB
Plaintext
399 lines
9.2 KiB
Plaintext
unit VFx; { Visual Effects - by RoboCop of nOOb <Robo.Cop@gmx.net>}
|
||
|
||
interface
|
||
uses Crt;
|
||
const drwdmax: integer=1000;
|
||
fxwd: integer=750;
|
||
var CenterPos, CWS: byte;
|
||
procedure ReadyBeep;
|
||
procedure WaitBeep;
|
||
procedure ErrorBeep;
|
||
procedure AckBeep;
|
||
procedure WinBeep;
|
||
procedure DrawBorder(MaxX,MaxY: integer; TCol,BCol: integer; BType: integer);
|
||
procedure DrawBorder2(x1,y1,x2,y2,FG,BG: byte);
|
||
procedure WriteLR(text: string; col: integer);
|
||
procedure FXWrite(text: string; finc: integer);
|
||
procedure FXWriteC(text: string; finc: integer);
|
||
procedure CWrite(st: string);
|
||
procedure CWriteLn(st: string);
|
||
procedure WriteC(st: string);
|
||
procedure WriteCLn(st: string);
|
||
procedure CursorOff;
|
||
procedure CursorOn;
|
||
procedure WStat(opt: string);
|
||
procedure Wcheck(stat: string);
|
||
function Space(len: integer): string;
|
||
function Num2Str(x: longint): string;
|
||
function MultiChar(ch: string; len: integer): string;
|
||
procedure TWriteLn(tx: string);
|
||
|
||
implementation
|
||
|
||
procedure WinBeep;
|
||
begin
|
||
Sound(1000);
|
||
Delay(100);
|
||
NoSound;
|
||
Delay(200);
|
||
Sound(1000);
|
||
Delay(50);
|
||
NoSound;
|
||
Delay(100);
|
||
Sound(1000);
|
||
Delay(50);
|
||
NoSound;
|
||
Delay(100);
|
||
Sound(1400);
|
||
Delay(750);
|
||
NoSound;
|
||
end;
|
||
|
||
procedure ReadyBeep; { inspired by Norton Speed Disk for DOS }
|
||
begin
|
||
Sound(800);
|
||
Delay(50);
|
||
NoSound;
|
||
Delay(50);
|
||
Sound(1000);
|
||
Delay(50);
|
||
NoSound;
|
||
Delay(50);
|
||
Sound(1200);
|
||
Delay(50);
|
||
NoSound;
|
||
end;
|
||
|
||
procedure WaitBeep; { inspired by the GameBoy-Game "Tetris" }
|
||
var i: integer;
|
||
begin
|
||
for i:=1 to 2 do begin
|
||
Sound(720);
|
||
Delay(70);
|
||
NoSound;
|
||
Delay(70);
|
||
Sound(1500);
|
||
Delay(70);
|
||
NoSound;
|
||
Delay(70);
|
||
end;
|
||
end;
|
||
|
||
procedure ErrorBeep;
|
||
begin
|
||
Sound(100);
|
||
Delay(200);
|
||
NoSound;
|
||
end;
|
||
|
||
procedure AckBeep;
|
||
begin
|
||
Sound(1200);
|
||
Delay(25);
|
||
NoSound;
|
||
end;
|
||
|
||
procedure DrawBorder(MaxX,MaxY: integer; TCol, BCol: integer; BType: integer);
|
||
var i,j: integer;
|
||
lx,rx,oy,uy,mx,my: integer;
|
||
DrwDelay, FilDelay: integer;
|
||
Border: string[8];
|
||
begin
|
||
CursorOff;
|
||
window(1,1,80,25);
|
||
if (MaxX=0) AND (MaxY=0) AND (TCol=0) AND (BCol=0) then Exit;
|
||
if BType=1 then Border := 'ڿ<>ٳ<EFBFBD><D9B3><EFBFBD>';
|
||
if BType=2 then Border := 'ɻȼ<C9BB><C8BC><EFBFBD><EFBFBD>';
|
||
if BType=3 then Border := 'ոԾ<D5B8><D4BE><EFBFBD><EFBFBD>';
|
||
if BType=4 then Border := 'ַӽ<D6B7><D3BD><EFBFBD><EFBFBD>';
|
||
if BType=5 then Border := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
|
||
if BType=6 then Border := 'ڷԼ<DAB7><D4BC><EFBFBD><EFBFBD>';
|
||
lx := 41-MaxX; oy := 13-MaxY; rx := 40+MaxX; uy := 12+MaxY;
|
||
mx := 40; my := 12; DrwDelay := drwdmax div (2*MaxX);
|
||
if drwdmax > 0 then FilDelay := 1 else FilDelay := 0;
|
||
TextColor(TCol); TextBackground(BCol);
|
||
for i:=mx downto lx+1 do begin
|
||
GotoXY(i,oy); Write(Border[7]);
|
||
GotoXY((rx+1)-i+lx-1,oy); Write(Border[7]);
|
||
Delay(DrwDelay);
|
||
end;
|
||
GotoXY(lx,oy); Write(Border[1]);
|
||
GotoXY(rx,oy); Write(Border[2]);
|
||
Delay(DrwDelay);
|
||
for i:=oy+1 to uy-1 do begin
|
||
GotoXY(lx,i); Write(Border[5]);
|
||
GotoXY(rx,i); Write(Border[6]);
|
||
Delay(DrwDelay);
|
||
end;
|
||
GotoXY(lx,uy); Write(Border[3]);
|
||
GotoXY(rx,uy); Write(Border[4]);
|
||
Delay(DrwDelay);
|
||
for i:=lx+1 to mx do begin
|
||
GotoXY(i,uy); Write(Border[8]);
|
||
GotoXY((rx+1)-i+lx-1,uy); Write(Border[8]);
|
||
Delay(DrwDelay);
|
||
end;
|
||
for i:=lx+1 to rx-1 do begin
|
||
for j:=oy+1 to uy-1 do begin
|
||
GotoXY(i,j); Write(' ');
|
||
Delay(FilDelay);
|
||
end;
|
||
end;
|
||
CenterPos := (rx-lx) div 2; window(lx+2,oy+1,rx-2,uy-1);
|
||
CursorOn;
|
||
end;
|
||
|
||
procedure DrawBorder2(x1,y1,x2,y2,FG,BG: byte);
|
||
const frame='<27>';
|
||
var i,j,xlen,ylen: byte;
|
||
tox,toy: byte;
|
||
xc,yc: byte;
|
||
max: byte;
|
||
DDel: byte;
|
||
begin
|
||
CursorOff;
|
||
xlen := (x2-x1);
|
||
ylen := (y2-y1);
|
||
TextColor(FG);
|
||
TextBackground(BG);
|
||
if xlen>ylen then max:=xlen else max:=ylen;
|
||
DDel:=400 DIV max;
|
||
for i:=0 to max do begin
|
||
tox:=(xlen*i) DIV max;
|
||
toy:=(ylen*i) DIV max;
|
||
|
||
for j:=0 to 100 do begin
|
||
xc := (x1+(tox*(100-j) DIV 100));
|
||
yc := (y1+(toy*j DIV 100));
|
||
if (xc>x1) AND (yc>y1) AND (xc<x2) AND (yc<y2) then begin
|
||
GotoXY(xc,yc);
|
||
Write(' ');
|
||
end;
|
||
xc := (x2-(tox*(100-j) DIV 100));
|
||
yc := (y2-(toy*j DIV 100));
|
||
if (xc>x1) AND (yc>y1) AND (xc<x2) AND (yc<y2) then begin
|
||
GotoXY(xc,yc);
|
||
Write(' ');
|
||
end;
|
||
end;
|
||
|
||
GotoXY(x1+tox,y1);
|
||
Write(frame);
|
||
GotoXY(x1,y1+toy);
|
||
Write(frame);
|
||
GotoXY(x2-tox,y2);
|
||
Write(frame);
|
||
GotoXY(x2,y2-toy);
|
||
Write(frame);
|
||
Delay(DDel);
|
||
end;
|
||
for i:=x1+1 to x2-1 do begin
|
||
for j:=y1+1 to y2-1 do begin
|
||
GotoXY(i,j);
|
||
Write(' ');
|
||
end;
|
||
end;
|
||
CursorOn;
|
||
end;
|
||
|
||
procedure WriteLR(text: string; col: integer);
|
||
var i,del: integer;
|
||
begin
|
||
TextColor(col);
|
||
del := fxwd div Length(text);
|
||
if (del>75) then del := 75;
|
||
for i:=1 to Length(text) do begin
|
||
Write(text[i]);
|
||
Delay(del);
|
||
end;
|
||
end;
|
||
|
||
procedure FXWrite(text: string; finc: integer);
|
||
var x,y,i: integer;
|
||
finc2: integer;
|
||
Del1: integer;
|
||
begin
|
||
x := WhereX;
|
||
y := WhereY;
|
||
Del1 := fxwd div Length(text);
|
||
if (Del1>75) then Del1 := 75;
|
||
for i:=1 to Length(text) do begin
|
||
GotoXY(x+i-1,y); TextColor(15); Write(text[i]);
|
||
if i>1 then begin
|
||
GotoXY(x+i-2,y);
|
||
TextColor(7);
|
||
Write(text[i-1]);
|
||
end;
|
||
if i>2 then begin
|
||
GotoXY(x+i-3,y);
|
||
TextColor(8);
|
||
Write(text[i-2]);
|
||
end;
|
||
Delay(Del1);
|
||
end;
|
||
GotoXY(x+Length(text)-1,y); TextColor(7); Write(text[Length(text)]);
|
||
if Length(text)>1 then begin
|
||
GotoXY(x+Length(text)-2,y);
|
||
TextColor(8);
|
||
Write(text[Length(text)-1]);
|
||
end;
|
||
Delay(Del1);
|
||
GotoXY(x+Length(text)-1,y); TextColor(8); Write(text[Length(text)]);
|
||
Delay(Del1*3);
|
||
if finc<=blink then begin
|
||
if finc<8 then finc2 := finc+8 else finc2 := finc-8;
|
||
end else begin
|
||
if finc<8+blink then finc2 := finc+8 else finc2 := finc-8;
|
||
end;
|
||
if finc=8 then finc2 := 15;
|
||
if finc=15 then begin
|
||
GotoXY(x,y); TextColor(8); Write(text); Delay(100);
|
||
end;
|
||
GotoXY(x,y); TextColor(finc2); Write(text);
|
||
Delay(100);
|
||
if finc=8 then begin
|
||
GotoXY(x,y); TextColor(7); Write(text); Delay(100);
|
||
end;
|
||
GotoXY(x,y); TextColor(finc); Write(text);
|
||
end;
|
||
|
||
procedure FXWriteC(text: string; finc: integer);
|
||
begin
|
||
GotoXY(40-Length(text) div 2,WhereY);
|
||
FXWrite(text,finc);
|
||
end;
|
||
|
||
procedure CWrite(st: string);
|
||
var i,j,k: integer;
|
||
FG,BG,err: integer;
|
||
last: integer;
|
||
cod: string;
|
||
begin
|
||
last := 1;
|
||
for i:=1 to Length(st) do begin
|
||
if Copy(st,i,2)='%%' then begin
|
||
Write(Copy(st,last,i-last)); { all before the CC }
|
||
for j:=i to Length(st) do begin
|
||
if Copy(st,j,1)='#' then begin
|
||
last := j+1;
|
||
cod := Copy(st,i+2,j-i-2);
|
||
for k:=1 to Length(cod) do begin
|
||
if Copy(cod,k,1)=',' then begin
|
||
Val(Copy(cod,1,k-1),FG,err);
|
||
if err=0 then TextColor(FG);
|
||
Val(Copy(cod,k+1,Length(cod)-k),BG,err);
|
||
if err=0 then TextBackground(BG);
|
||
end else begin
|
||
Val(cod,FG,err);
|
||
if err=0 then TextColor(FG);
|
||
end;
|
||
end;
|
||
break;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
Write(Copy(st,last,Length(st)-last+1));
|
||
end;
|
||
|
||
procedure CWriteLn(st: string);
|
||
begin
|
||
CWrite(st);
|
||
WriteLn;
|
||
end;
|
||
|
||
procedure WriteC(st: string);
|
||
begin
|
||
GotoXY(CenterPos-Length(st) div 2,WhereY);
|
||
Write(st);
|
||
end;
|
||
|
||
procedure WriteCLn(st: string);
|
||
begin
|
||
GotoXY(CenterPos-Length(st) div 2,WhereY);
|
||
WriteLn(st);
|
||
end;
|
||
|
||
procedure CursorOff;assembler; { Schaltet den Cursor ab - schnell und zuverl<72>ssig }
|
||
asm
|
||
xor ax,ax
|
||
mov ah,01h
|
||
mov ch,20h
|
||
mov cl,20h
|
||
int 10h
|
||
end;
|
||
|
||
procedure CursorOn;assembler; { Schaltet den Blinker wieder an }
|
||
asm
|
||
mov ah,01h
|
||
mov cx,0607h
|
||
int 10h
|
||
end;
|
||
|
||
procedure WStat(opt: string);
|
||
var i: integer;
|
||
begin
|
||
if CWS=0 then CWS := WhereY;
|
||
GotoXY(1,CWS);
|
||
Write(opt);
|
||
Write(' ');
|
||
for i:=Length(opt) to 70 do begin
|
||
Write('.');
|
||
end;
|
||
CWriteLn(' %%7#[%%142#wait%%7#]');
|
||
end;
|
||
|
||
procedure Wcheck(stat: string);
|
||
begin
|
||
GotoXY(75,CWS);
|
||
CWriteLn(stat);
|
||
TextColor(7);
|
||
CWS := 0;
|
||
end;
|
||
|
||
function Space(len: integer): string;
|
||
var i: integer;
|
||
tmp: string;
|
||
begin
|
||
tmp := '';
|
||
for i:=1 to len do tmp:=tmp+' ';
|
||
Space := tmp;
|
||
end;
|
||
|
||
function Num2Str(x: longint): string;
|
||
var tmp: string;
|
||
begin
|
||
Str(x:0,tmp);
|
||
Num2Str := tmp;
|
||
end;
|
||
|
||
|
||
function MultiChar(ch: string; len: integer): string;
|
||
var i: integer;
|
||
tmp: string;
|
||
begin
|
||
tmp := '';
|
||
for i:=1 to len do tmp:=tmp+ch;
|
||
MultiChar := tmp;
|
||
end;
|
||
|
||
procedure TWriteLn(tx: string);
|
||
var wh: byte;
|
||
begin
|
||
wh := WhereY;
|
||
Write(tx);
|
||
ClrEol;
|
||
if wh<25 then begin
|
||
WriteLn;
|
||
ClrEol;
|
||
end else begin
|
||
GotoXY(1,1);
|
||
ClrEol;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
Write('<27> Loading Unit: Visual FX - RoboCop of nOOb <Robo.Cop@gmx.net> ... ');
|
||
CenterPos := 40;
|
||
WriteLn('OK');
|
||
end. |