VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsBitmap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------
' Module    : clsBitmap
' Date      : 6/25/2004
' Author    : ALKO (alfred.koppold@freenet.de)
' Purpose   : Class for handling BMP images
'---------------------------------------------------------------------------------------

Option Explicit

Private Const SRCCOPY = &HCC0020
Private Const BI_RGB = 0&
Private Const CBM_INIT = &H4
Private Const DIB_RGB_COLORS = 0

Private Type RGBTriple
    Red As Byte
    Green As Byte
    Blue As Byte
End Type

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 Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO_24
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

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
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateDIBitmap Lib "gdi32" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_24, ByVal wUsage As Long) As Long

Private clsFunctions As New clsFunctions

Private bm24 As BITMAPINFO_24

Private hBmp As Long

Public Sub DrawBitmap(PicWidth As Long, PicHeight As Long, PicObject As Object, Scalierung As Boolean)
Dim Delivery As ScTw

Dim cDC As Long
Dim a As Long
Dim b As Long
Dim realheight As Long
Dim realwidth As Long

PicObject.Cls
If TypeOf PicObject Is Form Then
    'change ScaleMode direct
Else
    b = PicObject.Parent.ScaleMode
    PicObject.Parent.ScaleMode = 1
End If

a = PicObject.ScaleMode
PicObject.ScaleMode = 1
Select Case Scalierung
    Case True
        Delivery = modModule.PixelToTwips(PicWidth, PicHeight)
        PicObject.Height = Delivery.Height
        PicObject.Width = Delivery.Width
    Case False
End Select

If PicObject.Height <> PicObject.ScaleHeight Then 'with Boarders
    Delivery = modModule.TwipsToPixel(PicObject.Width, PicObject.Height)
    realheight = Delivery.Height
    realwidth = Delivery.Width
    PicObject.Height = PicObject.Height + (PicObject.Height - PicObject.ScaleHeight)
    PicObject.Width = PicObject.Width + (PicObject.Width - PicObject.ScaleWidth)
Else
    PicObject.ScaleMode = 3
    realheight = PicObject.ScaleHeight
    realwidth = PicObject.ScaleWidth
End If
If hBmp Then
    cDC = CreateCompatibleDC(PicObject.hdc)
    SelectObject cDC, hBmp
    Call StretchBlt(PicObject.hdc, 0, 0, realwidth, realheight, cDC, 0, 0, PicWidth, PicHeight, SRCCOPY)
    DeleteDC cDC
End If
If TypeOf PicObject Is Form Then
    'change ScaleMode direct
Else
    PicObject.Parent.ScaleMode = b
End If
PicObject.ScaleMode = a
PicObject.Picture = PicObject.Image
End Sub

Public Sub CreateBitmap_24(ByteArray() As Byte, PicWidth As Long, PicHeight As Long, Orientation As Integer) 'Creates a device independent bitmap from the pixel data in BitmapArray().
Dim Bits() As RGBQUAD

Dim hdc As Long

ReDim Bits(UBound(ByteArray) / 4)
RtlMoveMemory Bits(0), ByteArray(0), UBound(ByteArray)
With bm24.bmiHeader
    .biSize = Len(bm24.bmiHeader) 'SizeOf Struct
    .biWidth = PicWidth           'Bitmap Width
    If Orientation = 0 Then
        .biHeight = PicHeight     'Bitmap Height, bitmap is top down.
    Else
        .biHeight = -PicHeight
    End If
    .biPlanes = 1                 'Single plane
    .biBitCount = 32              '32 bit alignment
    .biCompression = BI_RGB       'No Compression
    .biSizeImage = 0              'Default
    .biXPelsPerMeter = 0          'Default
    .biYPelsPerMeter = 0          'Default
    .biClrUsed = 0                'Default
    .biClrImportant = 0           'Default
End With
hdc = GetDC(0)
hBmp = CreateDIBitmap(hdc, bm24.bmiHeader, CBM_INIT, Bits(0), bm24, DIB_RGB_COLORS)
End Sub

