home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / b / baswiz19.zip / BW$BAS.ZIP / GN1SHOWB.BAS < prev    next >
BASIC Source File  |  1993-01-31  |  4KB  |  86 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   |                      The BASIC Wizard's Library                      |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DECLARE SUB FOpen (File$, FMode$, BufferLen%, Handle%, ErrCode%)
  10.    DECLARE FUNCTION FGetError% (BYVAL Handle%)
  11.    DECLARE FUNCTION FGetSize& (BYVAL Handle%)
  12.    DECLARE SUB FLocate (BYVAL Handle%, Posn&)
  13.    DECLARE SUB FBlockRead (BYVAL Handle%, BYVAL Segm%, BYVAL Ofs%, BYVAL Bytes%)
  14.    DECLARE FUNCTION FRead$ (BYVAL Handle%, BYVAL Bytes%)
  15.    DECLARE SUB FClose (Handle%)
  16.    DECLARE SUB GN1Color (BYVAL Foreground%, BYVAL Background%)
  17.    DECLARE SUB GN1Plot (BYVAL X%, BYVAL Y%)
  18.  
  19.    DECLARE SUB PalBlk0 (BYVAL DSeg%, BYVAL DOfs%, BYVAL Colors%)
  20.  
  21. SUB GN1ShowBMP (File$, OrigX%, OrigY%, ErrCode%)
  22.    ErrCode% = 0
  23.    FOpen File$, "R", 0, Handle%, ErrCode%
  24.    IF ErrCode% = 0 THEN
  25.       Header$ = FRead$(Handle%, 54)
  26.       ErrCode% = FGetError%(Handle%)
  27.       IF ErrCode% = 0 THEN
  28.          PWide& = CVL(MID$(Header$, 19, 4))
  29.          PHigh& = CVL(MID$(Header$, 23, 4))
  30.          BitPlanes% = CVI(MID$(Header$, 27, 2))
  31.          ColorBits% = CVI(MID$(Header$, 29, 2))
  32.          IF LEFT$(Header$, 2) <> "BM" THEN
  33.             ErrCode% = -1    ' invalid BMP
  34.          ELSEIF NOT (BitPlanes% = 1 AND ColorBits% = 8) THEN
  35.             ErrCode% = -2    ' color format not supported
  36.          ELSEIF CVL(MID$(Header$, 31, 4)) <> 0& THEN
  37.             ErrCode% = -3    ' compression not supported
  38.          ELSEIF CVL(MID$(Header$, 3, 4)) <> FGetSize&(Handle%) THEN
  39.             ErrCode% = -4    ' incorrect file size
  40.          ELSEIF PWide& < 1& OR PWide& > 320& OR PHigh& < 1& OR PHigh& > 400& THEN
  41.             ErrCode% = -5    ' ludicrous image size
  42.          END IF
  43.          IF ErrCode% = 0 THEN
  44.             PicWidth% = PWide&
  45.             PicHeight% = PHigh&
  46.             IF OrigX% + PicWidth% > 320 OR OrigY% + PicHeight% > 400 THEN
  47.                ErrCode% = -6      ' invalid (X,Y) origin specified
  48.             END IF
  49.          END IF
  50.       END IF
  51.  
  52.       '----- set the palette -----
  53.       IF ErrCode% = 0 THEN
  54.          DIM Pal&(0 TO 255)
  55.          DSeg% = VARSEG(Pal&(0))
  56.          DOfs% = VARPTR(Pal&(0))
  57.          Bytes% = 1024            ' 256 * 4 is size of palette block
  58.          FBlockRead Handle%, DSeg%, DOfs%, Bytes%
  59.          ErrCode% = FGetError%(Handle%)
  60.          IF ErrCode% = 0 THEN
  61.             DSeg% = VARSEG(Pal&(0))
  62.             DOfs% = VARPTR(Pal&(0))
  63.             PalBlk0 DSeg%, DOfs%, 256
  64.          END IF
  65.       END IF
  66.  
  67.       '----- draw the picture -----
  68.       IF ErrCode% = 0 THEN
  69.          FLocate Handle%, CVL(MID$(Header$, 11, 4)) + 1&
  70.          Bytes% = ((PicWidth% + 3) \ 4) * 4
  71.          FOR y% = 0 TO PicHeight% - 1
  72.             st$ = FRead$(Handle%, Bytes%)
  73.             ErrCode% = FGetError%(Handle%)
  74.             IF ErrCode% THEN EXIT FOR
  75.             CurrY% = (PicHeight% - y%) + OrigY%
  76.             FOR x% = 0 TO PicWidth% - 1
  77.                GN1Color ASC(MID$(st$, x% + 1, 1)), 0
  78.                GN1Plot x% + OrigX%, CurrY%
  79.             NEXT
  80.          NEXT
  81.       END IF
  82.  
  83.       FClose Handle%
  84.    END IF
  85. END SUB
  86.