VB 图像处理中值滤波

Question

我下面的程序做的是3*3的中值滤波，问题出在我把要处理的那部分的二维数组转化为一维排序后，再取中间值的时候，写的exchange过程，调用的时候排序结果不能更新，Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Dim bmp As BITMAP
Dim b() As Byte
Dim i As Integer, j As Integer
Dim result As Long
Dim bytArrImg() As Byte
Dim arry() As Byte
Dim temp As Integer
Dim x, y As Integer
Dim m, n As Integer
Dim u, v As Integer
Dim lngsum, k As Long, lngcount As Long
Dim size As Long
'size = InputBox("请输入模板大小")
Public Function max(x As Long, y As Long) As Long
If x >= y Then
max = x
Else
max = y
End If
End Function
Public Function min(x As Long, y As Long) As Long
If x < y Then
min = x
Else
min = y
End If
End FunctionPrivate Sub Command1_Click()
result = GetObject(Picture1.Picture.Handle, Len(bmp), bmp)
ReDim bytArrImg(bmp.bmHeight * bmp.bmWidth - 1)
GetBitmapBits Picture1.Picture, bmp.bmWidth * bmp.bmHeight - 1, bytArrImg(0)
 ReDim arry(0 To bmp.bmHeight - 1, 0 To bmp.bmWidth - 1)
For x = 0 To bmp.bmHeight - 1
    For y = 0 To bmp.bmWidth - 1
        arry(x, y) = bytArrImg(x * bmp.bmWidth + y)
    Next y
Next x
'Call exchange(1, 2)
'Call exchange(2, 2)
''Call exchange(3, 2)
''''Call exchange(4, 2)
''''Call exchange(5, 2)
''''Call exchange(6, 2)
''''Call exchange(7, 2)
''''Call exchange(8, 2)
For i = 1 To bmp.bmHeight - 2
    For j = 1 To bmp.bmWidth - 2
       Call exchange(i, j)
     Next j
Next iFor x = 1 To bmp.bmHeight - 2
   For y = 1 To bmp.bmWidth - 2
        bytArrImg(x * bmp.bmWidth + y) = arry(x, y)
   Next y
   Next x
SetBitmapBits Picture1.Picture, bmp.bmWidth * bmp.bmHeight - 1, bytArrImg(0)
Picture2.Picture = Picture1.Picture
End Sub
Private Sub Command2_Click()
CommonDialog1.Filter = "图片(*.jpg)|*.jpg|bitmap(*.bmp)|*.bmp"
    CommonDialog1.ShowOpen
    Picture1.Picture = LoadPicture(CommonDialog1.FileName)
End SubPublic Sub exchange(ByVal i As Integer, ByVal j As Integer) '部分二维数组排序
     
     'Erase b()
     For m = max(0, i - 1) To min(bmp.bmHeight - 1, i + 1)
       For n = max(0, j - 1) To min(bmp.bmWidth - 1, j + 1)
        ' k = 0
          ReDim Preserve b(k)
          Print arry(m, n)
          b(k) = arry(m, n)                                '二维转化为一维
          k = k + 1
       Next n
     Next m
     For k = 0 To 8                                          '排序
      For v = k To 8
           If b(k) > b(v) Then
           temp = b(k)
           b(k) = b(v)
           b(v) = temp
        End If
      Next v
     'Print b(k)
      Next k
'      i = 0
'      For i = 0 To 8
'       Print b(i)
'       Next      'Print
   arry(i, j) = b(k \ 2)  '取中间值替换原值
'    Print
'   Print arry(i, j)
'   Print
End Sub

Answer 1

楼主这个是做马赛克效果?
有几个问题:
1: 中间的关键部分单独用了一个函数实现,在循环中调用.  这样会比较慢,因为调用函数的开销不小,简易直接把处理数据的算法部分整合到大函数里去,会快很多.
2:如果真的是做马赛克的话(我从代码上猜的),不应该用这样的算法,而应该用直方图法,把出现最多的数字赋给整块区域(楼主用的是8x8吧)
最后,楼主说的"调用的时候排序结果不能更新",实在没明白是什么意思.