Category : Pascal Source Code
Archive   : AWRITE.ZIP
Filename : ANSIWRIT.PAS

 
Output of file : ANSIWRIT.PAS contained in archive : AWRITE.ZIP

{ Copyright (c) 1986 Eric Ryan-Lambart }
{ SysOp, The Corsair (213)-456-1121 2400, 1200 baud. }
{ Running TCBBS, written entirely in Turbo Pascal! }
{ }
{ These routines will write a string to the IBM }
{ ANSI.SYS driver, for using ANSI color graphics, }
{ cursor positioning, etc. }
{ }
{ If you like these routines, please call The Corsair }
{ Bulletin Board (number above) and offer a $5 donat- }
{ ion. Thank you and have fun! }
{ }
{ If you find anything wrong with this, please tell me! }

type
String10 = string[10];
String80 = string[80];

procedure ANSIWrite(Strng : String80);

{ Sends the string STRNG to the ANSI.SYS driver }

var
RgStr : record
case boolean of
true : (ax,bx,cx,dx,bp,si,di,ds,es,flags : integer);
false: (al,ah,bl,bh,cl,ch,dl,dh : byte);
end;

begin
with RgStr do
begin
bx := 1; { Sends all output to the screen }
cx := length(Strng);
ds := seg(Strng);
dx := ofs(Strng) + 1;
ah := $40; { Write to a file or device command }
end;
msdos(Rgstr);
end; { ANSIWrite }

function Color(Fore,Back : integer) : String10;

{ specify Color(Foreground Color, Background color) }

{ You can use the Turbo Pascal predefined constants
Black, Blue, Green, Cyan, Red, Magenta, LightBlue, LightGreen, LightCyan,
LightRed, LightMagenta, Yellow, White }

{ This will create the necessary ANSI code for the requested colors }

{ I use a function for ease of use; you can put it in the middle of strings,
instead of using a separate line. If you want this as a procedure,
change "function" to "procedure", and replace the " : String10;" with
";". Then, at the end where it says "Color := ANSIString;", say
"ANSIWrite(ANSIString);"}

var
ANSIString : String10;

begin
ANSIString := ^[+'[';
if Fore > 15 then { Color + 16 for blink }
begin
ANSIString := ANSIString + '5;'; { Blink code }
Fore := Fore - 16; { So it uses normal color }
end
else
ANSIString := ANSIString + '0;'; { Always reset to black on white, no attrib }
if Back > 15 then
Back := Back - 16; { You can't have a blinking background! }
case Fore of
Black : ANSIString := ANSIString + '30;';
Blue : ANSIString := ANSIString + '34;';
Green : ANSIString := ANSIString + '32;';
Cyan : ANSIString := ANSIString + '36;';
Red : ANSIString := ANSIString + '31;';
Magenta : ANSIString := ANSIString + '35;';
Yellow : ANSIString := ANSIString + '33;';
White : ANSIString := ANSIString + '37;';
LightBlue : ANSIString := ANSIString + '1;34;'; { High intesity }
LightGreen : ANSIString := ANSIString + '1;32;'; { "" "" }
LightCyan : ANSIString := ANSIString + '1;36;'; { "" "" }
LightRed : ANSIString := ANSIString + '1;31;'; { "" "" }
LightMagenta:ANSIString := ANSIString + '1;35;'; { "" "" }
else
begin
Writeln('Invalid foreground color. Aborting.');
halt;
end
end;
case Back of
Black : ANSIString := ANSIString + '40';
Blue : ANSIString := ANSIString + '44';
Green : ANSIString := ANSIString + '42';
Cyan : ANSIString := ANSIString + '46';
Red : ANSIString := ANSIString + '41';
Magenta : ANSIString := ANSIString + '45';
Yellow : ANSIString := ANSIString + '43';
White : ANSIString := ANSIString + '47'
else
begin
Writeln('Invalid background color. Aborting.');
halt;
end
end;
ANSIString := ANSIString + 'm';
Color := ANSIString;
end;

procedure Locate(X,Y : integer);

var
ANSIString : String10;
TString : string[5]; { Temporary var }

{ Locates the cursor anywhere on the screen using ANSI graphics }

begin
ANSIString := ^[+'[';
str(Y,TString);
ANSIString := ANSIString + TString + ';';
str(X,TString);
ANSIString := ANSIString + TString + 'H';
ANSIWrite(ANSIString);
end;

procedure ClrScrn;

{ Clear the screen using ANSI }

begin
ANSIWrite(^[+'[2J');
end;

{ These variables are only for the following demo : }

var
x,
y : integer;
C : char;

begin
ANSIWrite(Color(White,Black));
ClrScrn;
ANSIWrite(Color(Red,Blue)+'Red on Blue'^J^M);
ANSIWrite(Color(Yellow,Black)+'Yellow on Black'^J^M);
ANSIWrite(Color(White+Blink,Green)+'Blinking White on Green'^J^M);
ANSIWrite(Color(Magenta,Cyan)+'Magenta upon Cyan'^J^M);
ANSIWrite(Color(Yellow,Blue)+'YELLOW on BLUE'^J^M);
ANSIWrite(Color(Green,Black)+'With ' + Color(Black,White) + 'ANSIWrite' +
Color(Green,Black)+' you can do cursor positioning,');
ANSIWrite(Color(White,Black)+' plus all sorts of colors! ');
Locate(1,15);
ANSIWrite(Color(Green,White));
ANSIWrite('Press the space bar to continue.');
Read(kbd,C);
x := 0;
ANSIWrite(Color(Magenta,Black));
ClrScrn;
for y := 5 to 20 do
begin
x := x + 1;
Locate(x,y);
ANSIWrite('V');
delay(100); { For visibility }
end;
for y := 20 downto 5 do
begin
x := x + 1;
Locate(x,y);
ANSIWrite('V');
delay(100); { For visibility }
end;
Locate(21,20);
ANSIWrite('e r s a t i l e,');
Locate(21,21);
ANSIWrite('and if you need ANSI Graphics in Turbo Pascal');
Locate(21,22);
ANSIWrite('then use '+Color(Yellow+Blink,Black)+'ANSIWRITE!');
ANSIWrite(Color(White,Black));
end.


  3 Responses to “Category : Pascal Source Code
Archive   : AWRITE.ZIP
Filename : ANSIWRIT.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/