Keskustelu: Koodit: QB: BMP-kuvan näyttäminen

Tämä ohjelma näyttää 2-, 16- ja 256-värisiä BMP-kuvia QBasicissa käyttäen grafiikkatilaa 13 (320x200 tarkkuus, 256 väriä). Se lukee kuvan rakenteen, paletin ja pikselit tiedostosta ja piirtää kuvan näiden tietojen perusteella. Kuvan piirtämiseen on kohdistettu pientä optimointia, ja se tuntuukin olevan verrattain nopea.

BMP-kuvan rakenteesta sen verran, että tiedoston alussa on kaksi kuvan rakenteen sisältävää tietuetta: BITMAPFILEHEADER ja BITMAPINFOHEADER. Jälkimmäinen sisältää tärkeimmät tiedot, mm. kuvan leveyden ja korkeuden sekä värimäärän. Tämän jälkeen tulee paletti nelitavuisena RGBQUAD-tietueena ja lopuksi itse kuvadata, jonka muoto riippuu värien määrästä. Kuva luetaan vasemmalta oikealle ja alhaalta ylös; ensimmäinen pikseli on siis vasen alanurkka ja viimeinen oikea ylänurkka.

1-bittiset eli 2-väriset eli mustavalkoiset kuvat: Paletissa on kaksi väriä ja yhdessä tavussa on kahdeksan pikseliä (bitti per pikseli).

4-bittiset eli 16-väriset kuvat: Paletissa on kuusitoista väriä ja yhdessä tavussa on kaksi pikseliä.

8-bittiset eli 256-väriset kuvat: Paletissa on 256 väriä ja yhdessä tavussa on yksi pikseli.

Ohjelma EI osaa näyttää 24-bittisiä kuvia (ei mahdollista VGA-tilassa) eikä RLE-pakattuja kuvia (harvinainen pakkaus - koodista olisi tullut entistäkin sekavampi).

'**************************************************************
'* Ohjelma lukee ja näyttää 2-, 16- ja 256-värisiä BMP-kuvia. *
'*                                                            *
'* Tekijä: Antti Laaksonen (antti.laaksonen@mbnet.fi)         *
'**************************************************************

DIM kuva AS STRING
kuva = "c:\antti\320200.bmp" 'näytettävä kuva

DEFINT A-Z

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

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

Ei näy ei....
Pelkkä musta tausta näkyy, mutta ei viivaa oikeassa yläkulmassa.

Ahaa kyllähän tuo toimiikin, kun vaan muistaisi tallentaa kuvan :D

Jee, tämmöstä mä oon aaaaainaa halunnu! :)

hyvin toimii ilman tätä pätkää:

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

Toiminee, ja siistiä koodia (vrt. meikäläisen QB-FLI-playeri ;-) Tuon tosin olisi voinut iskeä funktioksi niin käyttö olisi hieman helpottunut.

Ja vielä tästä rivistä:

POKE kohta + 7 - j, SGN(tavu AND 2 ^ j)

Potenssin (^) käyttäminen on todella hidasta (varsinkin vanhemilla koneilla), veikkaan että simppeli looppi tuon laskemiseen olisi jopa nopeampi...

Ajoin tämä koodin Ms-Dosissa (ei windowsia alla), ja sitten se väitti että sitä kuvaa ei löydy, vaikka se löytyy oikeasti.
Windowsin alla tämä toimii vallan mainiosti.
Mikähän vikana?

mä jo luulin että osaan qbasiccia kunnolla=) tai quick basiccia!!!!

Ei tajua...
Siis näitä kuvien lukemisia.

Onpas ihme viritys.

No eipä tollasella kyllä mitään tee jos ei edes RLE-kuvia osaa purkaa. Se RLE pakattu BMP on kyllä yleinen.

24-bittisten kuvien poisjättämisen ymmärtää toki, vaikka nekin voisi ihan hyvin näyttää kvantisoimalla kuvan värejä varten oman paletin.

RLE pakkauksen purkaminen on aika yksinkertaista eikä sellaisen sorsa mikään kovin sekava ole.

Mitä tekee codecilla joka osaa ladata vain murto-osan tiedostoformaatin kuvista??

Ei toimi jostain syystä! (Ehkä muokkailujeni syytä)

-The PC-Master-

Ei taho toimia mullakaan...

Muistitteko tallentaa kuvan oikeaan hakemistoon oikealla nimellä? Tallensin oman kuvan 256-värisenä ja toimi hyvin.

Turha ruveta mitään 24-bittisiä värejä väsäämään. QBasikin käyttäjille riittää useimmissa tapauksissa myös 256 väriä.

Miten saan niin että se kuva pitää olla samassa hakemistossa kun itse ohjelma tai toi systeemi? Ettei sille tartte aina erikseen kertoa tuota hakemistoa?

Yritin kerran tehä tällaista itsekin. (tai siis ainakin sellaista, joka pystyy lukemaan BMP-tiedostoa), mutta siinä näkyi vain jotain merkkejä, joista ei tajunnut mitään. Olisi tietysti pitänyt lukea kuva Binaari-muodossa.

joo, tämä ei toimi mulla ainakaa alkuunkaan. Se valittaa jotai End-of-statement (tiedän kyllä mitä se tarkoittaa), mutta ei tuollaisia pitäisi olla tässä vinkissä. Varmasti kuitenkin Antti on saanut sen toimimaan. En epäile etteikö tuo toimisi, mutta aika monella se ei toimi. minullakaan. No, kaippa sen saa vielä toimimaan...:)

Tuo pitäs saaha subbiin. Vaan ei toimi.

Hmm.. Tätä voisin jopa käyttää erään pelini alussa (mikäli vaan saan opeteltua kirjastojen käytön kunnolla..) :). Saat nimesi kiitoksiin!

saiskohan tätä käyttää omassa pelissä?
meinaan tota vois jopa hyödyntää

hmm...pää raksuttaa taas tyhjyyttään. Miten saan tuon koodin lukemaan 100*100 alueen vaikkapa 640*400 kuvasta?

Kiva, mutta tuo "tuntematon kuvatyyppi" ärsyttää.

Tuotahan voisi hyödyntää monien QB-sovellusten alussa.

kala kirjoitti:

No eipä tollasella kyllä mitään tee jos ei edes RLE-kuvia osaa purkaa. Se RLE pakattu BMP on kyllä yleinen.

mä en oo eres kuullu tätä ennen rle kuvista. tuo olis ollu kätevämpi SUBissa ku sais vaan liittää omaa koodiin.
Edit: Huono että muuttaa palettia.

Edit2:kala: no tee sellaanen.