program consoleclrs;
uses crt, Unix;
var
Rever, Reset, Blink, UnderOn, UnderOff, Bold: String;
(*In the color strings 'F' means foreground, 'B' means background*)
BlackF, BlackB, BlueF, BlueB, CyanF, CyanB, GreenF, GreenB: String;
strx: String;
RtnCode: Longint;
x: integer;
begin
(*colors can very depending on your terminal settings*)
Rever:='tput rev'; (*reverse foreground/background, use Reset to stop*)
Reset:='tput sgr0'; (*sets foreground/background to default colors*)
Blink:='tput blink'; (*causes text to blink, use Reset to stop*)
UnderOn :='tput smul'; (*start underline*)
UnderOff:='tput rmul'; (*stop underline*)
Bold:='tput bold'; (*bolds text, use Reset to stop*)
BlackF:='tput setaf 0';
BlackB:='tput setab 0';
BlueF :='tput setaf 4';
BlueB :='tput setab 4';
CyanF :='tput setaf 6';
CyanB :='tput setab 6';
GreenF:='tput setaf 2';
GreenB:='tput setab 2';
RtnCode:=fpSystem(BlueF);
writeln ('I''m blue on black');
RtnCode:=fpSystem(Rever);
writeln ('I''m black on blue');
RtnCode:=fpSystem(GreenF); (*since reverse is on green is the background*)
writeln ('I''m black on green');
RtnCode:=fpSystem(Reset);
RtnCode:=fpSystem(GreenF);
RtnCode:=fpSystem(CyanB);
writeln ('I''m green on cyan');
RtnCode:=fpSystem(Reset);
writeln ('I''m your default colors!');
writeln ('This is a test.');
(*note if the screen hasn't been cleared recently an odd color bar may appear to fill up the rest of this line
in the last bacground color; setting background to black does not fix this. Subsequent lines do not have
this bug.*)
Rtncode:=fpSystem(GreenF);
write ('I''m a ');
Rtncode:=fpSystem(Blink);
write ('surprise');
Rtncode:=fpSystem(Reset);
Rtncode:=fpSystem(GreenF);
writeln ('!');
Rtncode:=fpSystem(CyanF);
write ('I''m ');
Rtncode:=fpSystem(UnderOn);
write ('underlined');
Rtncode:=fpSystem(UnderOff);
writeln ('! But this is not.');
RtnCode:=fpSystem(GreenF);
RtnCode:=fpSystem(Bold);
writeln ('I''m very bold!');
(*display some of the colors available in your console. *)
for x:=1 to 100 (*number of colors available depends on your enviornment try up to 255 or even 65K*)
do begin
str(x,strx);
strx:='tput setaf '+strx;
RtnCode:=fpSystem(strx);
write (' Color ',x);
end;
writeln ('');
end.