Creating Icon Bitmaps

From QB64 Phoenix Edition Wiki
Jump to navigation Jump to search
Attention!! - This page is outdated and provided for reference and/or education only.
(Return to historic Table of Contents)
Starting with QB64-PE v3.14.0 Icon files (ICO) can be handled using _LOADIMAGE and _SAVEIMAGE.


Icon Viewer and Bitmap Creator

The following program can be used to view Icon or Cursor images and save them as Bitmaps. When you answer Y the bitmap is saved with a black background so that it can be PUT using XOR on to the AND image. The AND image will be black and white if the image is irregularly shaped(not a full box image). It is placed first using PUT with the AND action or can be placed using _PUTIMAGE with the color white _ALPHA being set to 0. In that case, try just placing the XOR image with the color black 0 alpha with _SETALPHA. 

'********************************* IconType.BI INCLUDE FILE ********************************

TYPE IconType            'Icon or cursor file header
  Reserved AS INTEGER    'Reserved (always 0)
  ID AS INTEGER          'Resource ID (Icon = 1, Cursor = 2)
  Count AS INTEGER       'Number of icon bitmaps in Directory of icon entries array
END TYPE '6 bytes

TYPE ICONENTRY           'or unanimated Cursor entry (see ANI for animated cursors)
  PWidth AS _BYTE        'Width of icon in pixels (USE THIS)
  PDepth AS _BYTE        'Height of icon in pixels (USE THIS)
  NumColors AS _BYTE     'Maximum number of colors: (2 or 16 colors. 256 or 24/32 bit = 0}
  RES2 AS _BYTE          'Reserved. Not used (always 0)
  HotSpotX AS INTEGER    'Icon: NumberPlanes(normally 0), Cursor: hotspot pixels from left
  HotSpotY AS INTEGER    'Icon: BitsPerPixel(normally 0), Cursor: hotspot pixels from top
  DataSize AS LONG       'Length of icon bitmap in bytes (USE THIS)
  DataOffset AS LONG     'Offset byte position of icon bitmap data header in file(add 1)
END TYPE '16 bytes

TYPE ICONHEADER          'Bitmap type header found using entry DataOffset + 1
  IconHSize AS LONG      'size of ICON header (always 40 bytes)
  ICONWidth AS LONG      'bitmap width in pixels. (width and double height may be missing)
  ICONDepth AS LONG      'Total map height in pixels (TWO TIMES the image height).
  NumPlanes AS INTEGER   'number of color planes. Must be set to 1.
  BPP AS INTEGER         'bits per pixel  1, 4, 8, 16, 24 or 32.(USE THIS for BPP)
  Compress AS LONG       'compression method should always be 0.
  RAWSize AS LONG        'size of the raw ICON image data(may only be XOR mask size).
  Hres AS LONG           'horizontal resolution of the image(not normally used)
  Vres AS LONG           'vertical resolution of the image(not normally used)
  NumColors AS LONG      'number of colors in the color palette(not normally used)
  SigColors AS LONG      'number of important colors used(not normally used)
END TYPE '40 byte
Code by Ted Weissgerber
REM $INCLUDE: 'IconType.BI'
DEFINT A-Z
DIM Icon AS IconType
DIM SHARED Item, BPP
DIM SHARED wide&, deep&, bmp&, bmpStretch&
DIM Image(26000)
dst& = _NEWIMAGE(800, 600, 32)
SCREEN dst&

hdr$ = " & File  ID = #  ## Image(s) in file  #######, bytes "
ico$ = "              Size = ## X ##   Colors = ##        Planes = #   BPP = ## "
cur$ = "              Size = ## X ##   Colors = ##   HotSpot X = ##      Y = ## "
dat$ = "              DATA Size = #####, bytes        DATA Offset =  ######,    "
bm1$ = "              HeaderSize = ## MaskArea = ## X ##  Planes = #   BPP = ## "
bm2$ = "              Compression = #   RAW Data Size = ######, bytes         "

LOCATE 20, 20: LINE INPUT "Enter an ICOn or CURsor file name: ", IconName$
L = LEN(IconName$)
IF L = 0 THEN SOUND 400, 4: SYSTEM
dot = INSTR(IconName$, ".")
IF dot = 0 THEN
   Save$ = IconName$: IconName$ = IconName$ + ".ICO"
