Category : Display Utilities
Archive   : SCRN.ZIP
Filename : SCRN.PAS
{ Written in Turbo Pascal V3 }
Program Scrn (input,output);
type
MaxColorLength = String[7];
var
ForeGnd,BackGnd : MaxColorLength;
ForeGroundColor,BackGroundColor : integer;
ForeGndString,BackGndString : String[2];
ColorString : String[9];
CharSign : char;
procedure UpperCase(param : MaxColorLength; var ch : char);
{ This procedure converts to first letter of the color to }
{ uppercase if it is not already uppercase. It converts }
{ the third letter of black or blue to uppercase, since }
{ they both have the same forst two letters. }
var
len : integer;
begin {program Screen}
len := Length(param); {Get the length of the Color}
ch := UpCase(Copy(param,1,1)); {Convert first letter to upper case}
{ If the color is black or blue we need to use the third }
{ letter to distinguish between the two. Also need to make }
{ sure that there is a third letter input }
if (ch = 'B') AND (len > 1) then ch :=UpCase(Copy(param,2,1));
if (ch = 'L') AND (len > 2) then ch :=UpCase(Copy(param,3,1));
end; {procedure UpperCase}
procedure ColorCode(Color : char; var Code: integer);
{ This procedure compares the input color to the available }
{ colors and computes the code needed for that color }
begin
Case Color of
'A' : Code := Code+30;
'R' : Code := Code+31;
'G' : Code := Code+32;
'Y' : Code := Code+33;
'U' : Code := Code+34;
'M' : Code := Code+35;
'C' : Code := Code+36;
'W' : Code := Code+37;
end; {Case Color}
end; {procedure ColorCode}
begin { Program Screen}
if ParamCount <2 then { Need to colors input, otherwise print }
begin { help screen }
writeln('Scrn [foreground color] [background color]');
writeln(' ');
writeln('Available colors are - Black Blue Green Cyan');
writeln(' Red Magenta Yellow White');
writeln(' ');
write('With the exception of Black and Blue, only the first');
writeln(' is necessary.');
end {ParamCount <2}
else begin
ForeGroundColor := 0;
BackGroundColor := 10; { Background colors are offset by 10 }
write(#$1B,'[2J'); { Clear Screen }
write(#$1B,'[=3h'); { Set screen up for color 80X25 }
ForeGnd := ParamStr(1); { Get first Parameter }
UpperCase(ForeGnd,CharSign);
ColorCode(CharSign,ForeGroundColor);
Str(ForeGroundColor,ForeGndString);
if ForeGroundColor = 0 then { if color value is still 0, it wasn't }
begin { a valid color }
write(ForeGnd);
writeln(' is an invalid Foreground color, Program aborted...');
writeln('For help type SCRN
end {then}
else begin
BackGnd := ParamStr(2); { Get second Color }
UpperCase(BackGnd,CharSign);
ColorCode(CharSign,BackGroundColor);
Str(BackGroundColor,BackGndString);
if BackGroundColor = 10 then begin { if value is still 10, }
write(BackGnd); { wasn't a valid color }
writeln(' is an invalid Background color, Program aborted...');
writeln('For help type SCRN
end {then}
else begin { Sequence is
ColorString :='['+ForeGndString+';'+BackGndString+'m';
writeln(#$1B,ColorString);
write(#$1B,'[2J'); { Clear screen with new colors }
end; {BackGroundColor}
end; {else ForeGroundColor}
end; {else ParamCount}
end. {Program Scrn}
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/