home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / baswiz19 / examples / getinfob.bas < prev    next >
Encoding:
BASIC Source File  |  1993-01-30  |  2.1 KB  |  50 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 FGetSize& (BYVAL Handle%)
  11.    DECLARE FUNCTION FRead$ (BYVAL Handle%, BYVAL Bytes%)
  12.    DECLARE SUB FClose (Handle%)
  13.  
  14. SUB GetInfoBMP (File$, PicWidth%, PicHeight%, PicColors%, ErrCode%)
  15.    ErrCode% = 0
  16.    FOpen File$, "R", 100, Handle%, ErrCode%
  17.    IF ErrCode% = 0 THEN
  18.       Header$ = FRead$(Handle%, 34)
  19.       IF FGetError% OR (LEN(Header$) <> 34) THEN
  20.          ErrCode% = FGetError%
  21.       ELSE
  22.          PWide& = CVL(MID$(Header$, 19, 4))
  23.          PHigh& = CVL(MID$(Header$, 23, 4))
  24.          BitPlanes% = CVI(MID$(Header$, 27, 2))
  25.          ColorBits% = CVI(MID$(Header$, 29, 2))
  26.          IF LEFT$(Header$, 2) <> "BM" THEN
  27.             ErrCode% = -1    ' invalid BMP
  28.          ELSEIF NOT (BitPlanes% = 1 AND (ColorBits% = 4 OR ColorBits% = 8)) THEN
  29.             ErrCode% = -2    ' color format not supported
  30.          ELSEIF CVL(MID$(Header$, 31, 4)) <> 0& THEN
  31.             ErrCode% = -3    ' compression not supported
  32.          ELSEIF CVL(MID$(Header$, 3, 4)) <> FGetSize&(Handle%) THEN
  33.             ErrCode% = -4    ' incorrect file size
  34.          ELSEIF PWide& < 1& OR PWide& > 32767& OR PHigh& < 1& OR PHigh& > 32767& THEN
  35.             ErrCode% = -5    ' ludicrous image size
  36.          END IF
  37.          IF ErrCode% = 0 THEN
  38.             PicWidth% = PWide&
  39.             PicHeight% = PHigh&
  40.             IF ColorBits% = 4 THEN
  41.                PicColors% = 16
  42.             ELSE
  43.                PicColors% = 256
  44.             END IF
  45.          END IF
  46.       END IF
  47.       FClose Handle%
  48.    END IF
  49. END SUB
  50.