ELSE Save$ = LEFT$(IconName$, dot - 1)
END IF
OPEN IconName$ FOR BINARY AS #1
length& = LOF(1)
PRINT
IF length& THEN
  GET #1, 1, Icon
  SELECT CASE Icon.ID
    CASE 1: IC$ = "Icon": ent$ = ico$
    CASE 2: IC$ = "Cursor": ent$ = cur$
    CASE ELSE: IC$ = "Bitmap?"
  END SELECT
  LOCATE 22, 20: PRINT USING hdr$; IC$; Icon.ID; Icon.Count; length&
  IF Icon.Count THEN
    count = Icon.Count
    DIM SHARED Entry(count) AS ICONENTRY
    DIM SHARED Header(count) AS ICONHEADER
    FOR Item = 1 TO count                            '16 bytes each entry
      GET #1, , Entry(Item)
    NEXT
    VIEW PRINT 24 TO 32
    FOR Item = 1 TO count
      GET #1, Entry(Item).DataOffset + 1, Header(Item) 'ADD 1 to offsets!
      COLOR _RGB(255, 255, 0): LOCATE 24, 30
      IF count > 1 THEN PRINT " IMAGE ENTRY #"; Item ELSE PRINT " IMAGE ENTRY"
      COLOR _RGB(50, 200, 255)
      PRINT USING ent$; Entry(Item).PWidth; Entry(Item).PDepth; Entry(Item).NumColors; Entry(Item).HotSpotX; Entry(Item).HotSpotY
      PRINT USING dat$; Entry(Item).DataSize; Entry(Item).DataOffset
      PRINT USING bm1$; Header(Item).IconHSize; Header(Item).ICONWidth; Header(Item).ICONDepth, Header(Item).NumPlanes; Header(Item).BPP
      PRINT USING bm2$; Header(Item).Compress; Header(Item).RAWSize
      PRINT
      k$ = INPUT$(1) 'Palette(4 or 8BPP) and/or XOR mask starts immediately after an ICONHEADER
      wide& = Entry(Item).PWidth: deep& = Entry(Item).PDepth: BPP = Header(Item).BPP
      IF BPP > 8 THEN BitColor = 32 ELSE BitColor = 256  'assign for proper colors
      bmpStretch& = _NEWIMAGE(4 * wide&, 4 * deep&, BitColor) 'set either 256 or 32
      bmp& = _NEWIMAGE(wide&, deep&, BitColor) 'don't bother with _FREEIMAGE, reuse them!
      SELECT CASE BPP
        CASE 1: OneBit
        CASE 4: FourBIT
        CASE 8: EightBIT
        CASE IS > 8: TrueCOLOR
      END SELECT
      IF BPP < 24 THEN _COPYPALETTE bmp&, bmpStretch&
      _PUTIMAGE , bmp&, bmpStretch&
      _DEST 0: _PUTIMAGE (100, 0), bmpStretch&
      SOUND 600, 3
      COLOR _RGB(255, 0, 255): LOCATE CSRLIN, 30: PRINT "Save as Bitmap? (Y/N)";
      k$ = INPUT$(1)
      k$ = UCASE$(k$)
      PRINT k$ + SPACE$(1);
      IF k$ = "Y" THEN
          SaveFile$ = Save$ + LTRIM$(STR$(Item)) + ".BMP"
          ThirtyTwoBit 0, 0, wide& - 1, deep& - 1, bmp&, SaveFile$
      END IF
      IF k$ = "Y" THEN PRINT "Saved!" ELSE PRINT "Not saved"
      ANDMask
      IF BPP < 24 THEN _COPYPALETTE bmp&, bmpStretch&
      _PUTIMAGE , bmp&, bmpStretch&
      _DEST 0: _PUTIMAGE (400, 0), bmpStretch&
      IF k$ = "Y" THEN
          ANDFile$ = Save$ + LTRIM$(STR$(Item)) + "BG.BMP"
          ThirtyTwoBit 0, 0, wide& - 1, deep& - 1, bmp&, ANDFile$
      END IF
      k$ = INPUT$(1)
      CLS
    NEXT
    VIEW PRINT
  ELSE SOUND 400, 4: CLOSE #1: PRINT "No images entries found!": END
  END IF
