VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cPic2Str"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'THIS CLASS IS NOT FROM ME(tHa_imaX)
'ITS FROM ACTIVE-VB.DE THX FOR THIS CLASS!

Option Explicit

Private Declare Function GetBitmapBits Lib "gdi32" _
   (ByVal hBitmap As Long, ByVal dwCount As Long, _
   lpBits As Any) As Long

Private Declare Function SetBitmapBits Lib "gdi32" _
   (ByVal hBitmap As Long, ByVal dwCount As Long, _
   lpBits As Any) As Long
   
Private Declare Function GetObject Lib "gdi32" Alias _
   "GetObjectA" (ByVal hObject As Long, ByVal nCount _
   As Long, lpObject As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias _
    "RtlMoveMemory" (Destination As Any, Source As Any, _
    ByVal Length As Long)
    
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Dim Data As String 'Der wichtige String, mit der Bitmap datei

Public Function GetBitmapData(pBox As PictureBox) As String
    'Aus der Bitmap den String erstellen

    'Deklarationen der Informationen
    Dim BitmapData As String
    Dim BitmapHeight As Long
    Dim strBitmapHeight As String
    Dim BitmapWidth As Long
    Dim strBitmapWidth As String
    Dim BytesPerPixel As Integer
    Dim strBytesPerPixel As String
    Dim BitmapBytes As Long
    
    Dim BMP As BITMAP         ' vom Typ BITMAP (siehe Deklarationsbereich)
    
    GetObject pBox.Image.Handle, Len(BMP), BMP 'Übergabe des Objektes
    BitmapHeight = BMP.bmHeight                    'Setzen der Eigenschaften
    BitmapWidth = BMP.bmWidth
    BytesPerPixel = (BMP.bmBitsPixel \ 8)
    BitmapBytes = BitmapHeight * BitmapWidth * BytesPerPixel
    
    BitmapData = Space$(BitmapBytes)
    GetBitmapBits pBox.Image.Handle, BitmapBytes, ByVal BitmapData
    
    strBitmapHeight = Space$(4)
    CopyMemory ByVal strBitmapHeight, BitmapHeight, 4
    
    strBitmapWidth = Space$(4)
    CopyMemory ByVal strBitmapWidth, BitmapWidth, 4
    
    strBytesPerPixel = Space$(2)
    CopyMemory ByVal strBytesPerPixel, BytesPerPixel, 2
    
    'String zusammenfügen und zurückgeben
    GetBitmapData = strBitmapHeight & strBitmapWidth & strBytesPerPixel & BitmapData
End Function
 
Public Sub SetBitmapData(Data As String, pBox As PictureBox)
    'Aus dem String die Bitmap zurückerstellen
    
    'Deklarationen der Informationen
    Dim BitmapData As String
    Dim BitmapHeight As Long
    Dim strBitmapHeight As String
    Dim BitmapWidth As Long
    Dim strBitmapWidth As String
    Dim BytesPerPixel As Integer
    Dim strBytesPerPixel As String
    Dim BitmapBytes As Long
    
    strBitmapHeight = Left$(Data, 4)
    strBitmapWidth = Mid$(Data, 5, 4)
    strBytesPerPixel = Mid$(Data, 9, 2)
    BitmapData = Mid$(Data, 11)
     
    CopyMemory BitmapHeight, ByVal strBitmapHeight, 4
    CopyMemory BitmapWidth, ByVal strBitmapWidth, 4
    CopyMemory BytesPerPixel, ByVal strBytesPerPixel, 2
    
    pBox.Height = BitmapHeight    'Die PicBox anpassen
    pBox.Width = BitmapWidth
    
    BitmapBytes = BitmapHeight * BitmapWidth * BytesPerPixel
    
    'Das Bild übergeben
    SetBitmapBits pBox.Image.Handle, BitmapBytes, ByVal BitmapData
    pBox.Refresh
End Sub
 
