|
在电视节目中，出于某种目的经常看到用马赛克遮挡画面的某些部分，使观众无法看清其真实面目。下面笔者在VB6.0环境下实现这一功能。
在Form1窗体中安放以下控件：
一个框架：Frame1
一个图片框：Picture1
两个滚动条：
水平滚动条:Hscroll1
垂直滚动条：Vscroll1
六个命令按钮：
打开文件：Command1
保存文件：Command2
图象马赛克：Command3
局部马赛克：Command4
复位：Command5
退出：Command6
一个对话框：CommonDialog1（外部控件：Microsoft Common Dialog Control6.0）
运行时首先打开一个图象文件，然后可选取“图象马赛克”或“局部马赛克”两种方式对图象处理。
单击“图象马赛克” 按钮，可一次将整个画面全部处理。“局部马赛克“按钮是个反复按钮，按下后，可将光标移动到画面中的任何位置，点击光标即可在点击处的右下方显示由9个小方块组成的马赛克区域，可继续在其他任意位置处操作，功能依旧。若想取消此功能，可再次单击“局部马赛克”按钮即可。（具体马赛克功能的实现原理说明见程序中注释）
保存文件钮：可将生成的马赛克画面保存为BMP文件；
复位钮：即将画面复原，可再次对其进行马赛克处理；
退出钮：可将程序文件关闭。
下面附“马赛克”MSK.VBP的源程序清单，在WIN98/2000、VB6.0环境下调试通过生成MSK.EXE.
完整源代码：
Dim mark As Boolean '定义i, mark为窗体级布尔型变量
'mark为是否进行局部马赛克标记
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() '打开文件
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.Picture = LoadPicture(choicedfile) '在picture1中装入指定的图象
Clipboard.Clear '将剪贴板清空
Clipboard.SetData Picture1.Picture '将指定的图象放入剪贴板
'装入图象放在picture1,clipboard
Else
Exit Sub
End If
Picture1.AutoSize = True
'将picture1设置为可自动调整大小以适应图象的大小
HScroll1.Max = Form1.Picture1.Width - Form1.Frame1.Width
VScroll1.Max = Form1.Picture1.Height - Form1.Frame1.Height + 2567
'将滚动条与图象进行关联
End Sub
Private Sub command6_Click() '退出程序
Clipboard.Clear '将剪贴板清空
End
End Sub
Private Sub command3_Click()
MousePointer = 11 '将鼠标指针设置为沙漏形状
Form1.Picture1.AutoRedraw = True
mosaic Picture1 '调用马赛克函数
Form1.Picture1.AutoRedraw = False
MousePointer = 1 '将鼠标指针设置为箭头形状
End Sub
Public Function mosaic(pic As PictureBox) '马赛克函数
Dim row As Integer, lin As Integer
Dim rl As Integer, ll As Integer
Dim xl As Integer, yl As Integer
Dim k As Integer, j As Integer
Dim X As Integer, Y As Integer
'row为马赛克块列数-1，lin为马赛克块行数-1，rl为所余块中的列数，ll为所余块中的行数
Dim color As Long
Dim r As Integer, g As Integer, b As Integer
starttime = Time
row = Int(pic.ScaleWidth / 10)
lin = Int(pic.ScaleHeight / 10)
rl = pic.ScaleWidth Mod 10
ll = pic.ScaleHeight Mod 10
For Y = 0 To (lin - 1) * 10 Step 10
For X = 0 To (row - 1) * 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)
For k = 0 To 9
For j = 0 To 9
SetPixel pic.hdc, X + k, Y + j, RGB(r, g, 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 + 5)
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 9
SetPixel pic.hdc, xl + k, Y + j, RGB(r, g, b)
Next j
Next k
pic.Refresh
End If
Next Y
If ll <> 0 Then
yl = pic.ScaleHeight - ll
For X = 0 To (row - 1) * 10 Step 10
color = GetPixel(pic.hdc, X + 5, yl + ll / 2)
r = (color Mod 256)
b = (Int(color / 65536))
g = Int((color - (b * 65536) - r) / 256)
For k = 0 To 9
For j = 0 To ll - 1
SetPixel pic.hdc, X + k, Y + j, RGB(r, g, b)
Next j
Next k
pic.Refresh
Next X
If rl <> 0 Then
color = GetPixel(pic.hdc, xl + rl / 2, yl + ll / 2)
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 ll - 1
SetPixel pic.hdc, X + k, Y + j, RGB(r, g, b)
Next j
Next k
pic.Refresh
End If
End If
endtime = Time
spendtime = endtime - starttime
End Function
Private Sub command2_Click() '保存文件
CommonDialog1.Filter = "bmp文件|*.bmp" '设置保存文件的类型
CommonDialog1.DialogTitle = "保存文件"
'将通用对话框标题设置为'保存文件'
CommonDialog1.FileName = "" '将通用对话框的文件名置空
CommonDialog1.ShowSave '打开“保存文件”对话框
CommonDialog1.DefaultExt = bmp '设置缺省的文件扩展名为bmp
If CommonDialog1.FileName <> "" Then
choicedfile = CommonDialog1.FileName
SavePicture Picture1.Image, choicedfile '按输入的文件名保存文件
Else
Exit Sub
End If
End Sub
Private Sub command4_Click() '局部马赛克
If mark = False Then
mark = True
'mark为进行局部马赛克的标记,为真进行局部马赛克处理,为假则不处理
Picture1.AutoRedraw = True
Else
mark = False '关闭局部马赛克功能
Picture1.AutoRedraw = False
End If
End Sub
Private Sub picture1_click() '在图象中单击鼠标处进行局部马赛克
Dim xl As Integer, yl As Integer
Dim k As Integer, j As Integer
If mark = True Then 'mark = True则允许进行局部马赛克
If Picture1.ScaleWidth - 1 - mX >= 30 And Picture1.ScaleHeight - 1 - mY >= 30 Then
'检测当前鼠标的位置,防止处理边缘溢出
For yl = mY To mY + 20 Step 10 '局部马赛克处理
For xl = mX To mX + 20 Step 10
color = GetPixel(Picture1.hdc, xl + 5, yl + 5)
'取每个马赛克小块的中心象素的颜色为填充整个小块的颜色
r = (color Mod 256)
b = (Int(color / 65536))
g = Int((color - (b * 65536) - r) / 256)
For k = 0 To 9 '填充整个马赛克小块的颜色
For j = 0 To 9
SetPixel Picture1.hdc, xl + k, yl + j, RGB(r, g, b)
Next j
Next k
Picture1.Refresh '图象刷新
Next xl
Next yl
End If
End If
End Sub
Private Sub command5_Click() '复位
Picture1.Picture = Clipboard.GetData '将剪贴板中保存的图象装入picture1
HScroll1.Max = Form1.Picture1.Width - Form1.Frame1.Width
VScroll1.Max = Form1.Picture1.Height - Form1.Frame1.Height + 2567
'将滚动条的最大值分别重新赋值
'2567=frame1.height-picture1.height,在相同高度下frame与picture相差2567
End Sub
Private Sub Form_Load() '窗体的初始位置
Left = 800
Top = 800
End Sub
Private Sub hscroll1_Change() '水平滚动条
Picture1.Left = -HScroll1.Value
End Sub
Private Sub vscroll1_Change() '垂直滚动条
Picture1.Top = -VScroll1.Value
End Sub
Private Sub picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'得到当前鼠标的位置
mX = X
mY = Y
End Sub
Private Sub exitm_Click()
Clipboard.Clear
End
End Sub
|
