VB的Rnd函数用处很多，如果用于图像变换中，就会产生意想不到的屏幕特技效果。本文的风暴切换效果，就像暴风吹过一般，非常壮观。
'标准模块ImageConvertEffect.bas：
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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 Const SRCAND = &H8800C6 ' (DWORD) dest = source AND dest
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Const NOTSRCCOPY = &H330008 ' (DWORD) dest = (NOT source)
Private Const SRCPAINT = &HEE0086 ' (DWORD) dest = source OR dest
Dim hDC1 As Long '源设备Picture1的设备环境句柄
Dim hDC2 As Long '目标设备Picture2的设备环境句柄
Dim hDC3 As Long '过渡设备Picture3的设备环境句柄
Dim i As Long,j As Long,k As Long '用到的循环变量
'MyTJParam系列参数用于调整切换速度
'风暴切换一
Public Function Radom_FengBao1(Picture1 As PictureBox,Picture2 As PictureBox,Picture3 As PictureBox,MyTJParam1 As Long)
'picture2.Cls
If MyTJParam1 = 0 Then Exit Function
Dim W1,H1 As Long
W1 = Picture1.ScaleWidth
H1 = 1
hDC3 = Picture3.hdc
hDC2 = Picture2.hdc
hDC1 = Picture1.hdc
On Error GoTo Lhandle
For i = 0 To W1 Step MyTJParam1
For j = 0 To Picture1.ScaleHeight Step H1
BitBlt hDC2,j,i + Int((W1 / 5) * Rnd()),H1,hDC3,SRCCOPY
BitBlt hDC2,W1 - i - Int((W1 / 5) * Rnd()),hDC1,SRCCOPY
Next j
Sleep (1)
Next i
Lhandle:
Exit Function
End Function
'风暴切换二
Public Function Radom_FengBao2(Picture1 As PictureBox,MyTJParam2 As Long)
'picture2.Cls
If MyTJParam2 = 0 Then Exit Function
Dim W1,H1 As Long
W1 = 1
H1 = Picture1.ScaleHeight
hDC3 = Picture3.hdc
hDC2 = Picture2.hdc
hDC1 = Picture1.hdc
On Error GoTo Lhandle
For i = 0 To H1 Step MyTJParam2
For j = 0 To Picture1.ScaleWidth Step W1
BitBlt hDC2,W1,i + Int((H1 / 5) * Rnd()),H1 - i - Int((H1 / 5) * Rnd()),SRCCOPY
Next j
Sleep (1)
Next i
Lhandle:
Exit Function
End Function
'风暴切换三
Public Function Radom_FengBao3(Picture1 As PictureBox,MyTJParam3 As Long)
'picture2.Cls
If MyTJParam3 = 0 Then Exit Function
Dim W1,H1 As Long
W1 = Picture1.ScaleWidth
H1 = 1
hDC3 = Picture3.hdc
hDC2 = Picture2.hdc
hDC1 = Picture1.hdc
On Error GoTo Lhandle
For i = W1 To 0 Step -MyTJParam3
For j = 0 To Picture1.ScaleHeight Step H1
BitBlt hDC2,-(W1 - i - Int((W1 / 5) * Rnd()) + W1 / 5),i - Int((W1 / 5) * Rnd()),-(i - Int((W1 / 5) * Rnd()) + W1 / 5),SRCCOPY
Next j
Sleep (1)
Next i
Lhandle:
Exit Function
End Function
'风暴切换四
Public Function Radom_FengBao4(Picture1 As PictureBox,MyTJParam4 As Long)
'picture2.Cls
If MyTJParam4 = 0 Then Exit Function
Dim W1,H1 As Long
W1 = 1
H1 = Picture1.ScaleHeight
hDC3 = Picture3.hdc
hDC2 = Picture2.hdc
hDC1 = Picture1.hdc
On Error GoTo Lhandle
For i = H1 To 0 Step -MyTJParam4
For j = 0 To Picture1.ScaleWidth Step W1
BitBlt hDC2,-(H1 - i - Int((H1 / 5) * Rnd()) + H1 / 5),i - Int((H1 / 5) * Rnd()),-(i - Int((H1 / 5) * Rnd()) + H1 / 5),SRCCOPY
Next j
Sleep (1)
Next i
Lhandle:
Exit Function
End Function
'窗体模块：
Option Explicit
'窗体上放入三个PictureBox控件：Picture1,Picture2,Picture3；一个列表框控件List1
Private Sub Form_Load()
List1.AddItem "风暴切换一"
List1.AddItem "风暴切换二 "
List1.AddItem "风暴切换三"
List1.AddItem "风暴切换四"
Me.ScaleMode = 3
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3
Picture3.ScaleMode = 3
Picture1.AutoRedraw = True
Picture2.AutoRedraw = False
Picture3.AutoRedraw = True
Picture1.Visible = False
Picture2.Visible = True
Picture3.Visible = False
Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height
Picture3.Width = Picture1.Width
Picture3.Height = Picture1.Height
'装入上一张图片
Picture1.Picture = LoadPicture("E:/PhotoAlbum/PICTURE/未命名9.bmp")
End Sub
Private Sub List1_Click() '装入下一张图片 Picture3.Picture = LoadPicture("E:/PhotoAlbum/PICTURE/玫瑰花(又名月季).jpg") If List1.ListIndex = 0 Then Call Radom_FengBao1(Picture1,Picture3,2) End If If List1.ListIndex = 1 Then Call Radom_FengBao2(Picture1,2) End If If List1.ListIndex = 2 Then Call Radom_FengBao3(Picture1,2) End If If List1.ListIndex = 3 Then Call Radom_FengBao4(Picture1,2) End If '切换到下一张图片 Picture2.Picture = LoadPicture("E:/PhotoAlbum/PICTURE/玫瑰花(又名月季).jpg")End Sub