home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / vgascrol.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-14  |  2KB  |  61 lines
  1.  
  2. program VgaScroll;
  3. { Neat and simple, one of the first! By Bas van Gaalen, Holland, PD }
  4. uses
  5.   crt,dos;
  6.  
  7. const
  8.   GSeg   = $A000;
  9.   Bits   : array[0..7] of byte = (128,64,32,16,8,4,2,1);
  10.   ColTab : array[0..7] of byte = (blue,lightblue,cyan,lightcyan,lightcyan,cyan,lightblue,blue);
  11.   ScrT   : string = 'Hai, this is a scroller...      ';
  12.  
  13. var
  14.   Fseg,Fofs : word;
  15.  
  16. {----------------------------------------------------------------------------}
  17.  
  18. procedure Getfont; assembler; asm
  19.   mov ax,1130h; mov bh,1; int 10h; mov Fseg,es; mov Fofs,bp; end;
  20.  
  21. {----------------------------------------------------------------------------}
  22.  
  23. procedure SetGraphics(Mode : word); assembler; asm
  24.   mov ax,Mode; int 10h; end;
  25.  
  26. {----------------------------------------------------------------------------}
  27.  
  28. procedure Scroll;
  29.  
  30. var
  31.   I,J : word;
  32.   CharPos,Pos,Color,Character : byte;
  33.  
  34. begin
  35.   Pos := 1;
  36.   repeat
  37.     Character := ord(ScrT[Pos]);
  38.     for CharPos := 0 to 7 do begin
  39.       for I := 0 to 7 do begin
  40.         if mem[Fseg:Fofs+(Character*8)+I] and Bits[CharPos] <> 0 then Color := ColTab[I]
  41.         else Color := black;
  42.         mem[GSeg:(((24*8)+I)*320)+319] := Color;
  43.       end;
  44.       while (port[$3DA] and 8) <> 0 do;
  45.       while (port[$3DA] and 8) = 0 do;
  46.       for J := 0 to 7 do for I := 0 to 318 do
  47.         mem[GSeg:(((24*8)+J)*320)+I] := mem[GSeg:(((24*8)+J)*320)+1+I];
  48.     end;
  49.     inc(Pos); if Pos = length(ScrT) then Pos := 1;
  50.   until keypressed;
  51. end;
  52.  
  53. {----------------------------------------------------------------------------}
  54.  
  55. begin
  56.   clrscr;
  57.   GetFont;
  58.   SetGraphics($13);
  59.   Scroll;
  60. end.
  61.