首页上一页 1 下一页尾页 3 条记录 1/1页
麻烦逐行解释下这段代码
发表在VB答疑区
2010-09-13
是否精华
是
否
版块置顶:
是
否
麻烦逐行解释下这段代码
Option Explicit
Dim ImageR() As Integer
Dim ImageG() As Integer
Dim ImageB() As Integer
Private Sub Form_Load()
Dim i As Long
For i = 0 To 5
mnuGlasses(i).Enabled = False
Next i
End Sub
Private Sub mnuGlasses_Click(Index As Integer)
Dim a As String
Select Case Index
Case 0
a = "柔化"
Case 1
a = "锐化"
Case 2
a = "浮雕"
Case 3
a = "雕刻"
Case 4
a = "扩散"
Case 5
a = "曝光"
End Select
Glasses (Index)
End Sub
Sub Glasses(n As Long)
Dim x As Long, y As Long
Dim i As Long, j As Long
Dim r As Long, g As Long, b As Long
Dim hBmp As Long, hDestDc As Long
Dim a As Long, c As Long
x = Picture1.ScaleWidth
y = Picture1.ScaleHeight
hBmp = CreateCompatibleBitmap(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
hDestDc = CreateCompatibleDC(Picture1.hdc)
SelectObject hDestDc, hBmp
Select Case n
Case 0
For i = 1 To y - 2
For j = 1 To x - 2
r = ImageR(i - 1, j - 1) _
+ ImageR(i - 1, j) _
+ ImageR(i - 1, j + 1) _
+ ImageR(i, j - 1) _
+ ImageR(i, j) _
+ ImageR(i, j + 1) _
+ ImageR(i + 1, j - 1) _
+ ImageR(i + 1, j) _
+ ImageR(i + 1, j + 1)
g = ImageG(i - 1, j - 1) _
+ ImageG(i - 1, j) _
+ ImageG(i - 1, j + 1) _
+ ImageG(i, j - 1) _
+ ImageG(i, j) _
+ ImageG(i, j + 1) _
+ ImageG(i + 1, j - 1) _
+ ImageG(i + 1, j) _
+ ImageG(i + 1, j + 1)
b = ImageB(i - 1, j - 1) _
+ ImageB(i - 1, j) _
+ ImageB(i - 1, j + 1) _
+ ImageB(i, j - 1) _
+ ImageB(i, j) _
+ ImageB(i, j + 1) _
+ ImageB(i + 1, j - 1) + _
ImageB(i + 1, j) + _
ImageB(i + 1, j + 1)
SetPixelV hDestDc, j, i, RGB(r \ 9, g \ 9, b \ 9)
Next j
Next i
Case 1
For i = 1 To y - 2
For j = 1 To x - 2
r = ImageR(i, j) + 0.5 * (ImageR(i, j) - ImageR(i - 1, j - 1))
g = ImageG(i, j) + 0.5 * (ImageG(i, j) - ImageG(i - 1, j - 1))
b = ImageB(i, j) + 0.5 * (ImageB(i, j) - ImageB(i - 1, j - 1))
If r > 255 Then r = 255
If r < 0 Then r = 0
If g > 255 Then g = 255
If g < 0 Then g = 0
If b > 255 Then b = 255
If b < 0 Then b = 0
SetPixelV hDestDc, j, i, RGB(r, g, b)
Next j
Next i
Case 2
For i = 1 To y - 2
For j = 1 To x - 2
r = Abs(ImageR(i, j) - ImageR(i + 1, j + 1) + 128)
g = Abs(ImageG(i, j) - ImageG(i + 1, j + 1) + 128)
b = Abs(ImageB(i, j) - ImageB(i + 1, j + 1) + 128)
SetPixelV hDestDc, j, i, RGB(r, g, b)
Next j
Next i
Case 3
For i = 2 To y - 1
For j = 2 To x - 1
r = Abs(ImageR(i, j) - ImageR(i - 1, j - 1) + 128)
g = Abs(ImageG(i, j) - ImageG(i - 1, j - 1) + 128)
b = Abs(ImageB(i, j) - ImageB(i - 1, j - 1) + 128)
SetPixelV hDestDc, j, i, RGB(r, g, b)
Next j
Next i
Case 4
For i = 2 To y - 3
For j = 2 To x - 3
a = Rnd() * 4 - 2
c = Rnd() * 4 - 2
r = ImageR(i + a, j + c)
g = ImageG(i + a, j + c)
b = ImageB(i + a, j + c)
SetPixelV hDestDc, j, i, RGB(r, g, b)
Next j
Next i
Case 5
For i = 1 To y - 2
For j = 1 To x - 2
r = ImageR(i, j)
g = ImageG(i, j)
b = ImageB(i, j)
If ((r < 128) Or (r > 255)) Then r = 255 - r
If ((g < 128) Or (g > 255)) Then g = 255 - g
If ((b < 128) Or (b > 255)) Then b = 255 - b
SetPixelV hDestDc, j, i, RGB(r, g, b)
Next j
Next i
End Select
BitBlt Picture1.hdc, 1, 1, Picture1.ScaleWidth - 2, Picture1.ScaleHeight - 2, hDestDc, 1, 1, &HCC0020
Picture1.Refresh
Call DeleteDC(hDestDc)
Call DeleteObject(hBmp)
End Sub
Private Sub mnuPicOpen_Click()
On Error GoTo err
CommonDialog1.Filter = "图像文件(*.jpg)|*.jpg"
CommonDialog1.ShowOpen
Picture1.Picture = LoadPicture(CommonDialog1.FileName)
Picture1.Visible = True
Form1.Width = Picture1.Width
Form1.Height = Picture1.Height
LoadImage
Dim i As Long
For i = 0 To 5
mnuGlasses(i).Enabled = True
Next i
err:
End Sub
Private Sub mnuQuit_Click()
Unload Form1
End
End Sub
Sub LoadImage()
Dim x As Long, y As Long
Dim i As Long, j As Long, p As Long
Dim r As Long, g As Long, b As Long
Dim hBmp As Long, hDestDc As Long
Dim hdc As Long
hdc = Picture1.hdc
x = Picture1.ScaleWidth
y = Picture1.ScaleHeight
ReDim ImageR(y - 1, x - 1)
ReDim ImageG(y - 1, x - 1)
ReDim ImageB(y - 1, x - 1)
hBmp = CreateCompatibleBitmap(hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
hDestDc = CreateCompatibleDC(hdc)
SelectObject hDestDc, hBmp
For i = 0 To y - 1
For j = 0 To x - 1
p = GetPixel(hdc, j, i)
r = p And 255
g = (p And &HFF00FF00) / 256
b = ((p And &HFF0000) / 65536)
ImageR(i, j) = r
ImageG(i, j) = g
ImageB(i, j) = b
Next j
Next i
Call DeleteDC(hDestDc)
Call DeleteObject(hBmp)
End Sub
Option Explicit
Dim ImageR() As Integer
Dim ImageG() As Integer
Dim ImageB() As Integer
Private Sub Form_Load()
Dim i As Long
For i = 0 To 5
mnuGlasses(i).Enabled = False
Next i
End Sub
Private Sub mnuGlasses_Click(Index As Integer)
Dim a As String
Select Case Index
Case 0
a = "柔化"
Case 1
a = "锐化"
Case 2
a = "浮雕"
Case 3
a = "雕刻"
Case 4
a = "扩散"
Case 5
a = "曝光"
End Select
Glasses (Index)
End Sub
Sub Glasses(n As Long)
Dim x As Long, y As Long
Dim i As Long, j As Long
Dim r As Long, g As Long, b As Long
Dim hBmp As Long, hDestDc As Long
Dim a As Long, c As Long
x = Picture1.ScaleWidth
y = Picture1.ScaleHeight
hBmp = CreateCompatibleBitmap(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
hDestDc = CreateCompatibleDC(Picture1.hdc)
SelectObject hDestDc, hBmp
Select Case n
Case 0
For i = 1 To y - 2
For j = 1 To x - 2
r = ImageR(i - 1, j - 1) _
+ ImageR(i - 1, j) _
+ ImageR(i - 1, j + 1) _
+ ImageR(i, j - 1) _
+ ImageR(i, j) _
+ ImageR(i, j + 1) _
+ ImageR(i + 1, j - 1) _
+ ImageR(i + 1, j) _
+ ImageR(i + 1, j + 1)
g = ImageG(i - 1, j - 1) _
+ ImageG(i - 1, j) _
+ ImageG(i - 1, j + 1) _
+ ImageG(i, j - 1) _
+ ImageG(i, j) _
+ ImageG(i, j + 1) _
+ ImageG(i + 1, j - 1) _
+ ImageG(i + 1, j) _
+ ImageG(i + 1, j + 1)
b = ImageB(i - 1, j - 1) _
+ ImageB(i - 1, j) _
+ ImageB(i - 1, j + 1) _
+ ImageB(i, j - 1) _
+ ImageB(i, j) _
+ ImageB(i, j + 1) _
+ ImageB(i + 1, j - 1) + _
ImageB(i + 1, j) + _
ImageB(i + 1, j + 1)
SetPixelV hDestDc, j, i, RGB(r \ 9, g \ 9, b \ 9)
Next j
Next i
Case 1
For i = 1 To y - 2
For j = 1 To x - 2
r = ImageR(i, j) + 0.5 * (ImageR(i, j) - ImageR(i - 1, j - 1))
g = ImageG(i, j) + 0.5 * (ImageG(i, j) - ImageG(i - 1, j - 1))
b = ImageB(i, j) + 0.5 * (ImageB(i, j) - ImageB(i - 1, j - 1))
If r > 255 Then r = 255
If r < 0 Then r = 0
If g > 255 Then g = 255
If g < 0 Then g = 0
If b > 255 Then b = 255
If b < 0 Then b = 0
SetPixelV hDestDc, j, i, RGB(r, g, b)
Next j
Next i
Case 2
For i = 1 To y - 2
For j = 1 To x - 2
r = Abs(ImageR(i, j) - ImageR(i + 1, j + 1) + 128)
g = Abs(ImageG(i, j) - ImageG(i + 1, j + 1) + 128)
b = Abs(ImageB(i, j) - ImageB(i + 1, j + 1) + 128)
SetPixelV hDestDc, j, i, RGB(r, g, b)
Next j
Next i
Case 3
For i = 2 To y - 1
For j = 2 To x - 1
r = Abs(ImageR(i, j) - ImageR(i - 1, j - 1) + 128)
g = Abs(ImageG(i, j) - ImageG(i - 1, j - 1) + 128)
b = Abs(ImageB(i, j) - ImageB(i - 1, j - 1) + 128)
SetPixelV hDestDc, j, i, RGB(r, g, b)
Next j
Next i
Case 4
For i = 2 To y - 3
For j = 2 To x - 3
a = Rnd() * 4 - 2
c = Rnd() * 4 - 2
r = ImageR(i + a, j + c)
g = ImageG(i + a, j + c)
b = ImageB(i + a, j + c)
SetPixelV hDestDc, j, i, RGB(r, g, b)
Next j
Next i
Case 5
For i = 1 To y - 2
For j = 1 To x - 2
r = ImageR(i, j)
g = ImageG(i, j)
b = ImageB(i, j)
If ((r < 128) Or (r > 255)) Then r = 255 - r
If ((g < 128) Or (g > 255)) Then g = 255 - g
If ((b < 128) Or (b > 255)) Then b = 255 - b
SetPixelV hDestDc, j, i, RGB(r, g, b)
Next j
Next i
End Select
BitBlt Picture1.hdc, 1, 1, Picture1.ScaleWidth - 2, Picture1.ScaleHeight - 2, hDestDc, 1, 1, &HCC0020
Picture1.Refresh
Call DeleteDC(hDestDc)
Call DeleteObject(hBmp)
End Sub
Private Sub mnuPicOpen_Click()
On Error GoTo err
CommonDialog1.Filter = "图像文件(*.jpg)|*.jpg"
CommonDialog1.ShowOpen
Picture1.Picture = LoadPicture(CommonDialog1.FileName)
Picture1.Visible = True
Form1.Width = Picture1.Width
Form1.Height = Picture1.Height
LoadImage
Dim i As Long
For i = 0 To 5
mnuGlasses(i).Enabled = True
Next i
err:
End Sub
Private Sub mnuQuit_Click()
Unload Form1
End
End Sub
Sub LoadImage()
Dim x As Long, y As Long
Dim i As Long, j As Long, p As Long
Dim r As Long, g As Long, b As Long
Dim hBmp As Long, hDestDc As Long
Dim hdc As Long
hdc = Picture1.hdc
x = Picture1.ScaleWidth
y = Picture1.ScaleHeight
ReDim ImageR(y - 1, x - 1)
ReDim ImageG(y - 1, x - 1)
ReDim ImageB(y - 1, x - 1)
hBmp = CreateCompatibleBitmap(hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
hDestDc = CreateCompatibleDC(hdc)
SelectObject hDestDc, hBmp
For i = 0 To y - 1
For j = 0 To x - 1
p = GetPixel(hdc, j, i)
r = p And 255
g = (p And &HFF00FF00) / 256
b = ((p And &HFF0000) / 65536)
ImageR(i, j) = r
ImageG(i, j) = g
ImageB(i, j) = b
Next j
Next i
Call DeleteDC(hDestDc)
Call DeleteObject(hBmp)
End Sub