Managing Colours

[delo]

How can I quickly convert a coloured image in PictureBox Control to shades of gray image (Black & White) ? I need some lines of code or any other help.
Thanx a lot.

[Aaron Young]

Here's some code I've been working on, it's optimized for speed, using the Get/SetPixel APIs:

You'll need: 3 Pictureboxes, (picBMP inside picFrame. picProgress for a Progressbar), 2 CommandButtons, (cmdLoad & cmdGrey), a Horizontal and Vertical Scrollbar and a CommonDialogbox..

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 Sub cmdGrey_Click()
    Dim Y As Integer
    Dim X As Integer
    Dim W As Integer
    Dim H As Integer
    Dim iHeight As Integer
    Dim lDC As Long
    Dim dPerc As Single
    
    W = picBMP.Width
    H = picBMP.Height
    dPerc = picProgress.ScaleWidth / (W * CSng(H))
    iHeight = picProgress.ScaleHeight
    picProgress.Cls
    picProgress.ForeColor = RGB(0, 0, 200)
    lDC = picBMP.hdc
    For Y = 0 To H - 1
        For X = 0 To W - 1
            Call SetPixel(lDC, X, Y, GreyColor(GetPixel(lDC, X, Y)))
        Next
        picProgress.Line (0, 0)-(dPerc * (X + (Y * CSng(W))), iHeight), , BF
        DoEvents
    Next
    picBMP = picBMP.Image
    picProgress.ForeColor = vbWhite
    picProgress.CurrentX = (picProgress.ScaleWidth - picProgress.TextWidth("Done.")) / 2
    picProgress.CurrentY = 0
    picProgress.Print "Done."
End Sub

Private Sub cmdLoad_Click()
    On Error GoTo Cancelled
    With cdbLoad
        .CancelError = True
        .DialogTitle = "Load an Image.."
        .Filter = "Images|*.bmp;*.gif;*.jpg;*.ico"
        .ShowOpen
        picBMP = LoadPicture(.FileName)
    End With
Cancelled:
End Sub

Private Sub Form_Load()
    picBMP.BorderStyle = vbBSNone
    picBMP.BackColor = vbWhite
    picBMP.AutoSize = True
    picFrame.BackColor = vbWhite
    picBMP.ScaleMode = vbPixels
    picFrame.ScaleMode = vbPixels
    picProgress.ScaleMode = vbPixels
    picBMP.AutoRedraw = True
    picBMP_Resize
End Sub

Private Sub HScroll1_Change()
    picBMP.Move -HScroll1, -VScroll1
End Sub

Private Sub picBMP_Resize()
    With picBMP
        If .Width > picFrame.ScaleWidth Then
            HScroll1.Max = .Width - picFrame.ScaleWidth
            HScroll1.LargeChange = HScroll1.Max / 10
            HScroll1.Enabled = True
        Else
            HScroll1.Enabled = False
        End If
        If .Height > picFrame.ScaleHeight Then
            VScroll1.Max = .Height - picFrame.ScaleHeight
            VScroll1.LargeChange = VScroll1.Max / 10
            VScroll1.Enabled = True
        Else
            VScroll1.Enabled = False
        End If
    End With
End Sub

Private Sub VScroll1_Change()
    picBMP.Move -HScroll1, -VScroll1
End Sub

Function GreyColor(ByVal lColor As Long) As Long
    Dim lGrey As Long
    lGrey = ((lColor And vbRed) + ((lColor And vbGreen) / (2 ^ 8)) + ((lColor And vbBlue) / (2 ^ 16))) / 3
    GreyColor = RGB(lGrey, lGrey, lGrey)
End Function

------------------
Aaron Young
Analyst Programmer
[email protected]
[email protected]

[This message has been edited by Aaron Young (edited 10-22-1999).]

[DrBrain]

The API "SetPixelV" is a bit faster than "SetPixel"

[delo]

That works perfectly. Thanks a lot, Aaron.
Yes, the SetpixelV function is a little bit faster. Thanks to DrBrain...