回 帖 发 新 帖 刷新版面

主题:[原创]休闲小作品

电视节目上有时会出现一些用马赛克色块屏蔽部分画面的现象,本人在空余之时编了下面这个模拟小程序,该程序不能实用,仅仅模拟而已。程序运行后只要用鼠标点击画面,马赛克就会随着鼠标的移动而移动。在编制该程序中,本人也学到了不少有关VB在图象和色彩方面的编程知识和技巧,以此和大家共享。

第一步:
建立一个普通窗体 Form1,在窗体上放一个 PictureBox 控件,命名为 Picture_Main
Picture_main 静态属性设置如下:
AutoRedraw = True
AutoSize = True
ScaleMode = 3
Picture = "自己喜欢的 BMP 或 JPG 图象,长宽不小于100都可以"

第二步:
在 Picture_main 边上再建立两个 PictureBox 控件,分别命名为 Picture_Back 和 Picture_Mark
Picture_Back 和 Picture_Mark 的静态属性设置如下:
AutoRedraw = True
AutoSize = True
ScaleMode = 3
ScaleWidth = 18
ScaleHeight = 18
Index = 0 (Picture_Mark 不设置此属性)
Visible = False

第三步:
在窗体 Form1 的声明中粘贴如下代码
Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Px(15) As Integer
Private Py(15) As Integer
Private PxB(15) As Integer
Private PyB(15) As Integer
Private Start As Boolean

Private Sub StorPictures(X As Single, Y As Single)
Dim Sx As Integer, Sy As Integer
Dim H As Integer, V As Integer
Dim n As Integer
Sx = X - 36: Sy = Y - 36
For V = Sy To Sy + 54 Step 18
    For H = Sx To Sx + 54 Step 18
        Px(n) = H: PxB(n) = H
        Py(n) = V: PyB(n) = V
        n = n + 1
    Next
Next
End Sub

第四步:
在窗体 Form1的 Load 过程中粘贴如下代码
Private Sub Form_Load()
Dim n As Integer
For n = 1 To 15
    Load Picture_Back(n)
Next
End Sub

第五步:
在 Picture_Main 的 MouseDown 过程中粘贴如下代码
Private Sub Picture_Main_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim n As Integer
Dim Draw As Long
If Start = False Then
   Start = True
   Call StorPictures(X, Y)
   For n = 0 To 15
       Draw = BitBlt(Picture_Back(n).hDC, 0, 0, 18, 18, Picture_Main.hDC, Px(n), Py(n), vbSrcCopy)
   Next
Else
   Start = False
   For n = 0 To 15
       Draw = BitBlt(Picture_Main.hDC, PxB(n), PyB(n), 18, 18, Picture_Back(n).hDC, 0, 0, vbSrcCopy)
   Next
End If
Picture_Main.Refresh
End Sub

第六步:
在 Picture_Main 的 MouseMove 过程中粘贴如下代码
Private Sub Picture_Main_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Pred As Double, Pgreen As Double, Pblue As Double, Pcolor As Double
Dim H As Integer, V As Integer
Dim n As Integer, m As Integer
Dim Draw As Long
If Start = False Then Exit Sub
For n = 0 To 15
    Draw = BitBlt(Picture_Main.hDC, PxB(n), PyB(n), 18, 18, Picture_Back(n).hDC, 0, 0, vbSrcCopy)
Next
Call StorPictures(X, Y)
For n = 0 To 15
    Draw = BitBlt(Picture_Back(n).hDC, 0, 0, 18, 18, Picture_Main.hDC, Px(n), Py(n), vbSrcCopy)
    For V = 0 To 17
        For H = 0 To 17
            Pcolor = Picture_Back(n).Point(H, V)
            Pblue = Pblue + Pcolor \ 65536
            Pcolor = Pcolor Mod 65536
            Pgreen = Pgreen + Pcolor \ 256
            Pred = Pred + Pcolor Mod 256
        Next
    Next
    Pred = Pred / 324
    Pgreen = Pgreen / 324
    Pblue = Pblue / 324
    Picture_Mark.BackColor = RGB(Pred, Pgreen, Pblue)
    Draw = BitBlt(Picture_Main.hDC, Px(n), Py(n), 18, 18, Picture_Mark.hDC, 0, 0, vbSrcCopy)
Next
Picture_Main.Refresh
End Sub

第七步:
执行程序。

本程序用到了一个 API 函数,因为用 API 做图要比 VB 提供的做图函数快得多。

本贴发上来后发现,由于受本网站篇幅宽度的限制,有些语句分行显示了,请大家在复制粘贴时特别注意!

回复列表 (共10个回复)

沙发

不错,mark

板凳

这是要顶的

3 楼

强啊 支持你啦~~~下来玩玩

4 楼

[quote]强啊 支持你啦~~~下来玩玩[/quote]
re

5 楼

个人觉得格子稍大了一点。

6 楼

请求帮忙!


7 楼

[quote]请求帮忙!


[/quote]
不明白什么意思?

8 楼

强啊 支持你啦~~~下来玩玩

9 楼

8楼是混分的,字都不打一个

10 楼

精神可嘉

我来回复

您尚未登录,请登录后再回复。点此登录或注册