Declare an .ico file

[eoredson]

I found a nice subroutine to return a .bmp file converted from a .ico file:

Code: (Select All)

Function Icon2BMP% (filein As String, fileout As String, index As Integer)
  Dim byte As _Unsigned _Byte, word As Integer, dword As Long
  Dim wide As Long, high As Long, BM As Integer, bpp As Integer
  rf = FreeFile
  If LCase$(Right$(filein, 4)) <> ".ico" Then 'check file extension is ICO only
      Exit Function
  End If
  Open filein For Binary Access Read As rf
  Get rf, , word
  Get rf, , word: icon = word
  Get rf, , word: count = word
  If icon <> 1 Or count = 0 Then Close rf: Exit Function
  If index > 0 And index <= count Then entry = 16 * (index - 1) Else entry = 16 * (count - 1)
  Seek rf, 1 + 6 + entry 'start of indexed Entry header
  Get rf, , byte: wide = byte ' use this unsigned for images over 127
  Get rf, , byte: high = byte ' use this unsigned because it isn't doubled
  Get rf, , word 'number of 4 BPP colors(256 & 32 = 0) & reserved bytes
  Get rf, , dword '2 hot spots both normally 0 in icons, used for cursors
  Get rf, , dword: size = dword 'this could be used, doesn't seem to matter
  Get rf, , dword: offset = dword 'find where the specific index BMP header is
  Seek rf, 1 + offset + 14 'only read the BPP in BMP header
  Get rf, , word: bpp = word
  If bpp = 0 Then Close rf: Exit Function
  If bpp <= 24 Then pixelbytes = bpp / 8 Else pixelbytes = 3
  If bpp > 1 And bpp <= 8 Then palettebytes = 4 * (2 ^ bpp) Else palettebytes = 0
  datasize& = (wide * 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
  readbytes& = datasize& + 28 ' (40 - 12) bytes left to read in BMP header and XOR mask only
  BM = CVI("BM") 'this will create "BM" in file like MKI$ would
  wf = FreeFile
  Open fileout For Binary As wf
  Put wf, , BM
  Put wf, , filesize&
  dword = 0
  Put wf, , dword
  Put wf, , bmpoffset& 'byte location of end of palette or BMP header
  dword = 40
  Put wf, , dword '              start of 40 byte BMP header
  Put wf, , wide
  Put wf, , high
  Seek rf, 1 + offset + 12 '    after 12 bytes start copy of BMP header starting at planes
  dat$ = String$(readbytes&, 0) 'create string to hold remaining bytes needed w/o AND mask data
  Get rf, , dat$ '              copy lower header, palette(if used) and XOR mask
  Put wf, , dat$ '              put all of the string data in the bitmap all at once
  Close rf, wf
  Icon2BMP = count '            return the number of icons available in the icon file
End Function