Type SAFEARRAYBOUND
  cElements As Long
  lLbound As Long
End Type
 
Type SAFEARRAY2D
  cDims As Integer
  fFeatures As Integer
  cbElements As Long
  cLocks As Long
  pvData As Long
  Bounds(0 To 1) As SAFEARRAYBOUND
End Type
 
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
 
'für  VB 6!
Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" ( _
    ByRef Ptr() As Any) As Long
 
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef pDst As Any, ByRef pSrc As Any, ByVal ByteLen As Long)
 
Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" ( _
    ByVal hObject As Long, ByVal nCount As Long, _
    ByRef lpObject As Any) As Long
 
Private Sub Command1_Click()
Dim Pic() As Byte
Dim SafeArray As SAFEARRAY2D
Dim Bmp As BITMAP
Dim x As Long
Dim y As Long
Dim nRed As Byte
Dim nGreen As Byte
Dim nBlue As Byte
Dim nGray As Long
Dim temp() As Byte
Dim ImgProc As New ImageProcessor
Dim x_ As Long
 
    On Error GoTo Errorhandling
    Call GetObject(Bildfeld.Picture, Len(Bmp), Bmp)
 
    With SafeArray
        .cDims = 2
        .fFeatures = 0
        .cbElements = 1
        .cLocks = 0
        .pvData = Bmp.bmBits
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = Bmp.bmHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = Bmp.bmWidthBytes
    End With
 
    If Bmp.bmBitsPixel <> 24 Then
      MsgBox "Es werden nur 24-Bit Bitmaps unterst¸tzt!"
      Exit Sub
    End If
 
    Call CopyMemory(ByVal VarPtrArray(Pic), VarPtr(SafeArray), 4)
 
    temp = ImgProc.ConvertImage_Gray(Pic) 'Hier wird das Array an eine Funktion 
    ' in der
    For x = 0 To UBound(temp, 1)                      'Klasse übergeben.
    x_ = 0
        For y = 0 To UBound(temp, 2)
        Pic(x_, y) = temp(x, y)
        Pic(x_ + 1, y) = temp(x, y)
        Pic(x_ + 2, y) = temp(x, y)
        Next y
    x_ = x_ + 3
    Next x
    Call CopyMemory(ByVal VarPtrArray(Pic), 0, 4)
 
    Bildfeld.Refresh
    Exit Sub
 
Errorhandling:
    Call CopyMemory(ByVal VarPtrArray(Pic), 0&, 4&)
    Stop
End Sub

Public Function ConvertImage_Gray(ByRef SourcePic As Variant) As Variant
Dim Source() As Byte
Dim width As Long
Dim height As Long
Dim nRed As Long
Dim nGreen As Long
Dim nBlue As Long
Dim nGray As Long
Dim x_ As Long
Dim x As Long
Dim y As Long
Dim temp() As Byte
 
Source = SourcePic
width = UBound(Source, 1) / 3
height = UBound(Source, 2)
ReDim temp(width, height)
x_ = 0
For x = 0 To UBound(Source, 1) - 3 Step 3
    For y = 0 To UBound(Source, 2)
        nBlue = Source(x, y)
        nGreen = Source(x + 1, y)
        nRed = Source(x + 2, y)
        nGray = ((nRed * 30) + (nGreen * 60) + (nBlue * 10)) / 100
        If nGray > 255 Then nGray = 255
        temp(x_, y) = nGray
    Next y
x_ = x_ + 1
Next x
ConvertImage_Gray = temp
 
End Function