home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / PCXDISP.ZIP / PCXDISP.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-07-12  |  4.8 KB  |  179 lines
  1. '    This program show how to display a PCX file in Screen 9 and
  2. '    Screen 12.
  3.  
  4. DECLARE SUB ShowPCX ()
  5.  
  6. '--- Define the header of the PCX file
  7.  
  8. TYPE PCXheaderform
  9.      manufacturer AS STRING * 1
  10.      version AS STRING * 1
  11.      encoding AS STRING * 1
  12.      bitsperpixel AS STRING * 1
  13.      xmin AS INTEGER
  14.      ymin AS INTEGER
  15.      xmax AS INTEGER
  16.      ymax AS INTEGER
  17.      hres AS INTEGER
  18.      vres AS INTEGER
  19.      egapalette AS STRING * 48
  20.      reserved AS STRING * 1
  21.      colourplanes AS STRING * 1
  22.      bytesperline AS INTEGER
  23.      palettetype AS INTEGER
  24.      filler AS STRING * 58
  25. END TYPE
  26.  
  27. DIM SHARED TheHeader AS PCXheaderform
  28.  
  29. '--- Open the file and get the header.
  30. OPEN COMMAND$ FOR BINARY AS 1
  31. GET #1, , TheHeader
  32.  
  33. '--- Check the file.
  34. IF TheHeader.manufacturer <> CHR$(&HA) THEN
  35.      PRINT "This is not a PCX file!"
  36.      END
  37. END IF
  38.  
  39. '--- Display the Header information.
  40. CLS
  41. PRINT "File: "; COMMAND$
  42. PRINT "Manufacturer code: ", HEX$(ASC(TheHeader.manufacturer))
  43. PRINT "Version number: ", ASC(TheHeader.version)
  44. PRINT "Encoding number: ", ASC(TheHeader.encoding)
  45. PRINT "Bits per Pixel: ", ASC(TheHeader.bitsperpixel)
  46. PRINT "Xmin, Ymin: ", TheHeader.xmin, TheHeader.ymin
  47. PRINT "Xmax, Ymax: ", TheHeader.xmax, TheHeader.ymax
  48. PRINT "Resolutions Horizonal, Vertical: ", TheHeader.hres, TheHeader.vres
  49.  
  50. '--- Show the Palette values.
  51. PRINT "Palette values: ";
  52. FOR i% = 1 TO 47
  53.      PRINT ASC(MID$(TheHeader.egapalette, i%, 1));
  54. NEXT i%
  55. PRINT ASC(MID$(TheHeader.egapalette, 48, 1))
  56.  
  57. PRINT "Reserved: ", ASC(TheHeader.reserved)
  58. PRINT "Number of color planes: ", ASC(TheHeader.colourplanes)
  59. PRINT "Bytes per line: ", TheHeader.bytesperline
  60. PRINT "Palette type: ", TheHeader.palettetype
  61.  
  62. CLOSE #1
  63.  
  64. '--- Wait for input.
  65. PRINT "Hit a key to display the file...."
  66. DO: x$ = INKEY$: LOOP WHILE x$ = ""
  67.  
  68. '--- Call the sub to display the file.
  69. ShowPCX
  70.  
  71. END
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78. SUB ShowPCX
  79.  
  80. '    The subprogram display a PCX file in either 640 x 350 x 16 or
  81. '    640 x 480 x 16.
  82.  
  83. '--- The setup.
  84. DIM Cpalette%(48), PalArray&(16)
  85. DIM Byte AS STRING * 1
  86. DIM Addr AS LONG
  87.  
  88. OPEN COMMAND$ FOR BINARY AS 1
  89. 'GET #1, TheHeader
  90.  
  91. '--- Set the screen and palette.
  92. CLS
  93.  
  94. FOR i% = 0 TO 47
  95.      Cpalette%(i%) = ASC(MID$(TheHeader.egapalette, i% + 1, 1))
  96. NEXT i%
  97.  
  98. SELECT CASE TheHeader.vres
  99.      CASE 350
  100.           SCREEN 9, , 0
  101.           FOR j% = 0 TO 15
  102.                Red% = Cpalette%(j% * 3) / 85
  103.                Green% = Cpalette%((j% * 3) + 1) / 85
  104.                Blue% = Cpalette%((j% * 3) + 2) / 85
  105.                Red% = ((Red% AND 1) * 32) OR ((Red% AND 2) * 2)
  106.                Green% = ((Green% AND 1) * 16) OR (Green% AND 2)
  107.                Blue% = ((Blue% AND 1) * 8) OR ((Blue% AND 2) \ 2)
  108.                Hue% = Red% OR Green% OR Blue%
  109.                PalArray&(j%) = Hue%
  110.           NEXT j%
  111.  
  112.      CASE 480
  113.           SCREEN 12, , 0
  114.           FOR j% = 0 TO 15
  115.                Red% = INT(Cpalette%(j% * 3) / 4)
  116.                Green% = INT(Cpalette%((j% * 3) + 1) / 4)
  117.                Blue% = INT(Cpalette%((j% * 3) + 2) / 4)
  118.                PalArray&(j%) = 65536 * Blue% + 256 * Green% + Red%
  119.           NEXT j%
  120.      CASE ELSE
  121.           PRINT "This file can not be displayed."
  122.           CLOSE #1
  123.           EXIT SUB
  124. END SELECT
  125.  
  126. PALETTE USING PalArray&(0)
  127.  
  128. '--- Set the file pointer and the segment.
  129. SEEK #1, 129
  130. DEF SEG = &HA000
  131.  
  132. '--- Decode and Read the bit map.
  133. FOR k& = TheHeader.ymin TO TheHeader.ymax
  134.      Addr = 80 * k&
  135.      LineEnd& = Addr + TheHeader.bytesperline
  136.      j% = 1
  137.      DO WHILE j% <= 4
  138.           b% = j%
  139.           IF j% = 3 THEN b% = 4
  140.           IF j% = 4 THEN b% = 8
  141.           OUT &H3C4, 2: OUT &H3C5, b%
  142.           GET #1, , Byte
  143.           byte.1% = ASC(Byte)
  144.           IF (byte.1% AND 192) <> 192 THEN
  145.                POKE Addr, byte.1%
  146.                Addr = Addr + 1
  147.                IF Addr >= LineEnd& THEN
  148.                     Addr = 80 * k&
  149.                     j% = j% + 1
  150.                END IF
  151.                ELSE
  152.                     byte.1% = byte.1% AND 63
  153.                     GET #1, , Byte
  154.                     Byte.2% = ASC(Byte)
  155.                     FOR m% = 1 TO byte.1%
  156.                          b% = j%
  157.                          IF j% = 3 THEN b% = 4
  158.                          IF j% = 4 THEN b% = 8
  159.                          OUT &H3C4, 2: OUT &H3C5, b%
  160.                          POKE Addr, Byte.2%
  161.                          Addr = Addr + 1
  162.                          IF Addr >= LineEnd& THEN
  163.                               Addr = 80 * k&
  164.                               j% = j% + 1
  165.                          END IF
  166.                     NEXT m%
  167.                END IF
  168.           LOOP
  169.      NEXT k&
  170.      OUT &H3C4, 2: OUT &H3C5, &HF
  171.      DEF SEG
  172.      CLOSE #1
  173. DO: x$ = INKEY$: LOOP WHILE x$ = ""
  174. SCREEN 0
  175. CLS
  176.  
  177. END SUB
  178.  
  179.