program TestVirtualScreenUnit;
uses
Dos, Crt,
Vscreen; (* VirtualScreen Unit *)
const
Screen1 : VsPtr = Nil; (* Message Pad *)
Screen2 : VsPtr = Nil; (* Attr-chart *)
Screen3 : VsPtr = Nil; (* Main display Vscreen *)
Screen4 : VsPtr = Nil; (* Buffer Vscreen *)
var
DUD : char; (* "Press <ANY KEY>" character *)
Loop1, Loop2 : word;
procedure BuildAttrChart;
begin
ClrVscr(Screen2, $37);
VSetVsXYattr(Screen2, 16, 15, 9, $0F);
VwriteStringVs(Screen2, '0123456789ABCDEF', 16, 9, $0F);
VSetVsXYattr(Screen2, 16, 17, 9, $0F);
VwriteStringVs(Screen2, 'FIRST NUMBER', 9, 11, $3F);
VwriteStringVs(Screen2, 'BACKGROUND COLOR', 12, 9, $3F);
WriteStringVs(Screen2, 'SECOND NUMBER = TEXT COLOR', false, 29, 5, $3F);
WriteStringVs(Screen2,
' 0 1 2 3 4 5 6 7 8 9 A B C D E F ',
false, 20, 7, $0F);
for Loop1 := 0 to 15 do
for Loop2 := 0 to 15 do
WriteStringVs(Screen2, ' X ', false, (20 + (Loop2 * 3)),
(9 + Loop1), (Loop2 + (Loop1 Shl 4)));
end;
procedure BuildMessages1;
begin
ClrVscr(Screen1, $7F);
(* Message 1 *)
SetVsWindowAttr(Screen1, 1, 47, 11, 20, $17);
WriteStringVs(Screen1, 'SIMPLE TEST PROGRAM FOR VSCREEN UNIT',
false, 6, 13, $1F);
WriteStringVs(Screen1, 'Every screen you see in this',
false, 8, 15, $17);
WriteStringVs(Screen1, 'program has been pre-built in RAM.',
false, 8, 16, $17);
WriteStringVs(Screen1, 'Press <ENTER> to continue:',
false, 12, 18, $17);
SetVsXYattr(Screen1, 7, 7, 15, $0F);
(* Message 2 *)
WriteStringVs(Screen1, 'SO WHAT DOES IT DO????',
false, 13, 3, $7F);
WriteStringVs(Screen1, 'This program will show how screen-',
false, 8, 5, $7F);
WriteStringVs(Screen1, 'attributes are set hexidecimally.',
false, 8, 6, $7F);
WriteStringVs(Screen1, 'Press <ENTER> to continue:',
false, 12, 8, $7F);
end;
procedure BuildMessages2;
begin
ClrVscr(Screen1, $70);
(* Message 3 *)
WriteStringVs(Screen1, 'Underneath this window is a hexidecimal',
false, 3, 3, $70);
WriteStringVs(Screen1, 'color attribute chart. To determine the',
false, 3, 4, $70);
WriteStringVs(Screen1, 'hexidecimal attribute for the color you',
false, 3, 5, $70);
WriteStringVs(Screen1, 'want, just...',
false, 3, 6, $70);
WriteStringVs(Screen1, 'Press <ENTER> to continue:',
false, 9, 8, $7F);
(* Message 4 *)
WriteStringVs(Screen1, 'Look-up the background color',
false, 3, 13, $70);
WriteStringVs(Screen1, 'from this collumn. This is',
false, 3, 14, $70);
WriteStringVs(Screen1, 'the first digit of the Hex-',
false, 3, 15, $70);
WriteStringVs(Screen1, 'attribute. Green is number 2',
false, 3, 16, $70);
WriteStringVs(Screen1, 'Press <ENTER> to continue:',
false, 4, 18, $7F);
(* Message 5 *)
WriteStringVs(Screen1, 'Next, look-up the text color',
false, 33, 13, $70);
WriteStringVs(Screen1, 'from this row. White is',
false, 33, 14, $70);
WriteStringVs(Screen1, 'number F. This is the second',
false, 33, 15, $70);
WriteStringVs(Screen1, 'digit of the Hex-attribute.',
false, 33, 16, $70);
WriteStringVs(Screen1, 'Press <ENTER> to continue:',
false, 34, 18, $7F);
end;
procedure BuildMessages3;
begin
ClrVscr(Screen1, $70);
(* Message 6 *)
WriteStringVs(Screen1, 'So the two hex-numbers combined',
false, 3, 3, $70);
WriteStringVs(Screen1, 'equal 2F hexidecimal. Which is',
false, 3, 4, $70);
WriteStringVs(Screen1, 'white text on a green background',
false, 3, 5, $70);
WriteStringVs(Screen1, 'Here''s the full chart:',
false, 3, 6, $70);
WriteStringVs(Screen1, 'Press <ENTER> to continue:',
false, 6, 8, $7F);
end;
(* The following procedure ONLY works for EGA+ modes *)
procedure Blink(BlinkOn : boolean);
var
Regs : registers;
begin
with Regs do
begin
AX := $1003;
BX := Ord(BlinkOn);
end;
Intr($10, Regs)
end;
BEGIN
if NOT ColorMode then
begin
WriteLn(' This demo can only be run in color-text mode');
Halt(1);
end;
VsInit(Screen1); (* Allocate VirtualScreens on the Heap *)
VsInit(Screen2);
VsInit(Screen3);
VsInit(Screen4);
BuildAttrChart;
BuildMessages1;
MoveVsWindowBlock(Screen1, 1, 47, 11, 20, (* Message 1 *)
Screen3, 17, 63, 6, 15);
DisplayVs(Screen3);
MoveVsWindowBlock(Screen1, 1, 47, 1, 10, (* Message 2 *)
Screen3, 17, 63, 6, 15);
ReadLn;
DisplayVs(Screen3); (* Message 2 *)
BuildMessages2;
Screen4^ := Screen2^;
ClrVscrWindow(Screen4, 20, 67, 17, 24, $F);
WriteStringVs(Screen4, '* CENSORED *', false, 36, 21, $70);
Screen3^ := Screen4^;
MoveVsWindowBlock(Screen1, 1, 44, 1, 10, (* Message 3 *)
Screen3, 22, 65, 12, 21);
ReadLn;
DisplayVs(Screen3); (* Message 3 *)
Screen3^ := Screen4^;
MoveVsWindowBlock(Screen1, 1, 32, 11, 20, (* Message 4 *)
Screen3, 27, 58, 9, 18);
WriteStringVs(Screen3, '<--------', false, 18, 11, $7F);
ReadLn;
DisplayVs(Screen3); (* Message 4 *)
Screen3^ := Screen4^;
MoveVsWindowBlock(Screen1, 31, 63, 11, 20, (* Message 5 *)
Screen3, 36, 68, 13, 22);
VSetVsXYattr(Screen3, 5, 65, 8, $7F);
VWriteStringVs(Screen3, '^||||||', 66, 8, $7F);
VSetVsXYattr(Screen3, 5, 67, 8, $7F);
ReadLn;
DisplayVs(Screen3); (* Message 5 *)
Screen3^ := Screen4^;
BuildMessages3;
MoveVsWindowBlock(Screen1, 1, 37, 1, 10, (* Message 6 *)
Screen3, 26, 62, 12, 21);
ReadLn;
DisplayVs(Screen3); (* Message 6 *)
Screen3^ := Screen2^;
WriteStringVs(Screen3, 'Press <ENTER> to turn the blink-bit off',
false, 23, 3, $70);
ReadLn;
DisplayVs(Screen3);
WriteStringVs(Screen3, ' Press <ENTER> to quit demo-program ',
false, 22, 3, $70);
ReadLn;
DisplayVs(Screen3);
Blink(false);
ReadLn;
Blink(true);
ClrScr; NormVideo
END.
