[API]
BITMAPINFOHEADER
RtlMoveMemory
CreateCompatibleDC
GetDC
CreateCompatibleBitmap
ReleaseDC
SetDIBits
StretchBlt
BitBlt
SelectObject
DeleteDC

[CODE]
Public Function RawBitmapToBitmapEx(ByVal xData As String, Optional ByRef Width As Long = 0&, Optional ByRef Height As Long = 0&, Optional ByVal Stretch As Boolean = False, Optional ByVal TransparentBackIndex As Long = -1&, Optional ByVal TransparentBackColor As Long = -1&) As Long
  Dim DestHDc As Long
  Const OffsetLeft As Long = 0&
  Const OffsetTop As Long = 0&
  
  Dim xType1 As BITMAPINFOHEADER
  Dim xChar1 As String
  Dim xLong1 As Long
  'Dim ScreenDC As Long
  Dim OldXLong1 As Long
  Dim PicDC As Long
  
  ' Strip any bitmap file header
  If Len(xData) > 3& Then
    Call RtlMoveMemory(ByVal VarPtr(xLong1), ByVal xData, 4&)
    If (xLong1 And &HFFFF&) = &H4D42 Then
      xData = Mid(xData, 15&)
      End If
    End If
  If Len(xData) > 40& Then
    Call RtlMoveMemory(xType1, ByVal xData, 40&)
    Select Case xType1.biBitCount
      Case 24&: xChar1 = Mid(xData, 41&): xData = Left(xData, 40&) 'truecolor, no indexes
      Case 8&: xChar1 = Mid(xData, 1065&): xData = Left(xData, 1064&) ' 40 + 4*256 indexes
      Case 4&: xChar1 = Mid(xData, 105&): xData = Left(xData, 104&) ' 40 + 4*16 indexes
      Case 1&: xChar1 = Mid(xData, 49&): xData = Left(xData, 48&) ' 40 + 4*x indexes
      End Select
    
    If Not xChar1 = "" Then
      If Not xType1.biBitCount = 24& Then
        'a=1:? 40+(2^a)*4
        If TransparentBackIndex < 0& Then TransparentBackIndex = 2 ^ xType1.biBitCount + TransparentBackIndex
        If Not (TransparentBackColor < 0& Or TransparentBackIndex < 0&) And TransparentBackColor < &H1000000 And TransparentBackIndex < 2 ^ xType1.biBitCount Then
          Mid(xData, 41& + TransparentBackIndex * 4&, 4&) = Chr(TransparentBackColor \ &H10000) & Chr((TransparentBackColor And &HFF00&) \ &H100&) & Chr(TransparentBackColor And &HFF&) & vbNullChar
          End If
        End If
      
      DestHDc = CreateCompatibleDC(0&)
      If Not DestHDc = 0& Then
        PicDC = CreateCompatibleDC(0&)
        If Not PicDC = 0& Then
          OldXLong1 = GetDC(0&)
          If Not OldXLong1 = 0& Then
            xLong1 = CreateCompatibleBitmap(OldXLong1, xType1.biWidth, xType1.biHeight)
            Call ReleaseDC(0&, OldXLong1)
          
            If Not xLong1 = 0& Then
              'ScreenDC = GetDC(0&)
              'PicDC = CreateCompatibleDC(ScreenDC)
              'Call ReleaseDC(0, ScreenDC)
      
              Call SetDIBits(PicDC, xLong1, 0&, xType1.biHeight, ByVal xChar1, ByVal xData, 0&)
              If Height < 1& Then Height = xType1.biHeight
              If Width < 1& Then Width = xType1.biWidth
              OldXLong1 = SelectObject(PicDC, xLong1)
              If Stretch And Not (Width = xType1.biWidth And Height = xType1.biHeight) Then
                Call StretchBlt(DestHDc, OffsetLeft, OffsetTop, Width, Height, PicDC, 0&, 0&, xType1.biWidth, xType1.biHeight, vbSrcCopy)
                Else
                Call BitBlt(DestHDc, OffsetLeft, OffsetTop, Width, Height, PicDC, 0&, 0&, vbSrcCopy)
                End If
              Call SelectObject(PicDC, OldXLong1)
              'Call ReleaseDC(0&, PicDC)
              
              Height = xType1.biHeight
              Width = xType1.biWidth
              RawBitmapToBitmapEx = xLong1
              End If
            End If
          Call DeleteDC(PicDC)
          End If
        Call DeleteDC(DestHDc)
        End If
      End If
    End If
  End Function
