133 lines
3.3 KiB
Plaintext
133 lines
3.3 KiB
Plaintext
program ColorDemo;
|
||
|
||
type
|
||
AnyString = string[40];
|
||
|
||
|
||
procedure Check;
|
||
var
|
||
Ch: char;
|
||
begin
|
||
writeln('This program will only work if you have the color graphics adapter installed');
|
||
write('Continue Y/N ');
|
||
repeat read (Kbd,Ch) until Upcase(Ch) in ['Y','N'];
|
||
if Upcase(Ch)='N' then Halt;
|
||
end;
|
||
|
||
|
||
|
||
procedure PaletteDemo;
|
||
var
|
||
Ch: Char;
|
||
PaletteNumber, Background: integer;
|
||
PaletteChange: boolean;
|
||
|
||
procedure DrawBoxes;
|
||
var
|
||
Y: integer;
|
||
begin
|
||
for Y:=1 to 24 do Draw(10,10*8+Y,320,10*8+Y,1);
|
||
for Y:=1 to 24 do Draw(10,13*8+Y,320,13*8+Y,2);
|
||
for Y:=1 to 24 do Draw(10,16*8+Y,320,16*8+Y,3);
|
||
end {DrawBoxes};
|
||
|
||
procedure Msg(X,Y: integer; S: AnyString);
|
||
{ write the string S at X,Y }
|
||
begin
|
||
GotoXY(X,Y);
|
||
Write(S);
|
||
end {Msg};
|
||
|
||
procedure Help;
|
||
begin { write the help text}
|
||
Msg(1,1,' TURBO COLOR DEMO ');
|
||
Msg(1,3,'Procedures used:');
|
||
Msg(1,6,' To make background: ');
|
||
Msg(1,7,' To select a palette: ');
|
||
Msg(1,9,'Colors in selected palette are:');
|
||
Msg(1,12,'1');
|
||
Msg(1,15,'2');
|
||
Msg(1,18,'3');
|
||
Msg(1,21,'Use arrows to change palette number');
|
||
Msg(1,22,'or press B to change Background');
|
||
GotoXY(1,25);
|
||
write('Press ESC twice to exit');
|
||
end {Help};
|
||
|
||
|
||
procedure Update;
|
||
begin
|
||
GotoXY(22,6); write('GraphBackground(',Background,') ');
|
||
GotoXY(22,7); write('Palette(',PaletteNumber,')');
|
||
GraphBackground(Background);
|
||
Palette(PaletteNumber);
|
||
if PaletteChange then
|
||
begin
|
||
GotoXY(1,21);
|
||
writeln('Use arrows to change palette number ');
|
||
write('Press B to change Background ');
|
||
end else
|
||
begin
|
||
GotoXY(1,21);
|
||
writeln('Use arrows to change background number');
|
||
write('or press P to change Palette ');
|
||
end;
|
||
end {Update};
|
||
|
||
begin {PaletteDemo}
|
||
GraphColorMode;
|
||
BackGround:=0;
|
||
PaletteNumber:=0;
|
||
GraphBackground(BackGround);
|
||
Palette(PaletteNumber);
|
||
DrawBoxes;
|
||
Help;
|
||
Update;
|
||
repeat
|
||
repeat read(Kbd,Ch) until Ch in ['P','p','B','b',#27];
|
||
case Upcase(Ch) of
|
||
'P': PaletteChange:=true;
|
||
'B': PaletteChange:=false;
|
||
#27: begin
|
||
read(Kbd,Ch);
|
||
case Ch of
|
||
'P': begin
|
||
if PaletteChange then
|
||
begin
|
||
PaletteNumber:=PaletteNumber-1;
|
||
if PaletteNumber<0 then PaletteNumber:=0;
|
||
end else
|
||
begin
|
||
Background:=BackGround-1;
|
||
if BackGround<0 then BackGround:=0;
|
||
end;
|
||
end;
|
||
'H': begin
|
||
if PaletteChange then
|
||
begin
|
||
PaletteNumber:=PaletteNumber+1;
|
||
if PaletteNumber>3 then PaletteNumber:=3;
|
||
end else
|
||
begin
|
||
Background:=BackGround+1;
|
||
if BackGround>15 then BackGround:=15;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
Update;
|
||
until Ch=#27;
|
||
end {Palettedemo};
|
||
|
||
|
||
|
||
begin {Main program}
|
||
Check;
|
||
PaletteDemo;
|
||
TextMode;
|
||
end.
|
||
|
||
|
||
|
||
|