home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l291 / 6.ddi / CGA.FO$ / CGA.bin
Encoding:
Text File  |  1989-01-16  |  1.2 KB  |  40 lines
  1. CC  CGA.FOR - Demonstrates CGA colors.
  2.  
  3.       INCLUDE  'FGRAPH.FI'
  4.       INCLUDE  'FGRAPH.FD'
  5.  
  6.       INTEGER*2 dummy2, i, j, k
  7.       INTEGER*4 dummy4
  8.       INTEGER*4 bkcolor(8) /
  9.      +          $BLACK, $BLUE   , $GREEN, $CYAN,
  10.      +          $RED  , $MAGENTA, $BROWN, $WHITE /
  11.  
  12.       CHARACTER*7  bkcolorname(8) /
  13.      +             'BLACK', 'BLUE'   , 'GREEN', 'CYAN',
  14.      +             'RED'  , 'MAGENTA', 'BROWN', 'WHITE' /
  15.  
  16.       RECORD / rccoord / curpos
  17.  
  18.       IF( setvideomode( $MRES4COLOR ) .EQ. 0 )
  19.      +    STOP 'Error:  cannot set CGA graphics mode'
  20.  
  21.       DO i = 0, 3
  22.          dummy2 = selectpalette( i )
  23.          DO k = 1, 8
  24.             dummy4 = setbkcolor( bkcolor(k) )
  25.             DO j = 0, 3
  26.                CALL settextposition( 1, 1, curpos )
  27.                WRITE (*, 9000) bkcolorname(k), i, j
  28.                dummy2 = setcolor( INT4( j ) )
  29.                dummy2 = rectangle( $GFILLINTERIOR, 160, 100, 320, 200 )
  30.                READ (*,*)     ! Wait for ENTER key to be pressed
  31.             END DO
  32.          END DO
  33.       END DO
  34.       dummy2 = setvideomode( $DEFAULTMODE )
  35.  
  36.  9000 FORMAT( ' background color: ', A / ' palette:', I3 /
  37.      +        ' color:  ', I3 / )
  38.  
  39.       END
  40.