ELSE: CLOSE #1: SOUND 400, 4: KILL IconName$: END
END IF
CLOSE #1
END

SUB OneBit 'adapted from TheBob's Winbit 'B & W monochrome images ONLY (NO PALETTE data)
BitsOver = wide& MOD 32
IF BitsOver THEN ZeroPAD$ = SPACE$((32 - BitsOver) \ 8)
_DEST bmp&
y = deep& - 1: p$ = " "
DO
  x = 0
  DO
    GET #1, , p$
    ByteVAL = ASC(p$)
    FOR Bit% = 7 TO 0 STEP -1 'read bits left to right
      IF ByteVAL AND 2 ^ Bit% THEN PSET (x, y), 15 ELSE PSET (x, y), 0
      x = x + 1
    NEXT Bit%
  LOOP WHILE x < wide&
  GET #1, , ZeroPAD$  '         'prevents odd width image skewing
  y = y - 1 '
LOOP UNTIL y = -1
END SUB

SUB EightBIT 'adapted from TheBob's Winbit      '256 palette data Colors (8 BPP)
IF wide& MOD 4 THEN ZeroPAD$ = SPACE$(4 - (wide& MOD 4))
_DEST bmp&
a$ = " ": u$ = " "
OUT &H3C8, 0
FOR Colr = 0 TO 255
  GET #1, , a$: Blu = ASC(a$) \ 4
  GET #1, , a$: Grn = ASC(a$) \ 4
  GET #1, , a$: Red = ASC(a$) \ 4
  OUT &H3C9, Red
  OUT &H3C9, Grn
  OUT &H3C9, Blu
  GET #1, , u$ '--- unused byte
NEXT Colr
y = deep& - 1: p$ = " "
DO: x = 0
  DO
    GET #1, , p$
    PSET (x, y), ASC(p$)
    x = x + 1
  LOOP WHILE x < wide&
  GET #1, , ZeroPAD$  '           'prevents odd width image skewing
  y = y - 1
LOOP UNTIL y = -1
END SUB

SUB FourBIT 'adapted from TheBob's Winbit  '16 palette data colors (4 BPP = 8 or 16 color)
_DEST bmp&
IF wide& MOD 8 THEN ZeroPAD$ = SPACE$((8 - wide& MOD 8) \ 2) 'prevents odd width image skewing
a$ = " ": u$ = " "
FOR Colr = 0 TO 15
  OUT &H3C8, Colr
  GET #1, , a$: Blu = ASC(a$) \ 4
  GET #1, , a$: Grn = ASC(a$) \ 4
  GET #1, , a$: Red = ASC(a$) \ 4
  OUT &H3C9, Red
  OUT &H3C9, Grn
  OUT &H3C9, Blu
  GET #1, , u$ '--- unused byte
NEXT Colr
y = deep& - 1: p$ = " "
DO
  x = 0
  DO
    GET #1, , p$
    HiNIBBLE = ASC(p$) \ &H10
    LoNIBBLE = ASC(p$) AND &HF
    PSET (x, y), HiNIBBLE
    x = x + 1
    PSET (x, y), LoNIBBLE
    x = x + 1
  LOOP WHILE x < wide&
  GET #1, , ZeroPAD$  '              'prevents odd width image skewing
  y = y - 1
LOOP UNTIL y = -1
END SUB

SUB ANDMask '   'AND MASK is B & W. Black area holds XOR colors, white displays background
BitsOver = wide& MOD 32
IF BitsOver THEN ZeroPAD$ = SPACE$((32 - BitsOver) \ 8) 'look for sizes not multiples of 32 bits
_DEST bmp&
IF BPP < 24 THEN PALETTE '        'remove for a PUT using previous XOR mask palette data
y = deep& - 1: a$ = " ": p$ = " "
DO
  x = 0
  DO
    GET #1, , a$
    ByteVAL = ASC(a$) 'MSBit is left when calculating 16 X 16 cursor map 2 byte integer
    FOR Bit% = 7 TO 0 STEP -1 'values despite M$ documentation that says otherwise!
      IF ByteVAL AND 2 ^ Bit% THEN 'LONG values cannot be used in a cursor file!
        IF BPP > 8 THEN PSET (x, y), _RGB32(255, 255, 255) ELSE PSET (x, y), 15
      ELSE: IF BPP > 8 THEN PSET (x, y), _RGB32(0, 0, 0) ELSE PSET (x, y), 0
      END IF
      x = x + 1        '16 X 16 = 32 bytes, 32 X 32 = 128 bytes AND MASK SIZES
    NEXT Bit%          '48 X 48 = 288 bytes, 64 X 64 = 512 bytes, 128 X 128 = 2048 bytes
  LOOP WHILE x < wide&
  GET #1, , ZeroPAD$   '16 X 16 and 48 X 48 = 2 byte end padder per row in the AND MASK
  y = y - 1            'adds 32 and 96 bytes respectively to the raw data size!
