home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / FEB88.ZIP / COLORTXT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-17  |  8.3 KB  |  251 lines
  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N-}    {No numeric coprocessor}
  6. {$M 65500,16384,655360} {Turbo 3 default stack and heap}
  7.  
  8. {___________________________________________________________________
  9.  
  10. COLORTXT.PAS shows how to display character strings in all
  11. combinations of foreground and background colors for EGA mode 10h,
  12. 640x350 pixels with 16 colors, then in normal and inverse video for
  13. CGA mode 6, 640x200 pixels monochrome.  This method works for all
  14. 16-color EGA and VGA modes, and for CGA, EGA, VGA, and MCGA
  15. monochrome modes.  For CGA mode 5, 320x200 pixels and 4 colors,
  16. the concept remains the same, but you may have to make changes in
  17. the Screen_Write routine.  VGA/MCGA mode 13h is another topic.
  18.  
  19. This version of COLORTXT is written for Turbo Pascal Release 4.0.
  20.  
  21. WARNING - To run as written, your PC must have either an EGA or
  22.           a VGA video controller.
  23.  
  24. Copyright, 1987, Ben Myers
  25.  ____________________________________________________________________
  26. }
  27.  
  28. program colortxt;
  29.  
  30. Uses
  31.   Crt, Dos, Turbo3;
  32.  
  33. const
  34.   _Copyright : string[80] = 'Copyright 1987, Ben Myers';
  35.   _VIDEO = $10;     { BIOS video interrupt }
  36.  
  37. var
  38.   __BIOSReg : Registers;
  39.   Previous_Mode : byte;
  40.   TempCh : char;
  41.   Display_String : string[80];
  42.   i, k, Color_Index : integer;
  43.  
  44. {__________________________________________________________________
  45.  
  46. Set_Cursor_Position - Position the cursor on active display page zero.
  47.  
  48. X and Y are the row and column to position the cursor, relative to 1,
  49. like Turbo GoToXY.  This procedure gives correct results for values
  50. of X and Y within the range allowed by the current video BIOS mode.
  51.  __________________________________________________________________
  52. }
  53.  
  54. procedure Set_Cursor_Position ( X, Y : integer );
  55.  
  56. begin {Set_Cursor_Position}
  57.  
  58.   with __BIOSReg do
  59.     begin
  60.       Ah := $02;  { BIOS VIDEO subfunction 2, Set Cursor Position. }
  61.       Bh := 0;                { Video display page zero }
  62.       Dh := pred(Y);          { Make zero relative }
  63.       Dl := pred(X) and $FF;
  64.     end;
  65.   Intr(_VIDEO,Dos.Registers(__BIOSReg));
  66. {! 1. Parameter to Intr must be of the type Registers defined
  67.  in DOS unit.}
  68.  
  69. end; {Set_Cursor_Position}
  70.  
  71. {___________________________________________________________________
  72.  
  73. Write_Byte_Attribute - Write copies of a character with a specified
  74.                        attribute beginning at current cursor
  75.                        position.
  76.  
  77. Data_Ch    The character to display
  78. Count      The number of copies of Data_Ch to display
  79. Fore, Back The foreground and background attributes for the character.
  80. ____________________________________________________________________
  81. }
  82.  
  83. procedure Write_Byte_Attribute (Data_Ch : char;
  84.                                 Count, Fore, Back : integer);
  85.  
  86. begin {Write_Byte_Attribute}
  87.  
  88.   if (Count > 0) then
  89.   with __BIOSReg do
  90.     begin
  91.       Ah  := $09;  { BIOS video subfunction 9, }
  92.       { Write Attribute/Character at Current Cursor Position }
  93.       Al  := Ord(Data_Ch);
  94.       { Use video display page zero (Bh), and       }
  95.       { force reasonable values for the attributes. }
  96.       Bx  := ((Back and $0F) shl 4) or (Fore and $0F);
  97.       Cx  := Count;
  98.       Intr(_VIDEO,Dos.Registers(__BIOSReg));
  99.     end;
  100.  
  101. end; {Write_Byte_Attribute}
  102.  
  103. {__________________________________________________________________
  104.  
  105. Screen_Write - Display a character string in color on a background
  106.                color.
  107.  
  108. Phrase              The character string to be displayed
  109. Text_Row, Text_Col  The starting row and column on which to display
  110. FColor, BColor      The foreground and background colors to use
  111.  
  112. ___________________________________________________________________
  113. }
  114.  
  115. Procedure Screen_Write ( Phrase : String; Text_Row, Text_Col,
  116.                          Fcolor, Bcolor: integer );
  117. const
  118. { Font character consisting of all bits (a little square) }
  119.     White_Space : char =  #$DB;
  120.  
  121. var
  122.   j : integer;
  123.   Phrase_Size : integer;
  124.   Effective_Foreground_Color : byte;
  125.  
  126. begin  { Screen_Write }
  127.  
  128.   Phrase_Size := Length ( Phrase );
  129.   if Bcolor <> Black then
  130.     begin  { Display string against non-black background }
  131.       { Paint Phrase_Size bytes of all bits in background color }
  132.       Set_Cursor_Position ( Text_Col, Text_Row );
  133.       Write_Byte_Attribute ( White_Space, Phrase_Size,
  134.                              BColor, Black );
  135.       Effective_Foreground_Color := FColor xor BColor;
  136.       { For EGA, VGA, ATs, XT/286's, and PS/2's, the for statement
  137.         could be replaced by a single call to video BIOS function
  138.         $13, Write String.
  139.       }
  140.       for j := 1 to Phrase_Size do
  141.       if Phrase [j] <> ' ' then
  142.         begin
  143.           Set_Cursor_Position ( Text_Col + pred(j), Text_Row );
  144.           Write_Byte_Attribute ( Phrase [j], 1,
  145.                                  Effective_Foreground_Color,
  146.                                  8 {xor font bits on background});
  147.         end;
  148.      end   { Display string against non-black background }
  149.    else
  150.      begin  { Display string against black background }
  151.        { Write the character string }
  152.       for j := 1 to Phrase_Size do
  153.       if Phrase [j] <> ' ' then
  154.         begin
  155.           Set_Cursor_Position ( Text_Col + pred(j), Text_Row );
  156.           Write_Byte_Attribute ( Phrase [j], 1, FColor, Black );
  157.         end;
  158.      end;   { Display string against black background }
  159.  
  160. end;  { Screen_Write }
  161.  
  162. {__________________________________________________________________
  163.  
  164. Main Procedure
  165. ___________________________________________________________________
  166. }
  167. begin  {colortxt}
  168.  
  169. { Display 16 colors 640x350 with EGA mode 10h }
  170.  
  171.   { BIOS VIDEO subfunction 0Fh, Read Current Video State. }
  172.   __BIOSReg.Ah := $0F;
  173.   Intr(_VIDEO,Dos.Registers(__BIOSReg));
  174.   Previous_Mode := __BIOSReg.Al;
  175.   { BIOS VIDEO subfunction 0, Set Mode. }
  176.   __BIOSReg.Ax := $0010;
  177.   Intr(_VIDEO,Dos.Registers(__BIOSReg));
  178.   Display_String := ' Display all colors on line 1. ' + _Copyright;
  179.   for i := 1 to length(Display_String) do
  180.     begin
  181.       { Don't display a black character }
  182.       Color_Index := (i mod 15) + 1;
  183.       Screen_Write ( Display_String[i], 1, i, Color_Index, Black );
  184.     end;
  185.  
  186.   Display_String :=
  187.     ' Display black on all background colors on line 2. ';
  188.   for i := 1 to length(Display_String) do
  189.     begin
  190.       Color_Index := (i mod 15) + 1;
  191.       Screen_Write ( Display_String[i], 2, i, Black, Color_Index );
  192.     end;
  193.  
  194.   { Display all possible combinations }
  195.   for k := 0 to 15 do
  196.   for i := 0 to 15 do
  197.     Screen_Write ( chr(ord('A')+k+i), 3+k, 1+i, i, k);
  198.  
  199.   Screen_Write (
  200.    ' Display blue text on light cyan background on line 19. ',
  201.                  19, 1, Blue, LightCyan );
  202.  
  203.   Screen_Write (
  204.    ' Display yellow text on red background on line 20. ',
  205.                  20, 1, Yellow, Red );
  206.  
  207.   Screen_Write (
  208.    ' Display green text on yellow background on line 21. ',
  209.                  21, 1, Green, Yellow );
  210.  
  211.   Screen_Write (
  212.    ' Display yellow text on green background on line 22. ',
  213.                  22, 1, Yellow, Green );
  214.  
  215.   Screen_Write (
  216.    ' Display magenta text on light green background on line 23. ',
  217.                  23, 1, Magenta, LightGreen );
  218.  
  219.   Screen_Write (
  220.    ' Display light cyan text on blue background on line 24. ',
  221.                  24, 1, LightCyan, Blue );
  222.  
  223.   Screen_Write (
  224.  ' Display light blue text on light magenta background on line 25. ',
  225.                  25, 1, LightBlue, LightMagenta );
  226.  
  227.   while not KeyPressed do;   { Wait for a keystroke }
  228.   Read ( kbd, TempCh );         { Now get rid of it }
  229.  
  230. { Display monochrome in CGA mode 6, 2 color 640x200  }
  231.  
  232.   { BIOS VIDEO subfunction 0, Set Mode. }
  233.   __BIOSReg.Ax := $0006;
  234.   Intr(_VIDEO,Dos.Registers(__BIOSReg));
  235.   Screen_Write ( ' Display white on black on line 1. ',
  236.                  1, 1, White, Black );
  237.  
  238.   Screen_Write ( ' Display black on white on line 3. ',
  239.                  3, 1, Black, White );
  240.  
  241.   while not KeyPressed do;   { Wait for a keystroke }
  242.   Read ( kbd, TempCh );         { Now get rid of it }
  243.  
  244.   { Leave the video mode as it was found when program started up }
  245.   { However, active display page from that mode is not restored  }
  246.   { BIOS VIDEO subfunction 0, Set Mode. }
  247.   __BIOSReg.Ax := Previous_Mode;
  248.   Intr(_VIDEO,Dos.Registers(__BIOSReg));
  249.  
  250. end.   {colortxt}
  251.