Trasformare un'immagine a colori in bianco e nero
Inserire il seguente codice in un modulo Bas:
Option Explicit
'matrice dei pixel dell'immagine a livelli di grigio
Public grayimage() As Byte
Public widthtwips As Long, heighttwips As Long
Declare Function SetPixel& Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, _
ByVal Y As Long, ByVal crColor As Long)
Declare Function GetPixel& Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, _
ByVal Y As Long)
Public Sub GrayLevel(ByVal picMask As PictureBox)
Dim widthpixels As Long, heightpixels As Long
Dim width As Long, height As Long
Dim pixel As Long
Dim R As Long, G As Long, B As Long
Dim I As Long, J As Long
width = picMask.Picture.width
widthtwips = picMask.ScaleX(width, vbHimetric, vbTwips)
height = picMask.Picture.height
heighttwips = picMask.ScaleY(height, vbHimetric, vbTwips)
widthpixels = picMask.ScaleX(widthtwips, vbTwips, vbPixels)
heightpixels = picMask.ScaleY(heighttwips, vbTwips, vbPixels)
ReDim grayimage(widthpixels, heightpixels)
For I = 0 To widthpixels - 1
DoEvents
For J = 0 To heightpixels - 1
pixel = GetPixel(picMask.hdc, I, J)
R = pixel And &HFF
G = (pixel And &H100FF00) / 256
B = (pixel And &HFF0000) / 65536
grayimage(I, J) = R * 0.299 + G * 0.587 + B * 0.114
Next J
Next I
OpenGrayImage picMask
End Sub
Public Sub OpenGrayImage(ByVal picMask As PictureBox)
Dim I As Long, J As Long, Y As Double
Dim ris As Long, gray As Long
Dim Xpix As Long, Ypix As Long
Xpix = UBound(grayimage, 1)
Ypix = UBound(grayimage, 2)
widthtwips = picMask.ScaleX(UBound(grayimage, 1), vbPixels, vbTwips)
heighttwips = picMask.ScaleY(UBound(grayimage, 2), vbPixels, vbTwips)
For I = 0 To UBound(grayimage, 1)
DoEvents
For J = 0 To UBound(grayimage, 2)
gray = grayimage(I, J)
Y = gray + (gray * 256#) + (gray * 65536#)
'per evitare l'overflow
If Y > 2147483647 Then Y = 2147483647
ris = SetPixel(picMask.hdc, I, J, Y)
Next J
Next I
End Sub
In un Form inserisci un CommandButton ed una PictureBox ed il seguente codice:
Private Sub Command1_Click()
GrayLevel Picture1
End Sub
Se vuoi ripristinare l'immagine a colori inserisci un'atra PictureBox ed un'altro CommandButton.
Infine inserisci il seguente codice:
Private Sub Command2_Click()
Picture1.Picture = Picture2.Image
End Sub
Private Sub Form_Load()
Picture2.Picture = Picture1.Image
End Sub
Testato su: Windows 98, Win Me, Windows 2000 Professional