VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 2649|回复: 8

[经验技巧] vb图像掩膜

[复制链接]
 楼主| 发表于 2009-11-25 23:13:12 | 显示全部楼层 |阅读模式
本帖最后由 灵之轨迹 于 2009-11-25 23:18 编辑

嘿嘿,最近看了一本叫《机器人导学》的书,这个程序的几个滤镜就来自其中对视觉处理的部分。
大家要是还有一些什么滤镜,都一起发上来吧!
我写的这个函数是可以支持多种滤镜的,就是 n x m 这样的区域掩膜。

因为使用SetPixel函数,速度有点慢,不过效果不错,但是觉得算法的效率不是太高,希望大家帮忙改进一下,谢谢大家了。

图片:

下面有源码下载。

主要代码:
  1. Public Function PicFilter(ByVal hwnd1 As Long, ByVal hwnd2 As Long, ByRef filters() As Long, fx As Long, fy As Long, _
  2.                     ByVal xW As Long, ByVal yH As Long)
  3. 'On Error Resume Next
  4. Dim scr() As Long
  5. ReDim scr(2, xW, yH)
  6. Dim Afilters As Long, fxmid As Long, fymid As Long

  7. Dim i As Long, j As Long, k As Long, l As Long, m As Long
  8. Dim hdcP1 As Long, hdcP2 As Long
  9. hdcP1 = GetWindowDC(hwnd1)
  10. hdcP2 = GetWindowDC(hwnd2)

  11. For i = 0 To (fx * fy - 1)
  12. Afilters = Afilters + filters(i)
  13. Next
  14. If Afilters = 0 Then Afilters = 1
  15. For i = 0 To xW
  16.    For j = 0 To yH
  17.       Dim s As Long
  18.       s = GetPixel(hdcP1, i, j)
  19.       scr(0, i, j) = s Mod 256
  20.          s = s \ 256
  21.       scr(1, i, j) = s Mod 256
  22.          s = s \ 256
  23.       scr(2, i, j) = s Mod 256
  24.       'DoEvents
  25.    Next
  26. Next
  27. fxmid = Int(fx / 2)
  28. fymid = Int(fy / 2)
  29. For i = 0 To xW
  30.    For j = 0 To yH
  31.    Dim t(2) As Long
  32.    On Error Resume Next
  33.    
  34.    For k = 0 To 2
  35.    t(k) = 0  '恢复
  36.        Dim n As Long
  37.        n = 0
  38.        For m = 0 To fy - 1
  39.           For l = 0 To fx - 1
  40.              t(k) = t(k) + scr(k, i + l - fxmid, j + m - fymid) * filters(n)
  41.              'Debug.Print "( " & l - fxmid & "," & m - fymid & ") " & filters(n)
  42.              n = n + 1
  43.           Next l
  44.        Next m
  45.        t(k) = t(k) / Afilters
  46.        If t(k) < 0 Then t(k) = 0
  47.        If t(k) > 255 Then t(k) = 255
  48.       
  49.        DoEvents
  50.    Next
  51.    
  52.    Call SetPixel(hdcP2, i, j, RGB(t(0), t(1), t(2)))
  53.    Next
  54. Next
  55. '------------------------释放-------------------
  56. ReleaseDC hwnd1, hdcP1
  57. ReleaseDC hwnd2, hdcP2

  58. End Function
复制代码

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?立即注册

x

评分

参与人数 1威望 +3 人气 +1 收起 理由
ksni2000 + 3 + 1 发布源码 好神奇啊

查看全部评分

发表于 2009-11-26 14:52:22 | 显示全部楼层
你那不叫掩膜,那叫边缘检测……
回复 支持 反对

使用道具 举报

 楼主| 发表于 2009-11-26 18:03:09 | 显示全部楼层
那只是一种……
前几个才是,不过边缘检测也是靠掩膜来实现的啊
回复 支持 反对

使用道具 举报

头像被屏蔽
发表于 2009-11-26 18:43:12 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
回复 支持 反对

使用道具 举报

发表于 2009-11-26 22:34:33 | 显示全部楼层
我是说“掩膜”这个词听起来很不专业……你可以找一本计算机图像处理/计算机图形学/机器视觉的书来看一看……

评分

参与人数 1威望 +3 收起 理由
灵之轨迹 + 3 学习了,主要是那本书上写的是“掩膜”

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2009-11-27 08:36:21 | 显示全部楼层
xuexi,,,,,,
回复 支持 反对

使用道具 举报

发表于 2009-12-5 19:32:13 | 显示全部楼层
很黄,很强大
回复 支持 反对

使用道具 举报

发表于 2009-12-5 20:59:30 | 显示全部楼层
good!
回复 支持 反对

使用道具 举报

发表于 2009-12-16 17:01:28 | 显示全部楼层
:),多谢。学习
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2022-7-4 05:23

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表