home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / misc.swg / 0108_Smooth Thermobar display.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  4.8 KB  |  175 lines
  1. {
  2. Here a sample program which shows a smoothly (graphics mode like)
  3. animation of a thermobar display. It works (I think) only on VGA cards
  4.  
  5. The trick is done by animating one character by changing it's
  6. bitpattern. }
  7.  
  8.  
  9. {---------------------------------------------------------}
  10. {  Project : Textmode thermometer bar                     }
  11. {  Unit    : Main Program                                 }
  12. {  By      : Wim van der Vegt                             }
  13. {---------------------------------------------------------}
  14. {  This program shows a thermometer bar display similar   }
  15. {  to the ones in many installation programs. This one    }
  16. {  however is in textmode, but smoothly animated as if in }
  17. {  graphics mode. It is only tested on one (S)VGA card.   }
  18. {---------------------------------------------------------}
  19. {  Date  .Time  Revision                                  }
  20. {  940620.1450  Creation.                                 }
  21. {---------------------------------------------------------}
  22.  
  23. Uses
  24.   Dos,
  25.   Crt;
  26.  
  27. Const
  28.   c : Array[1..16] Of Byte = (255,255,255,255,
  29.                               255,255,255,255,
  30.                               255,255,255,255,
  31.                               255,255,255,255);
  32.  
  33. {---------------------------------------------------------}
  34. {---Procedure to turn cursor on/off.                      }
  35. {---------------------------------------------------------}
  36.  
  37. Procedure Cursor(on : Boolean);
  38.  
  39. VAR
  40.   r : registers;
  41.  
  42. BEGIN
  43.   r.ah:=$03;
  44.   r.bh:=$00;
  45.   Intr($10,r);
  46.  
  47.   IF ((r.cx< $2020) AND NOT(on)) OR
  48.      ((r.cx>=$2020) AND on)
  49.     THEN
  50.       BEGIN
  51.         r.ah:=$01;
  52.         r.cx:=r.cx XOR $2020;
  53.         Intr($10,r);
  54.       END;
  55. END; {of Cursor}
  56.  
  57. {---------------------------------------------------------}
  58. {---Procedure to wait for the vertical retrace of the VGA }
  59. {   display. This minimizes screen flickering when the    }
  60. {   CRTC gets reprogrammed.                               }
  61. {---------------------------------------------------------}
  62.  
  63. PROCEDURE Wait4Retrace;
  64.  
  65. begin
  66.   while ((Port[$3DA] AND 8) > 0) do;
  67.   while ((Port[$3DA] AND 8) = 0) do;
  68. end; {of Wait4Retrace;}
  69.  
  70. {---------------------------------------------------------}
  71. {---Procedure to generate an animation scene for character}
  72. {   #1. The cursor is turned off every time the procedure }
  73. {   is called because the cursor keeps showing up when the}
  74. {   CRTC is reprogrammed. And a cursor behind a smoothly  }
  75. {   animated thermobar just doesn't feel right.           }
  76. {---------------------------------------------------------}
  77.  
  78. Procedure Reprogram(i,bperc : Byte);
  79.  
  80. VAR
  81.   j : integer;
  82.   r : registers;
  83.   w : Word;
  84.  
  85. Begin
  86. {----calculate bittpattern. It goes like
  87.      0
  88.      128
  89.      128+64
  90.      128+64+32
  91.      128+64+32+16
  92.      128+64+32+16+8
  93.      128+64+32+16+8+4
  94.      128+64+32+16+8+4+2
  95.      128+64+32+16+8+4+2+1 (This is equivalent to character 219 '█')
  96.      }
  97.  
  98.    w:=0;
  99.    FOR j:=1 TO i DO w:=w+BYTE(256 SHR j);
  100.    For j:=1 To bperc Do c[j]:=w;
  101.  
  102.  {----reprogram character #1,
  103.       but wait for retrace so there's no flickering}
  104.    r.ah:=$11;
  105.    r.al:=$10;
  106.    r.bh:=bperc;
  107.    r.bl:=$00;
  108.    r.cx:=$01;
  109.    r.dx:=$01;
  110.    r.bp:=Ofs(c);
  111.    r.es:=Seg(c);
  112.    Wait4Retrace;
  113.    Intr($10,r);
  114.   Cursor(false);
  115. End; {of Reprogram}
  116.  
  117. {---------------------------------------------------------}
  118. {---Main program, btw the character #1 isn't restored     }
  119. {   because it's seldomly used by application.            }
  120. {   a TEXTMODE(LASTMODE) statement will clear the screen  }
  121. {   and restore character #1. So put that at the end of   }
  122. {   program                                               }
  123. {---------------------------------------------------------}
  124.  
  125. Var
  126.   r     : registers;
  127.   i,k   : Byte;
  128.   bperc : Byte;
  129.  
  130. Begin
  131.   Clrscr;
  132.  
  133.   GotoXY(20,5);
  134.   Write('0%                50%               100%');
  135.   GotoXY(20,4);
  136.  
  137. {----get bytes per character of current font,
  138.      by requesting font data on font #0 (INT 1F)}
  139.   r.ah:=$11;
  140.   r.al:=$30;
  141.   r.bh:=$00;
  142.   Intr($10,r);
  143.   bperc:=r.cx;
  144.  
  145.   textcolor(yellow);
  146.  
  147. {----Do a 30 character bar}
  148.   For k:=1 To 40 Do
  149.     Begin
  150.     {----Use chr(1) to animate, however wipe it before writing it}
  151.       Reprogram(0,bperc);
  152.       Write(#01);
  153.  
  154.     {----Animate character #1}
  155.       For i:=0 To 7 Do
  156.         Begin
  157.         {----calc bit new patterns,
  158.              bit patterns are reversed in character generator,
  159.              bit 7 is on the left side of a character}
  160.           Reprogram(i,bperc);
  161.           Delay(25);
  162.         End;
  163.  
  164.    {----Replace fully animated characters by a full block from
  165.         the line drawing set because animation of character #1
  166.         will be started all over}
  167.      GotoXY(WhereX-1,WhereY);
  168.      Write('█');
  169.     End;
  170.   GotoXY(1,6);
  171.   Cursor(true);
  172.  
  173.  {textmode(lastmode);}
  174. End. {of Main program}
  175.