Category : Pascal Source Code
Archive   : COLORSET.ZIP
Filename : TSTCOLOR.PAS

Program TstColor;
{----------------------------------------------------------------------------}
{ Program: TestColor }
{ Programmer: Jeffrey S. Kline }
{ Start Date: April 28, 1990 Completion: April 29, 1990 }
{ Synopsis: }
{ Test and develop a smart means of color selection for both the forground }
{ and the background with just a moving block. }
{----------------------------------------------------------------------------}
Uses
DOS, CRT, COLORSET;

Const
MainFGcolor : Integer = LightGray;
MainBGcolor : Integer = Black;
MainColors : Word = $07;

Var
Ch : Char;
Changed : Boolean;
Finished : Boolean;
Curs1,Curs2 : Byte; { old cursor stats storage }
DummyStr : String;

Procedure FindCursor;
Var
Reg : Registers;
Begin
Reg.Ax := $0F00;
Intr($10,Reg);
Reg.Ax := $0300;
Intr($10,Reg);
With Reg do
Begin
Curs1 := Hi(Cx) and $0F;
Curs2 := Lo(Cx) and $0F;
End;
End;


Procedure SetCursor(Top, Bot:Byte);
Var
Reg : Registers;
Begin
with Reg do
Begin
ax := 1 shl 8;
cx := Top shl 8 + Bot;
INTR($10,Reg);
End;
End;


Function IntToStr(Number:longint):string;
var Temp : string;
begin
Str(Number,temp);
IntToStr := temp;
end;

function RealToStr(Number:real;Decimals:byte):string;
var Temp : string;
begin
Str(Number:20:Decimals,Temp);
repeat
If copy(Temp,1,1) = ' ' then
delete(Temp,1,1);
until copy(temp,1,1) <> ' ';
RealToStr := Temp;
end;

Begin
Finished := False;
FindCursor; { GET OLD CURSOR STATS }
Repeat
SetCursor(6,7);
TextColor(MainFGcolor);
TextBackGround(MainBGcolor);
ClrScr;
Writeln('Beginning color selections test and evaluation. ');
Writeln;
Writeln('This is using the "COLORSET" TPU/QPU. Copyright '+CopyrightName);
Writeln('See the documentation for access to the source code to this unit');
Writeln('and about the usage of this module.');
GotoXY(5,8);
Writeln('Main FG................: ',IntToStr(MainFGcolor),' ',ColorNames[MainFGcolor]);
GotoXY(5,9);
Writeln('Main BG................: ',IntToStr(MainBGcolor),' ',ColorNames[MainBGcolor]);
GotoXY(5,10);
Writeln('Main in WORD form is...: ',RealToStr(Attr(MainFGcolor,MainBGcolor),0),' Decimal.');
GotoXY(1,23);
TextColor(White);
Write('Press ALT-C to set colors or ALT-X to exit!');
Ch := Readkey;
If Ch = #0 then
Begin
Ch := Readkey;
If Ch = #45 then Finished := True;
If Ch = #46 then Changed := Select_Colors(Attr(MainFGColor,MainBGcolor));
End;
If Changed then
Begin { get changed colors into our vars }
MainFGcolor := ChosenFG;
MainBGcolor := ChosenBG;
MainColors := ChosenColors;
End;
Until Finished;
TextAttr := Attr(7,0);
SetCursor(Curs1,Curs2);
ClrScr;
End.