Attribute VB_Name = "BlackWhite"
'Private Sub CmdBlackWhite_Click()
'    Call BlackAndWhite(pPicture)
'    Call SavePicture(pPicture, "C:\test.bmp")
'End Sub
Option Explicit
Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" ( _
     ByVal hwnd As Long, _
     lpRect As RECT) As Long
Private Declare Function GetPixel Lib "gdi32" ( _
     ByVal hdc As Long, _
     ByVal x As Long, _
     ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" ( _
     ByVal hdc As Long, _
     ByVal x As Long, _
     ByVal y As Long, _
     ByVal crColor As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" ( _
     ByVal hdc As Long, _
     ByVal x As Long, _
     ByVal y As Long, _
     ByVal crColor As Long) As Long
Public Sub BlackAndWhite(ByVal picPictureBox As PictureBox)
'PictureBox properties
Dim Size As RECT
Dim lHeight As Long
Dim lWidth As Long
'PictureBox Handles
Dim picHdc As Long
picHdc = picPictureBox.hdc
Call GetWindowRect(picPictureBox.hwnd, Size)
lWidth = Size.right - Size.left
lHeight = Size.bottom - Size.top

Dim lXpos As Long
Dim lYpos As Long
Dim lColour As Long
         
For lXpos = 0 To lWidth
    For lYpos = 0 To lHeight
        lColour = GetPixel(picHdc, lXpos, lYpos)
        '65280 is &H00FF00
        If ((((lColour And &HFF0000) / &H10000) + _
                ((lColour And 65280) / &H100) + _
                (lColour And &HFF)) / 3) > 127 Then
            'White
            Call SetPixelV(picHdc, lXpos, lYpos, &HFFFFFF)
        Else
            'Black
            Call SetPixelV(picHdc, lXpos, lYpos, &H0)
        End If
    Next
Next
Exit Sub

End Sub