LOOP UNTIL y = -1
END SUB

SUB TrueCOLOR '     ' 16 Million colors. NO PALETTE! Colored by pixels (24 or 32 BPP)
_DEST bmp&
IF ((BMP.PWidth * 3) MOD 4) <> 0 THEN        '3 byte pixels
ZeroPAD$ = SPACE$((4 - ((BMP.PWidth * 3) MOD 4)))
END IF
R$ = " ": G$ = " ": B$ = " "
y = deep& - 1
DO
  x = 0
  DO
    GET #1, , B$            '3 bytes set RGB color intensities
    GET #1, , G$
    GET #1, , R$
    red& = ASC(R$)
    green& = ASC(G$)
    blue& = ASC(B$)
    PSET (x, y), _RGB(red&, green&, blue&) 'returns closest attribute in 4 or 8 bit
    x = x + 1
  LOOP WHILE x < wide&
  GET #1, , ZeroPAD$  '     'prevents odd width image skewing
  y = y - 1
LOOP UNTIL y = -1
END SUB
REM $INCLUDE: '32BitSUB.BM'



'*********************************** 32BitSUB.BM INCLUDE FILE *******************************

SUB ThirtyTwoBit (x1%, y1%, x2%, y2%, image&, Filename$)
  DIM Colors8%(255)
  IF x1% > x2% THEN SWAP x1%, x2%
  IF y1% > y2% THEN SWAP y1%, y2%

  _SOURCE image&
  pixelbytes& = _PIXELSIZE(image&)
  IF pixelbytes& = 0 THEN BEEP: EXIT SUB 'no text screens

  FileType$ = "BM"
  QB64$ = "QB64"           'free advertiising in reserved bytes
  IF pixelbytes& = 1 THEN OffsetBITS& = 1078 ELSE OffsetBITS& = 54 'no palette in 24/32 bit
  InfoHEADER& = 40
  PictureWidth& = (x2% - x1%) + 1  ' don't exceed maximum screen resolutions!
  PictureDepth& = (y2% - y1%) + 1
  NumPLANES% = 1
  IF pixelbytes& = 1 THEN BPP% = 8 ELSE BPP% = 24
  Compression& = 0
  WidthPELS& = 3780
  DepthPELS& = 3780
  IF pixelbytes& = 1 THEN NumColors& = 256    '24/32 bit say none

  IF (PictureWidth& AND 3) THEN ZeroPAD$ = SPACE$(4 - (PictureWidth& AND 3))

  ImageSize& = (PictureWidth& + LEN(ZeroPAD$)) * PictureDepth&
  FileSize& = ImageSIZE& + OffsetBITS&
  f = FREEFILE
  OPEN Filename$ FOR BINARY AS #f

  PUT #f, , FileType$
  PUT #f, , FileSize&
  PUT #f, , QB64$
  PUT #f, , OffsetBITS&
  PUT #f, , InfoHEADER&
  PUT #f, , PictureWidth&
  PUT #f, , PictureDepth&
  PUT #f, , NumPLANES%
  PUT #f, , BPP%
  PUT #f, , Compression&
  PUT #f, , ImageSize&
  PUT #f, , WidthPELS&
  PUT #f, , DepthPELS&
  PUT #f, , NumColors&
  PUT #f, , SigColors&     '51 offset

  IF pixelbytes& = 1 THEN     '4 or 8 BPP Palettes set for 256 colors
    u$ = CHR$(0)
    FOR c& = 0 TO 255  'PUT as BGR order colors
      cv& = _PALLETTECOLOR(c&, image&)
      Colr$ = CHR$(_BLUE32(cv&))
      PUT #f, , Colr$
      Colr$ = CHR$(_GREEN32(cv&))
      PUT #f, , Colr$
      Colr$ = CHR$(_RED32(cv&))
      PUT #f, , Colr$
      PUT #f, , u$  'Unused byte
    NEXT
  END IF

  FOR y% = y2% TO y1% STEP -1   'place bottom up
    FOR x% = x1% TO x2%
     c& = POINT(x%, y%)
     IF pixelbytes& = 1 THEN
       a$ = CHR$(c&)
       Colors8%(ASC(a$)) = 1
     ELSE : a$ = LEFT$(MKL$(c&), 3)
     END IF
     PUT #f, , a$
    NEXT
    PUT #f, , ZeroPAD$
  NEXT

  FOR n = 0 TO 255
    IF Colors8%(n) = 1 THEN SigColors& = SigColors& + 1
  NEXT n
  PUT #f, 51, SigColors&
  CLOSE #f
