VB实现马赛克

学了2个月的VB做的,请高手给点意见.Option Explicit
Dim x, x1, y, y1, h, w
Dim choicedfile As String
Dim  As Boolean  '定义i, 为窗体级布尔型变量为是否进行局部马赛克标记
Const A1 = 5
Dim mX As Integer, mY As Integer  '存放鼠标在屏幕上的当前坐标
Dim color As Long  '定义color为窗体级长整型变量
Dim r As Integer, g As Integer, b As Integer  'r,g,b为三原色值
Dim starttime As Date, endtime As Date, spendtime As Date
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long Private Sub Command1_Click() '打开文件
On Error GoTo err
CommonDialog1.Filter = "所有文件|*.*|jpeg文件|*.jpg|bmp文件|*.bmp|gif文件|*.gif|ico文件|*.ico|wmf文件|*.wmf|dib文件|*.dib|cur文件|*.cur"'设置所选文件类型CommonDialog1.DialogTitle = "打开"  '将通用对话框标题设置为'打开'CommonDialog1.FileName = ""  '将通用对话框的文件名置空CommonDialog1.ShowOpen  '打开“打开文件”通用对话框If CommonDialog1.FileName <> "" Then choicedfile = CommonDialog1.FileName  '文件名放入choicedfile变量
 
   '在picture1中装入指定的图象
 
 Picture1.Picture = LoadPicture(choicedfile)
 h = Me.ScaleY(Picture1.Picture.Height, vbHimetric)
 w = Me.ScaleX(Picture1.Picture.Width, vbHimetric) Clipboard.Clear  '将剪贴板清空 Clipboard.SetData Picture1.Picture  '将指定的图象放入剪贴板 '装入图象放在picture1,clipboardElse Exit SubEnd IfHScroll1.Max = w
VScroll1.Max = h
Command2.Enabled = False
Command5.Enabled = False
Command3.Enabled = True
Command4.Enabled = True
Exit Sub
err:
MsgBox "打开文件类型错误，请核实！", 0 + 48 + 0, "提示"
End SubPrivate Sub command6_Click()  '退出程序Clipboard.Clear  '将剪贴板清空EndEnd SubPrivate Sub command3_Click()MousePointer = 11  '将鼠标指针设置为沙漏形状Form1.Picture1.AutoRedraw = Truemosaic Picture1
'调用马赛克函数Form1.Picture1.AutoRedraw = FalseMousePointer = 1  '将鼠标指针设置为箭头形状Command2.Enabled = True
Command5.Enabled = True
Exit SubEnd SubPublic Function mosaic(pic As PictureBox)  '马赛克函数Dim row As Integer, lin As IntegerDim rl As Integer, ll As IntegerDim xl As Integer, yl As IntegerDim k As Integer, j As IntegerDim x As Integer, y As Integer'row为马赛克块列数-1，lin为马赛克块行数-1，rl为所余块中的列数，ll为所余块中的行数Dim color As LongDim r As Integer, g As Integer, b As Integerstarttime = Timerow = Int(pic.Width / 2)lin = Int(pic.Height / 2)rl = pic.Width \ 10ll = pic.Height \ 10For y = 0 To (lin) * 10 Step 10 For x = 0 To (row) * 10 Step 10  color = GetPixel(pic.hdc, x + 5, y + 5)  r = (color Mod 256)  b = (Int(color / 65536))  g = Int((color - (b * 65536) - r) / 256)
If y > Picture1.Height Then
  Exit Function
  End If
  For k = 0 To 10   For j = 0 To 10    SetPixel pic.hdc, x + k, y + j, RGB(Abs(r), Abs(g), Abs(b))   Next j  Next k   pic.Refresh   Next x If rl <> 0 Then  xl = pic.ScaleWidth - rl  color = GetPixel(pic.hdc, xl + rl / 2, y + 7)  r = (color Mod 256)  b = (Int(color / 65536))  g = Int((color - (b * 65536) - r) / 256)  For k = 0 To rl - 1   For j = 0 To rl    SetPixel pic.hdc, xl + k, y + j, RGB(Abs(r), Abs(g), Abs(b))   Next j  Next k  pic.Refresh End IfNext yIf ll <> 0 Then yl = pic.ScaleHeight - ll For x = 0 To (row - 1) * 100 Step 1  color = GetPixel(pic.hdc, x + 5, yl + 11 / 2)  r = (color Mod 256)  b = (Int(color / 65536))  g = Int((color - (b * 65536) - r) / 256)  For k = 0 To 50   For j = 0 To 60 - 1    SetPixel pic.hdc, x + k, y + j, RGB(Abs(r), Abs(g), Abs(b))   Next j  Next k pic.Refresh Next xEnd Ifendtime = Timespendtime = endtime - starttimeEnd FunctionPrivate Sub command2_Click()  '保存文件CommonDialog1.Filter = "bmp文件|*.bmp"  '设置保存文件的类型CommonDialog1.DialogTitle = "保存文件"'将通用对话框标题设置为'保存文件'CommonDialog1.FileName = ""  '将通用对话框的文件名置空CommonDialog1.ShowSave  '打开“保存文件”对话框CommonDialog1.DefaultExt = "bmp"  '设置缺省的文件扩展名为bmpIf CommonDialog1.FileName <> "" Then choicedfile = CommonDialog1.FileName SavePicture Picture1.Image, choicedfile  '按输入的文件名保存文件Else Exit SubEnd IfEnd SubPrivate Sub command4_Click()  '局部马赛克If  = False Then  = True '为进行局部马赛克的标记,为真进行局部马赛克处理,为假则不处理Else  = False  '关闭局部马赛克功能
 Picture1.AutoRedraw = False
 
