[API]
BITMAPINFOHEADER
ICONINFO
RtlMoveMemory
CreateCompatibleDC
SelectObject
CreateBitmap
BitBlt
DeleteObject
DeleteDC
CreateIconIndirect
Public DestroyIcon

[INCLUDE]

[CODE]
Private Function RawIconEntryToIcon(ByVal xData As String, ByVal Width As Long, ByVal Height As Long) As Long
  Dim xType1 As BITMAPINFOHEADER
  Dim HeaderLen As Long
  Dim MaskHeight As Long
  Dim FirstPicByteLen As Long
  Dim xType2 As ICONINFO
  Dim hDC1 As Long
  Dim hDC2 As Long
  Dim hBmp1 As Long
  Dim hBmpOld1 As Long
  Dim hBmpOld2 As Long
  Dim xSuccess As Boolean

  Call RtlMoveMemory(xType1, ByVal xData, 40&)
  Select Case xType1.biBitCount
    Case 8&: HeaderLen = 4& * 256&
    Case 4&: HeaderLen = 4& * 16&
    Case 1&: HeaderLen = 4& * 2&
    End Select
  HeaderLen = HeaderLen + 40&
  MaskHeight = xType1.biHeight
  xType1.biHeight = Height
  Call RtlMoveMemory(ByVal xData, xType1, 40&)

  FirstPicByteLen = xType1.biWidth * xType1.biBitCount  'bits
  FirstPicByteLen = ((FirstPicByteLen + 7&) And &HFFFFFFF8) / &H8&
  FirstPicByteLen = (FirstPicByteLen + 3&) And &HFFFFFFFC
  FirstPicByteLen = FirstPicByteLen * xType1.biHeight ' + 40&

  #If RawBitmapToBitmapEx And Not RawBitmapToBitmap Then
    xType2.hbmColor = RawBitmapToBitmapEx(Left(xData, FirstPicByteLen + HeaderLen))
    #Else
    xType2.hbmColor = RawBitmapToBitmap(Left(xData, FirstPicByteLen + HeaderLen))
    #End If
'  Stop
  If Not xType2.hbmColor = 0& Then
    xType1.biBitCount = 1&
    xType1.biHeight = Height 'MaskHeight '- Height
    'xType1.biClrImportant = 1&
    'xType1.biClrUsed = 2&
    'xType1.biCompression = 0&
    'xType1.biPlanes = 1&
    'xType1.biSize = 40&
'    xtype1.
    Call RtlMoveMemory(ByVal xData, xType1, 40&)
    'xType2.hbmMask = RawBitmapToBitmap(Left(xData, 40&) + String(4&, vbNullChar) + String(4&, Chr(255)) + Mid(xData, HeaderLen + FirstPicByteLen + 1&))
    'xData = Mid(xData, HeaderLen + FirstPicByteLen + 1&)
    #If RawBitmapToBitmapEx And Not RawBitmapToBitmap Then
      hBmp1 = RawBitmapToBitmapEx(Left(xData, 40&) + String(4&, vbNullChar) + String(4&, Chr(255)) + Mid(xData, HeaderLen + FirstPicByteLen + 1&))
      #Else
      hBmp1 = RawBitmapToBitmap(Left(xData, 40&) + String(4&, vbNullChar) + String(4&, Chr(255)) + Mid(xData, HeaderLen + FirstPicByteLen + 1&))
      #End If
    If Not hBmp1 = 0& Then
      #If BitmapToSpecificBitmap Then
        xType2.hbmMask = BitmapToSpecificBitmap(hBmp1, xType1.biWidth, xType1.biHeight, 1&)
        #Else
        hDC1 = CreateCompatibleDC(0&)
        If Not hDC1 = 0& Then
          hBmpOld1 = SelectObject(hDC1, hBmp1)
          If Not hBmpOld1 = 0& Then
            hDC2 = CreateCompatibleDC(0&)
            If Not hDC2 = 0& Then
              xType2.hbmMask = CreateBitmap(xType1.biWidth, xType1.biHeight, 1&, 1&, ByVal 0&)
              If Not xType2.hbmMask = 0& Then
                hBmpOld2 = SelectObject(hDC2, xType2.hbmMask)
                If Not hBmpOld2 = 0& Then
                  xSuccess = Not (BitBlt(hDC2, 0&, 0&, xType1.biWidth, xType1.biHeight, hDC1, 0&, 0&, vbSrcCopy) = 0&)
                  Call SelectObject(hDC2, hBmpOld2)
                  End If
                If Not xSuccess Then
                  Call DeleteObject(xType2.hbmMask)
                  xType2.hbmMask = 0&
                  End If
                End If
              Call DeleteDC(hDC2)
              End If
            Call SelectObject(hDC1, hBmpOld1)
            End If
          Call DeleteDC(hDC1)
          End If
        #End If
      Call DeleteObject(hBmp1)
      End If
    If Not xType2.hbmMask = 0& Then
      xType2.fIcon = True
      RawIconEntryToIcon = CreateIconIndirect(xType2)
      'Call ClearImage(xType2.hbmMask, xType1.biWidth, xType1.biHeight)
      'Call ClearImage(xType2.hbmColor, xType1.biWidth, xType1.biHeight)
      'DoDrawIcon RawIconEntryToIcon, xType1.biWidth, xType1.biHeight
      Call DeleteObject(xType2.hbmMask)
'      Stop
      End If
    Call DeleteObject(xType2.hbmColor)
    End If
  'If Not RawIconEntryToIcon = 0& Then
  '  DoDrawIcon RawIconEntryToIcon, xType1.biWidth, xType1.biHeight
  '  End If
  End Function
