主题:[原创]休闲小作品
第一步:
建立一个普通窗体 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 提供的做图函数快得多。
本贴发上来后发现,由于受本网站篇幅宽度的限制,有些语句分行显示了,请大家在复制粘贴时特别注意!