END SUB
Adapted from code by Bob Seguin
If full code is not displayed, refresh browser!


NOTE: Black areas of an image may become "see through" unless another color attribute is used and set to black!
This can be done by changing another color attribute's RGB settings to 0 or almost 0 and creating a mask after using it in solid black areas of a 4 or 8 BPP palette image. This can also be done using _PUTIMAGE with 32 bit _CLEARCOLOR settings.
See the following page: Creating Sprite Masks


Icon to Bitmap Conversion Function

The following program uses a conversion function with the TYPE definitions inside of the function to eliminate an $INCLUDE library file. 

SCREEN _NEWIMAGE(640, 480, 256)
_TITLE "Icon Converter"
icon$ = "daphne.ico" '<<<<<<<<< change icon file name
bitmap$ = "tempfile.bmp"
indx% = 5 '1 minimum <<<<<<< higher values than count get highest entry image in icon file

IF Icon2BMP(icon$, bitmap$, indx%) THEN
  img& = _LOADIMAGE(bitmap$)
  PRINT img&
  IF img& < -1 THEN '           check that handle value is good before loading
    _ICON img& '                place image in header
    _PUTIMAGE (300, 250), img& 'place image on screen
    _FREEIMAGE img& '           always free unused handles to save memory
    'KILL bitmap$ '              comment out and/or rename to save the bitmaps
  END IF
ELSE PRINT "Could not create bitmap!"
END IF
END
'                ----------------------------------------------------

FUNCTION Icon2BMP% (filein AS STRING, fileout AS STRING, index AS INTEGER)
TYPE ICONTYPE '              Icon or cursor file header
  Reserved AS INTEGER '         Reserved (always 0)
  ID AS INTEGER '               Resource ID (Icon = 1, Cursor = 2)
  Count AS INTEGER '            Number of icon bitmaps in Directory of icon entries array
END TYPE '6 bytes
TYPE ENTRYTYPE '             or unanimated Cursor entry (ANI are animated cursors)
  Wide AS _UNSIGNED _BYTE '     Width of icon in pixels (USE THIS) Use _UNSIGNED over 127
  High AS _UNSIGNED _BYTE '     Height of icon in pixels (USE THIS) Use _UNSIGNED over 127
  NumColors AS _BYTE '          Maximum number of colors. (2, 8 or 16 colors. 256 or 24/32 bit = 0)
  RES2 AS _BYTE '               Reserved. Not used (always 0)
  HotSpotX AS INTEGER '         Icon: NumberPlanes(normally 0), Cursor: hotspot pixels from left
  HotSpotY AS INTEGER '         Icon: BitsPerPixel(normally 0), Cursor: hotspot pixels from top
  DataSize AS LONG '            Length of image data in bytes minus Icon and Entry headers (USE THIS)
  Offset AS LONG '              Start Offset byte position of icon bitmap header(add 1 if TYPE GET)
END TYPE '16 bytes
TYPE PREHEADER '             Bitmap information not in icon BM header
  BM AS INTEGER '               Integer value changed to "BM" by PUT
  Size AS LONG '                Size of the data file(LOF)
  Reser AS LONG'                2 reserved integers are zero automatically
  BOffset AS LONG '             Start offset of pixel data(next byte)
