Private Sub mnuKontrastMehr_Click()
    ContrastFast Picture1, 20
End Sub
 
Private Sub mnuKontrastWenig_Click()
    ContrastFast Picture1, -20
End Sub

Public Sub ContrastFast(ByRef pic As PictureBox, ByVal Percent As Long)
    Dim bmi As BITMAPINFO
    Dim hDIB As Long
    Dim pBits As Long
    Dim hMemDC As Long
    Dim oldObj As Long
    Dim w As Long, h As Long
    Dim arr() As Byte
    Dim i As Long
 
    pic.ScaleMode = vbPixels
    w = pic.ScaleWidth
    h = pic.ScaleHeight
    ' --- Bitmap Setup ---
    With bmi.bmiHeader
        .biSize = Len(bmi.bmiHeader)
        .biWidth = w
        .biHeight = -h
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = 0
    End With
    ' --- DIBSection ---
    hDIB = CreateDIBSection(pic.hDC, bmi, 0, pBits, 0, 0)
    ' --- Memory DC ---
    hMemDC = CreateCompatibleDC(pic.hDC)
    oldObj = SelectObject(hMemDC, hDIB)
    ' --- Bild kopieren ---
    BitBlt hMemDC, 0, 0, w, h, pic.hDC, 0, 0, SRCCOPY
    ' --- Pixel holen ---
    ReDim arr(0 To (w * h * 4) - 1)
    CopyMemory arr(0), ByVal pBits, UBound(arr) + 1
    ' ----------------------------------------
    ' Kontrastfaktor berechnen
    ' Bereich: -100 bis +100
    ' ----------------------------------------
    Dim factor As Double
    factor = (259# * (Percent + 255#)) / (255# * (259# - Percent))
    ' --- LUT erzeugen ---
    Dim lut(0 To 255) As Byte
    Dim v As Long
    For i = 0 To 255
        v = factor * (i - 128) + 128
        If v < 0 Then
            v = 0
        ElseIf v > 255 Then
            v = 255
        End If
        lut(i) = v
    Next i
    ' --- Pixel bearbeiten (BGRA) ---
    For i = 0 To UBound(arr) Step 4
        arr(i) = lut(arr(i))         ' B
        arr(i + 1) = lut(arr(i + 1)) ' G
        arr(i + 2) = lut(arr(i + 2)) ' R
    Next i
    ' --- zurückschreiben ---
    CopyMemory ByVal pBits, arr(0), UBound(arr) + 1
    ' --- anzeigen ---
    BitBlt pic.hDC, 0, 0, w, h, hMemDC, 0, 0, SRCCOPY
    ' --- cleanup ---
    SelectObject hMemDC, oldObj
    DeleteDC hMemDC
    pic.Refresh
End Sub