Attribute VB_Name = "hlp_DrawRawBMP"
' Copyright (C) 2004-2006 Jan Vorel
'
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' This is a shared modul, class modul, usercontrol or form. It is also
' published under the GNU General Public License.

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues

Option Explicit
Option Base 0

' DrawRawBMP_FlagA
'    1 => CreateOnly!
' 1000 => transparency etc

Private Type BITMAPINFOHEADER
  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

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As Any, ByVal wUsage As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
#If (DrawRawBMP_FlagA And &H1&) = &H1& Then
  Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  #Else
  Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  #End If
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long

#If (DrawRawBMP_FlagA And &H1&) = &H1& Then
  Private Declare Function ReleaseDC Lib "user32" (ByVal HWnd As Long, ByVal hdc As Long) As Long
  Private Declare Function GetDC Lib "user32" (ByVal HWnd As Long) As Long
  #End If

Private Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

#If (DrawRawBMP_FlagA And &H1&) = &H1& Then
  #If (DrawRawBMP_FlagA And &H1000&) = &H1000& Then
    Public Function CreateRawBMP(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&, Optional ByVal TransparentForeIndex As Long = -2&, Optional ByVal TransparentForeColor As Long = -1&) As Long
    #Else
    Public Function CreateRawBMP(ByVal xData As String, Optional ByRef Width As Long = 0&, Optional ByRef Height As Long = 0&, Optional ByVal Stretch As Boolean = False) As Long
    #End If
  
  Dim DestHDc As Long
  Const OffsetLeft As Long = 0&
  Const OffsetTop As Long = 0&
  #Else
  #If (DrawRawBMP_FlagA And &H1000&) = &H1000& Then
    Public Function DrawRawBMP(ByVal DestHDc As Long, ByVal xData As String, Optional ByVal OffsetLeft As Long = 0&, Optional ByVal OffsetTop As Long = 0&, 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&, Optional ByVal TransparentForeIndex As Long = -2&, Optional ByVal TransparentForeColor As Long = -1&) As Boolean
    #Else
    Public Function DrawRawBMP(ByVal DestHDc As Long, ByVal xData As String, Optional ByVal OffsetLeft As Long = 0&, Optional ByVal OffsetTop As Long = 0&, Optional ByRef Width As Long = 0&, Optional ByRef Height As Long = 0&, Optional ByVal Stretch As Boolean = False) As Boolean
    #End If
  #End If
  
  Dim xType1 As BITMAPINFOHEADER
  Dim xChar1 As String
  Dim xLong1 As Long
  'Dim ScreenDC As Long
  Dim OldXLong1 As Long
  Dim PicDC As Long
  
  If Len(xData) > 54& Then
    xData = Mid(xData, 15&)
    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 (DrawRawBMP_FlagA And &H1000&) = &H1000& 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
          If TransparentForeIndex < 0& Then TransparentForeIndex = 2 ^ xType1.biBitCount + TransparentForeIndex
          If Not (TransparentForeColor < 0& Or TransparentForeIndex < 0&) And TransparentForeColor < &HFFFFFF And TransparentForeIndex < 2 ^ xType1.biBitCount Then
            Mid(xData, 41& + TransparentForeIndex * 4&, 4&) = Chr(TransparentForeColor \ &H10000) & Chr((TransparentForeColor And &HFF00&) \ &H100&) & Chr(TransparentForeColor And &HFF&) & vbNullChar
            End If
          'If TransparentBackColor < 0& Then transparentcolor = getsyscolor(transparentcolor)
          End If
        #End If
      
      #If (DrawRawBMP_FlagA And &H1&) = &H1& Then
        DestHDc = CreateCompatibleDC(0&)
        If Not DestHDc = 0& Then
          #End If
            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
                  #If (DrawRawBMP_FlagA And &H1&) = &H1& Then
                    CreateRawBMP = xLong1
                    #Else
                    Call DeleteObject(xLong1)
                    DrawRawBMP = True
                    #End If
                  End If
                End If
              Call DeleteDC(PicDC)
              End If
            #If (DrawRawBMP_FlagA And &H1&) = &H1& Then
          Call DeleteDC(DestHDc)
          End If
        #End If
      End If
    End If
  End Function
