Public Function SetNewPixelNearBlackPixel()
' Setzt einen neuen schwarzen Pixel neben einen ggf. als schwarz erkannten Pixel
' Das gaukelt dem Anwender vor, er würde ein bedeutend schärferes Bild sehen
 
    Dim x1&, Y1&, color1&, r&, g&, b&, Grenzwert&, Pic1hdc&
    Dim filename As String
 
    Grenzwert = 128
 
    With Fm_Test.PicDummy
        .Picture = LoadPicture(Fm_Test.Pb_Bild.image)
        .ScaleMode = vbPixels
        .AutoSize = True
        .AutoRedraw = True
        Pic1hdc = .hdc
        For Y1 = 0 To .ScaleHeight - 1
            For x1 = 0 To .ScaleWidth - 1
                color1 = GetPixel(Pic1hdc, x1, Y1)
                r = color1 And vbRed
                g = (color1 And vbGreen) \ &H100
                b = (color1 And vbBlue) \ &H10000
                If r < Grenzwert And g < Grenzwert And b < Grenzwert Then
                    ' Mach den gefundenen Pixel schwarz
                    Call SetPixel(Pic1hdc, x1, Y1, vbBlack)
                    ' und setz noch einen schwarzen daneben
                    Call SetPixel(Pic1hdc, x1 - 1, Y1, vbRed)         ' um zu 
                    ' sehen das was passiert
                End If
            Next x1
            DoEvents
        Next Y1
        .Refresh
        filename = Get_TempPath() + "testbild.jpg"
        StartUpGDIPlus 1
        SavePictureAsJPG Fm_Test.PicDummy.Picture, filename, 100
        ShutdownGDIPlus
        Fm_Test.Pb_Bild.image = filename
        Debug.Print "Umsetzung fertig ...."
    End With
 
    Fm_EzDoku.PicDummy.Picture = LoadPicture()
 
End Function