Keskustelu: Ohjelmointikysymykset: QB: BMP -avaaja Subbiin

DECLARE SUB ShowPic (kuva$)


TYPE BITMAPFILEHEADER
  bfType AS STRING * 2
  bfSize AS LONG
  bfReserved1 AS INTEGER
  bfReserved2 AS INTEGER
  bfOffBits AS LONG
END TYPE

TYPE BITMAPINFOHEADER
  biSize AS LONG
  biWidth AS LONG
  biHeight AS LONG
  biPlanes AS INTEGER
  biBitCount AS INTEGER
  biCompression AS LONG
  biSizeImage AS LONG
  biXPelsPerMeter AS LONG
  biYPelsPerMeter AS LONG
  biClrUsed AS LONG
  biClrImportant AS LONG
END TYPE

TYPE RGBQUAD
  rgbBlue AS STRING * 1
  rgbGreen AS STRING * 1
  rgbRed AS STRING * 1
  rgbReserved AS STRING * 1
END TYPE




SUB ShowPic (kuva$)

DEFINT A-Z


CONST BIRGB = 0&
CONST BIRLE8 = 1&
CONST BIRLE4 = 2&

DIM tiedosto AS BITMAPFILEHEADER
DIM info AS BITMAPINFOHEADER
DIM vari AS RGBQUAD

IF DIR$(kuva$) = "" THEN
  PRINT "Tiedostoa ei l?ytynyt!"
  END
END IF

OPEN kuva$ FOR BINARY AS #1

GET #1, , tiedosto
GET #1, , info

SCREEN 13

IF tiedosto.bfType <> "BM" THEN
  PRINT "Tuntematon tiedostomuoto!"
  END
END IF

DIM pikseli AS STRING, kohta AS LONG, tase AS STRING * 1
DEF SEG = &HA000
kohta = 320& * info.biHeight - 1
merkki = 0

SELECT CASE info.biBitCount
CASE 1
  OUT &H3C8, 0
  FOR i = 1 TO 2
    GET #1, , vari
    OUT &H3C9, ASC(vari.rgbRed) \ 4
    OUT &H3C9, ASC(vari.rgbGreen) \ 4
    OUT &H3C9, ASC(vari.rgbBlue) \ 4
  NEXT
  leveys = INT(info.biWidth / 8 + .5)
  pikseli = SPACE$(leveys)
  GET #1, , pikseli
  loppu& = info.biHeight * leveys
  miinus = info.biWidth MOD 8
  SELECT CASE leveys MOD 4
  CASE 0: v = -1: CASE 1: v = 2: CASE 2: v = 1: CASE 3: v = 0
  END SELECT
  FOR i& = 1 TO loppu&
    merkki = merkki + 1
    IF kohta < 64000 THEN
      tavu = ASC(MID$(pikseli, merkki, 1))
      FOR j = 0 TO 7
        POKE kohta + 7 - j, SGN(tavu AND 2 ^ j)
      NEXT
    END IF
    kohta = kohta + 8
    IF i& MOD leveys = 0 THEN
      kohta = kohta - 320 - info.biWidth + miinus
      FOR j = 0 TO v: GET #1, , tase: NEXT
      GET #1, , pikseli
      merkki = 0
    END IF
  NEXT
CASE 4
  OUT &H3C8, 0
  FOR i = 1 TO 16
    GET #1, , vari
    OUT &H3C9, ASC(vari.rgbRed) \ 4
    OUT &H3C9, ASC(vari.rgbGreen) \ 4
    OUT &H3C9, ASC(vari.rgbBlue) \ 4
  NEXT
  SELECT CASE info.biCompression
  CASE BIRGB
    leveys = INT(info.biWidth / 2 + .5)
    pikseli = SPACE$(leveys)
    GET #1, , pikseli
    loppu& = info.biHeight * leveys
    SELECT CASE leveys MOD 4
    CASE 0: v = -1: CASE 1: v = 2: CASE 2: v = 1: CASE 3: v = 0
    END SELECT
    IF info.biWidth / 2 <> info.biWidth \ 2 THEN miinus = -1
    FOR i& = 1 TO loppu&
      merkki = merkki + 1
      IF kohta < 64000 THEN
        POKE kohta, (ASC(MID$(pikseli, merkki, 1)) \ 16) AND 15
        IF merkki < leveys THEN
          POKE kohta + 1, ASC(MID$(pikseli, merkki, 1)) AND 15
        END IF
      END IF
      kohta = kohta + 2
      IF i& MOD leveys = 0 THEN
        kohta = kohta - 320 - info.biWidth + miinus
        FOR j = 0 TO v: GET #1, , tase: NEXT
        GET #1, , pikseli
        merkki = 0
      END IF
    NEXT
  CASE ELSE
    PRINT "Tuntematon pakkausmuoto!"
  END SELECT
CASE 8
  OUT &H3C8, 0
  FOR i = 1 TO 256
    GET #1, , vari
    OUT &H3C9, ASC(vari.rgbRed) \ 4
    OUT &H3C9, ASC(vari.rgbGreen) \ 4
    OUT &H3C9, ASC(vari.rgbBlue) \ 4
  NEXT
  SELECT CASE info.biCompression
  CASE BIRGB
    pikseli = SPACE$(info.biWidth)
    GET #1, , pikseli
    loppu& = info.biHeight * info.biWidth
    SELECT CASE info.biWidth MOD 4
    CASE 0: v = -1: CASE 1: v = 2: CASE 2: v = 1: CASE 3: v = 0
    END SELECT
    FOR i& = 1 TO loppu&
      kohta = kohta + 1
      merkki = merkki + 1
      IF kohta < 64000 THEN
        POKE kohta, ASC(MID$(pikseli, merkki, 1))
      END IF
      IF i& MOD info.biWidth = 0 THEN
        kohta = kohta - 320 - info.biWidth
        FOR j = 0 TO v: GET #1, , tase: NEXT
        GET #1, , pikseli
        merkki = 0
      END IF
    NEXT
  CASE ELSE
    PRINT "Tuntematon pakkausmuoto!"
  END SELECT
CASE ELSE
  PRINT "Tuntematon v?rim??r?!"
END SELECT

CLOSE #1



END SUB