END TYPE '14 bytes
TYPE BMPHEADER '             Bitmap type header found using entry DataOffset + 1
  IconHSize AS LONG '           size of ICON header (always 40 bytes)
  PWidth AS LONG '              bitmap width in pixels (signed integer).
  PDepth AS LONG '              Total map height in pixels (signed integer is 2 times image height)
  NumPlanes AS INTEGER '        number of color planes. Must be set to 1.
  BPP AS INTEGER '              bits per pixel  1, 4, 8, 16, 24 or 32.(USE THIS)
  Compress AS LONG '            compression method should always be 0.
  RAWSize AS LONG '             size of the raw ICON image data(may only be XOR mask size).
  Hres AS LONG '                horizontal resolution of the image(not normally used)
  Vres AS LONG '                vertical resolution of the image(not normally used)
  NumColors AS LONG '           number of colors in the color palette(not normally used)
  SigColors AS LONG '           number of important colors used(not normally used)
END TYPE '40 bytes              palette and image data immediately follow this header!

DIM ICON AS ICONTYPE, ENT AS ENTRYTYPE, PRE AS PREHEADER, BMP AS BMPHEADER

rf = FREEFILE
IF LCASE$(RIGHT$(filein, 4)) = ".ico" THEN 'check file extension is ICO only
  OPEN filein FOR BINARY ACCESS READ AS rf
ELSE EXIT FUNCTION
END IF
GET rf, , ICON 'GET 6 byte icon header
IF ICON.ID <> 1 OR ICON.Count = 0 THEN CLOSE rf: EXIT FUNCTION
IF index > 0 AND index <= ICON.Count THEN entry = 16 * (index - 1) ELSE entry = 16 * (ICON.Count - 1)
PRINT ICON.Count, entry
SEEK rf, 1 + 6 + entry 'start of indexed Entry header selected
GET rf, , ENT 'GET 16 byte Entry Header set by index request or highest available

SEEK rf, 1 + ENT.Offset 'go to BMP header offset given in Entry header
GET rf, , BMP 'GET 40 byte icon bitmap header information
IF BMP.BPP <= 24 THEN pixelbytes = BMP.BPP / 8 ELSE pixelbytes = 3
IF BMP.BPP > 1 AND BMP.BPP <= 8 THEN palettebytes = 4 * (2 ^ BMP.BPP) ELSE palettebytes = 0
datasize& = (ENT.Wide * ENT.High * pixelbytes) + palettebytes 'no padder should be necessary
filesize& = datasize& + 14 + 40 '                      data and palette + header
bmpoffset& = palettebytes + 54 '                       data offset from start of bitmap
BMP.PWidth = ENT.Wide
BMP.PDepth = ENT.High
BMP.RAWSize = datasize& - palettebytes

PRE.BM = CVI("BM") 'integer value changes to "BM" in file
PRE.Size = filesize&
PRE.BOffset = bmpoffset& 'start of data after header and palette if used

wf = FREEFILE
OPEN fileout FOR BINARY AS wf
PUT wf, , PRE 'PUT 14 byte bitmap information
PUT wf, , BMP 'PUT 40 byte bitmap header information
SEEK rf, 1 + ENT.Offset + 40
dat$ = STRING$(datasize&, 0) 'create string variable the length of remaining image data
GET rf, , dat$ 'GET remaining palette and only the XOR image data after the indexed header
PUT wf, , dat$ 'PUT remaining data into new bitmap file
CLOSE rf, wf
Icon2BMP = ICON.Count 'function returns number of images available in icon file
END FUNCTION
Code by Ted Weissgerber
Note: The index selected or the highest numbered icon image less than the index value is the image displayed.


See also


QB64 Programming References

Wiki Pages
Main Page with Articles and Tutorials
QB64 specific keywords (alphabetical)
Original QBasic keywords (alphabetical)
QB64 OpenGL keywords (alphabetical)
Keywords by Usage
Got a question about something?
Frequently Asked Questions about QB64
QB64 Phoenix Edition Community Forum
Links to other QBasic Sites:
Pete's QBasic Forum
Pete's QBasic Downloads
Retrieved from "https://qb64phoenix.com/qb64wiki/index.php?title=Creating_Icon_Bitmaps&oldid=9251"