End If
End SubPrivate Sub picture1_click()  '在图象中单击鼠标处进行局部马赛克
Dim il As Integer, jj As Integer
Dim r As Long, g As Long, b As Long
Dim aa As Long
Dim imagepixels(2, 2 * A1, 2 * A1) As Integer
If Picture1.Picture = 0 Then
    MsgBox ("请加载一个图片")
    Exit Sub
End If
If  = True Then
 Picture1.AutoRedraw = True
For il = mY - A1 To mY + A1
For jj = mX - A1 To mX + A1
  aa = GetPixel(Picture1.hdc, il + 100, jj + 100)
  r = (aa Mod 256)  b = (Int(aa / 65536))  g = Int((aa - (b * 65536) - r) / 256)
  imagepixels(0, jj - mX + A1, il - mY + A1) = r          '分别存储像素点的ＧＲＢ值
  imagepixels(1, jj - mX + A1, il - mY + A1) = g
  imagepixels(2, jj - mX + A1, il - mY + A1) = b
Next
Nextr = 0
g = 0
b = 0
For il = 0 To 2 * A1 - 1
  For jj = 0 To 2 * A1 - 1
      r = r + imagepixels(0, jj, il)
      g = g + imagepixels(1, jj, il)
      b = b + imagepixels(2, jj, il)
   Next
Next
   
r = Int(r / (2 * A1) ^ 2)                      '求小方块所有像素点的平均值
g = Int(g / (2 * A1) ^ 2)
b = Int(b / (2 * A1) ^ 2)For il = mY - A1 To mY + A1 / 2
For jj = mX - A1 To mX + A1 / 2
  Picture1.PSet (jj, il), RGB(r, g, b)
Next
Next
End If
End SubPrivate Sub command5_Click()  '复位Picture1.Picture = Clipboard.GetData  '将剪贴板中保存的图象装入picture1HScroll1.Max = w
VScroll1.Max = hEnd Sub Private Sub Form_Load()  '窗体的初始位置Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
End SubPrivate Sub hscroll1_Change()  '水平滚动条Picture1.Left = -(HScroll1.Value \ 2)End SubPrivate Sub picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    '设置当前位置
mX = x
mY = y
Text1 = mX
Text2 = mY
If  = True Then
Command2.Enabled = True
Command5.Enabled = True
End If
End Sub
Private Sub vscroll1_Change()  '垂直滚动条Picture1.Top = -(VScroll1.Value \ 2)End SubPrivate Sub exitm_Click()
Clipboard.ClearEnd
End Sub