Keskustelu: Koodit: QB: ICO-kuvakkeen näyttäminen

'ICO-tiedoston näyttäminen
'------------------------------
'
'Tämä ohjelma näyttää Windowsin .ICO-kuvakkeen
'640x480x16-tilassa. Kuvakkeen koon tulee olla
'32x32-pikseliä ja värejä tulee olla 16.
'
'ICO-tiedoston rakenne on haettu Windows 3.1
'SDK:sta
'
'Copyright Antti Laaksonen 2002
'www.ohjelmointiputka.net


TYPE ICONDIRENTRYTYPE
  bWidth AS STRING * 1
  bHeight AS STRING * 1
  bColorCount AS STRING * 1
  bReserved AS STRING * 1
  wPlanes AS INTEGER
  wBitCount AS INTEGER
  dwBytesInRes AS LONG
  dwImageOffset AS LONG
END TYPE

TYPE ICONDIRTYPE
  idReserved AS INTEGER
  idType AS INTEGER
  idCount AS INTEGER
  idEntries AS ICONDIRENTRYTYPE
END TYPE

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

TYPE BITMAPINFOHEADERTYPE
  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

'tietueita kuvakkeen datalle
DIM IconDir AS ICONDIRTYPE
DIM icHeader AS BITMAPINFOHEADERTYPE
DIM icColors AS RGBQUADTYPE

'näytettävä kuvake
tiedosto$ = "c:\winnt\forms\configs\mapif5l.ico"
OPEN tiedosto$ FOR BINARY AS #1

'otetaan kuvakkeen perustiedot IconDir-tietueeseen
GET #1, , IconDir

'onko kuva oikeaa tyyppiä?
IF IconDir.idType = 1 AND IconDir.idCount = 1 THEN
  'ovatko leveys ja korkeus 32?
  IF ASC(IconDir.idEntries.bWidth) = 32 AND ASC(IconDir.idEntries.bHeight) = 32 THEN
    'onko värimäärä 16?
    IF ASC(IconDir.idEntries.bColorCount) = 16 THEN
      '640x480, 16 väriä
      SCREEN 12
      'lisää tietoa kuvakkeesta
      GET #1, , icHeader
      'paletin määritys
      FOR i = 1 TO 16
        GET #1, , icColors
        OUT &H3C8, i - 1
        OUT &H3C9, ASC(icColors.rgbRed) \ 4
        OUT &H3C9, ASC(icColors.rgbGreen) \ 4
        OUT &H3C9, ASC(icColors.rgbBlue) \ 4
      NEXT
      vari$ = " "
      'kuvan piirtäminen
      FOR i = 32 TO 1 STEP -1
        FOR j = 1 TO 16
          GET #1, , vari$
          'yhdessä tavussa on kaksi pikseliä
          oikea% = ASC(vari$) AND &HF
          vasen% = ASC(vari$) AND &HF0
          DO WHILE vasen% > 15
            vasen% = vasen% - 15
          LOOP
          'piirretään pikselit
          PSET (j * 2, i), vasen%
          PSET (j * 2 + 1, i), oikea%
        NEXT
      NEXT
      'odotetaan näppäimenpainallusta
      SLEEP
      'takaisin tekstitilaan
      SCREEN 0
    ELSE
      PRINT "VIRHE: Kuvakkeen tulee olla 16-värinen!"
    END IF
  ELSE
    PRINT "VIRHE: Kuvakkeen tulee olla 32x32-pikselin kokoinen!"
  END IF
ELSE
  PRINT "VIRHE: Väärän tyyppinen kuvake!"
END IF

'suljetaan tiedosto
CLOSE #1