Grayscaling images

[SteveCRM]

I can't find anything on how to make images black and white! Does anyone here know?

[Joacim Andersson]

Well I'm sure there's a 1000 ways to do this better but here goes.

Public Function GetGrayScale(lngColor As Long) As Long
    Dim nRed&, nGreen&, nBlue&
    nRed = lngColor Mod 256
    nBlue = lngColor \ &H10000
    nGreen = (lngColor Mod &H10000) \ 256
    nRed = (nRed + nBlue + nGreen) \ 3
    GetGrayScale = nRed * &H10000 + nRed * &H100 + nRed
End Function

You can loop through your picture and get every pixels color using the GetPixel API. Pass it to GetGrayScale and use the return value as the argument for SetPixel.

[Joacim Andersson]

Hmmm... That didn't come out right.
Change

&H10000
'and
&H100

To

&H10000
and
&H100

Whitout the spaces.

[SteveCRM]

Um.......I got lots of errors, and how would I do the whole picture?

this turns anything that is not white, black

Private Sub Command1_Click()
    Dim TColor As Long
    For i = 0 To Picture1.Width
        For j = 0 To Picture1.Height
            TColor = GetPixel(Picture1.hdc, i, j)
            If TColor <> vbWhite Then
                Call SetPixel(Picture1.hdc, i, j, vbBlack)
            End If
        Next
    Next
End Sub

[Joacim Andersson]

The errors must be because the post doesn't come out right.
What looks like this:
&H10000 is actually hex for the value 65536
and &H100 is hex for 256

You can use the loop denniswrenn wrote but substitute vbBlack for GetGrayScale(TColor)

Call SetPixel(Picture1.hdc, i, j, GetGrayScale(TColor))

You have to declare SetPixel and GetPixel.

Public Declare Function GetPixel _
 Lib "gdi32" Alias "GetPixel" ( _
 ByVal hdc As Long, _
 ByVal x As Long, _
 ByVal y As Long) As Long

Public Declare Function SetPixel _
 Lib "gdi32" Alias "SetPixel" ( _
 ByVal hdc As Long, _
 ByVal x As Long, _
 ByVal y As Long, _
 ByVal crColor As Long) As Long

Good luck!

[SteveCRM]

Originally posted by Joacim Andersson
You can use the loop denniswrenn wrote but substitute vbBlack for GetGrayScale(TColor)

Call SetPixel(Picture1.hdc, i, j, GetGrayScale(TColor))

I get an error: sub or function not defined

    Dim TColor As Long
    For i = 0 To Picture1.Width
        For j = 0 To Picture1.Height
            TColor = GetPixel(Picture1.hdc, i, j)
            If TColor <> vbWhite Then
                Call SetPixel(Picture1.hdc, i, j, GetGrayScale(TColor))
            End If
        Next
    Next

I get the error in the bold part....Im kind of understanding this, but not enough to fix the bugs. Thanks guys for all this help!

[Joacim Andersson]

Well you have to copy and paste the original code I posted in my first reply! Make the changes to the hex values and run the code.

[oetje]

Don't forget to use Picture1.ScaleWidth instead of Picture1.Width! You also need to set the ScaleMode property of the picturebox to 3(pixels).