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
aarony@redwingsoftware.com
adyoung@win.bright.net

[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...