已有23人关注
麻烦逐行解释下这段代码
发表在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

分享到:
精彩评论 3
学分: LV1
2010-09-14
沙发
这里主要是使用一些算法实现像素的改变,从而实现图片效果的改变。也就是通过算法修改RGB的值。
掌握下面这些API函数的意义 上面的代码应该就都能理解了。
CreateCompatibleBitmap:该函数创建与指定的设备环境相关的设备兼容的位图。
CreateCompatibleDC:该函数创建一个与指定设备兼容的内存设备上下文环境(DC)。通过GetDc()获取的HDC直接与相关设备沟通,而本函数创建的DC,则是与内存中的一个表面相关联。
SelectObject:该函数选择一对象到指定的设备上下文环境中,该新对象替换先前的相同类型的对象。
GetPixel:该函数检索指定坐标点的像素的RGB颜色值。
SetPixelV:在指定的设备场景中设置一个像素的RGB值
151359000
学分:0 LV1
TA的每日心情
开心
2022-10-18 21:45:59
2010-09-14
板凳
这些函数的作用我懂啊。我问的是能不能逐行给我解释下,我想知道每一行代码的作用以及为什么要这样写!
学分: LV1
2010-09-14
地板
您的代码太长 我们由于还有很多工作要做不能给您逐行解释
而且这些代码中除了这几个API函数,没有难理解的语句
整体的思路就是先获取原图像像素值,然后计算得到对应的像素的RGB分量值,然后就使用算法将RGB值进行改变,最后将改变的像素显示在图像上
还有就是算法,算法要通过整体来看
就是通过一定的计算方法分别改变RGB颜色分量的值
首页上一页 1 下一页尾页 3 条记录 1/1页
手机同步功能介绍
友情提示:以下图书配套资源能够实现手机同步功能
明日微信公众号
明日之星 明日之星编程特训营
客服热线(每日9:00-17:00)
400 675 1066
mingrisoft@mingrisoft.com
吉林省明日科技有限公司Copyright ©2007-2022,mingrisoft.com, All Rights Reserved长春市北湖科技开发区盛北大街3333号长春北湖科技园项目一期A10号楼四、五层
吉ICP备10002740号-2吉公网安备22010202000132经营性网站备案信息 营业执照