Contributor: WIM VAN DER VEGT
{
Here a sample program which shows a smoothly (graphics mode like)
animation of a thermobar display. It works (I think) only on VGA cards
The trick is done by animating one character by changing it's
bitpattern. }
{---------------------------------------------------------}
{ Project : Textmode thermometer bar }
{ Unit : Main Program }
{ By : Wim van der Vegt }
{---------------------------------------------------------}
{ This program shows a thermometer bar display similar }
{ to the ones in many installation programs. This one }
{ however is in textmode, but smoothly animated as if in }
{ graphics mode. It is only tested on one (S)VGA card. }
{---------------------------------------------------------}
{ Date .Time Revision }
{ 940620.1450 Creation. }
{---------------------------------------------------------}
Uses
Dos,
Crt;
Const
c : Array[1..16] Of Byte = (255,255,255,255,
255,255,255,255,
255,255,255,255,
255,255,255,255);
{---------------------------------------------------------}
{---Procedure to turn cursor on/off. }
{---------------------------------------------------------}
Procedure Cursor(on : Boolean);
VAR
r : registers;
BEGIN
r.ah:=03ドル;
r.bh:=00ドル;
Intr(10,ドルr);
IF ((r.cx< 2020ドル) AND NOT(on)) OR ((r.cx>=2020ドル) AND on)
THEN
BEGIN
r.ah:=01ドル;
r.cx:=r.cx XOR 2020ドル;
Intr(10,ドルr);
END;
END; {of Cursor}
{---------------------------------------------------------}
{---Procedure to wait for the vertical retrace of the VGA }
{ display. This minimizes screen flickering when the }
{ CRTC gets reprogrammed. }
{---------------------------------------------------------}
PROCEDURE Wait4Retrace;
begin
while ((Port[3ドルDA] AND 8)> 0) do;
while ((Port[3ドルDA] AND 8) = 0) do;
end; {of Wait4Retrace;}
{---------------------------------------------------------}
{---Procedure to generate an animation scene for character}
{ #1. The cursor is turned off every time the procedure }
{ is called because the cursor keeps showing up when the}
{ CRTC is reprogrammed. And a cursor behind a smoothly }
{ animated thermobar just doesn't feel right. }
{---------------------------------------------------------}
Procedure Reprogram(i,bperc : Byte);
VAR
j : integer;
r : registers;
w : Word;
Begin
{----calculate bittpattern. It goes like
0
128
128+64
128+64+32
128+64+32+16
128+64+32+16+8
128+64+32+16+8+4
128+64+32+16+8+4+2
128+64+32+16+8+4+2+1 (This is equivalent to character 219 'ロ')
}
w:=0;
FOR j:=1 TO i DO w:=w+BYTE(256 SHR j);
For j:=1 To bperc Do c[j]:=w;
{----reprogram character #1,
but wait for retrace so there's no flickering}
r.ah:=11ドル;
r.al:=10ドル;
r.bh:=bperc;
r.bl:=00ドル;
r.cx:=01ドル;
r.dx:=01ドル;
r.bp:=Ofs(c);
r.es:=Seg(c);
Wait4Retrace;
Intr(10,ドルr);
Cursor(false);
End; {of Reprogram}
{---------------------------------------------------------}
{---Main program, btw the character #1 isn't restored }
{ because it's seldomly used by application. }
{ a TEXTMODE(LASTMODE) statement will clear the screen }
{ and restore character #1. So put that at the end of }
{ program }
{---------------------------------------------------------}
Var
r : registers;
i,k : Byte;
bperc : Byte;
Begin
Clrscr;
GotoXY(20,5);
Write('0% 50% 100%');
GotoXY(20,4);
{----get bytes per character of current font,
by requesting font data on font #0 (INT 1F)}
r.ah:=11ドル;
r.al:=30ドル;
r.bh:=00ドル;
Intr(10,ドルr);
bperc:=r.cx;
textcolor(yellow);
{----Do a 30 character bar}
For k:=1 To 40 Do
Begin
{----Use chr(1) to animate, however wipe it before writing it}
Reprogram(0,bperc);
Write(#01);
{----Animate character #1}
For i:=0 To 7 Do
Begin
{----calc bit new patterns,
bit patterns are reversed in character generator,
bit 7 is on the left side of a character}
Reprogram(i,bperc);
Delay(25);
End;
{----Replace fully animated characters by a full block from
the line drawing set because animation of character #1
will be started all over}
GotoXY(WhereX-1,WhereY);
Write('ロ');
End;
GotoXY(1,6);
Cursor(true);
{textmode(lastmode);}
End. {of Main program}