需求:一個PictureBox一個Command按鍵)
主表單程式碼
Option Explicit
Dim myPic As Picture
-------------------------------------------------------------------------------------------------------
按下變化按鈕的事件程序
Private Sub Command1_Click()
Dim mywidth As Long, myheigh As Long, myRGB As Long
Dim myDC As Long, i As Long, j As Long
Dim bBlue As Long, bRed As Long, bGreen As Long
Dim Y As Long
mywidth = Picture1.ScaleWidth
myheigh = Picture1.ScaleHeight
myDC = Picture1.hdc
For i = 1 To mywidth
For j = 1 To myheigh
myRGB = GetPixel(myDC, i, j)
bBlue = Blue(myRGB)
bRed = Red(myRGB)
bGreen = Green(myRGB)
Y = (9798 * bRed + 19235 * bGreen + 3735 * bBlue) \ 32768
myRGB = RGB(Y, Y, Y)
SetPixelV myDC, i, j, myRGB
Next j
Next i
Set Picture1.Picture = Picture1.Image '此時才真正顯示Picture
End Sub
表單載入事件程序
Private Sub Form_Load()
Picture1.ScaleMode = 3 '設為Pixel
Picture1.AutoRedraw = True '設定所有Pixel的改變不立即在pictureBox上顯示
Set myPic = Picture1.Picture
End Sub
自訂的RGB色彩轉換函數
'-------------------------------------------------------------------------------------------------------
Private Function Red(ByVal mlColor As Long) As Long
Red = mlColor And &HFF
End Function
'-------------------------------------------------------------------------------------------------------
Private Function Green(ByVal mlColor As Long) As Long
Green = (mlColor \ &H100) And &HFF
End Function
'-------------------------------------------------------------------------------------------------------
Private Function Blue(ByVal mlColor As Long) As Long
Blue = (mlColor \ &H10000) And &HFF
End Function
模組程式碼
'取得畫布某個位置的畫素顏色
Public Declare Function GetPixel Lib "gdi32" _
(ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
'設定畫布某個位置的畫素顏色
Public Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long,
ByVal Y As Long, ByVal crColor As Long) As Long
|