圖片的平滑切換處理技術

--------------------------------------------------------------------------------

　　用過Anfy Java程序的用戶一定不會忘記其優(yōu)秀的圖像效果處理技術：DUMP、DEFORM、FIREWORKS、SNOW、HUEROT、LAKE、LENS、ROT、WARP、WATER等等,的確讓人興奮不已。(若讀者還不曾用過Anfy,可以到其相關網(wǎng)頁http://www.AnfyTeam.com上去下載,約2917KB,V1.4.3)。但作為愛好編程的"程序員",老用別人的東西,總覺得心得不舒服,因此筆者也用VB6.0設計了出圖片平滑過渡、加下雪效果這兩種方法,以饗讀者,而且可以將其設計成ActiveX,在您的網(wǎng)頁中也可以使用--有時候，看著自己親手做的東西，不管是否完美，總覺得有種自豪的感覺--也許這就叫做"自我陶醉"。

　　為了高效處理圖形,當然需要用到WIN32 API,以下為常量定義及申明(用戶可以利用VB6.0中API瀏覽器插入),我們將其存入模塊API.bas中：

Attribute VB_Name = "API模塊"
Const MILLICMETERCELL = 26.45836 '每一個像素點相當于多少微米
Public Const BLACKNESS = &H42
Public Const WHITENESS = &HFF0062
Public Const DSTINVERT = &H550009
Public Const NOTSRCCOPY = &H330008
Public Const NOTSRCERASE = &H1100A6
Public Const SRCAND = &H8800C6
Public Const SRCCOPY = &HCC0020
Public Const SRCERASE = &H440328
Public Const SRCINVERT = &H660046
Public Const SRCPAINT = &HEE0086

Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public Type LOGBRUSH
lbStyle As Long
lbColor As Long
lbHatch As Long
End Type

Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (
ByVal hdc As Long, ByVal x As Long, ByVal y As Long,
ByVal lpString As String, ByVal nCount As Long) As Long

Public Declare Function SelectObject Lib "gdi32" (
ByVal hdc As Long, ByVal hObject As Long) As Long

Public 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

Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long,
ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long,
ByVal x As Long, ByVal y As Long) As Long

Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long,
ByVal nWidth As Long, ByVal nHeight As Long) As Long

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long,
ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long,
ByVal dwRop As Long) As Long

Public Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long

Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT,
ByVal HBrush As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long

Public Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long,
ByVal hPalette As Long, ByVal bForceBackground As Long) As Long

Public Declare Function GetPaletteEntries Lib "gdi32" (
ByVal hPalette As Long, ByVal wStartIndex As Long,
ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long

Public Declare Function GetBitmapDimensionEx Lib "gdi32" (
ByVal hBitmap As Long, lpDimension As Size) As Long

Public Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
以下還將定義幾個常用到的函數(shù)：

'返回兩者中較小的一個
Public Function Min(ByVal a As Integer, ByVal b As Integer) As Integer
Min = IIf(a > b, b, a)
End Function

'返回兩者中較大的一個
Public Function Max(ByVal a As Integer, ByVal b As Integer) As Integer
Max = IIf(a > b, a, b)
End Function

以下三個函數(shù)獲取色彩中的各分量值
'取色彩中n的Red的值
Public Function GetRed(ByVal n As Long) As Integer
GetRed = n Mod 256&
End Function

'取色彩n中的Green的值
Public Function GetGreen(ByVal n As Long) As Integer
GetGreen = (n \ 256&) Mod 256&
End Function

'取色彩n中的Blue的值
Public Function GetBlue(ByVal n As Long) As Integer
GetBlue = n \ 65536
End Function
　　在VB6.0中,函數(shù)Len(s)將返回中字符的個數(shù)(一個漢字也是被定義為一個字符長度),而在WIN32 API TextOut()要求字符串長度將一個漢字定義為2個字符,因此需要全新的計算長度串函數(shù)
'取字符串中有多少個字符(1個漢字定義為2個字符寬度)

Public Function Strlen(ByVal s As String) As Integer
Dim i As Integer
n = Len(s)
For i = 1 To n
If Asc(Mid$(s, i, 1)) < 0 Then n = n + 1 ‘若為漢字,字符個數(shù)加1
Next i
Strlen = n
End Function
　　以下兩個函數(shù)返回用戶用LoadPicture(PictureFileName)函數(shù)裝入的圖片的高、寬度(以像素為單位),原始的用MILLICMETER為單位。

'獲取位圖的寬度(以像素為單位)
Public Function GetPictureWidth(ByVal p As Picture) As Integer
GetPictureWidth = Int(p.Width / MILLICMETERCELL + 0.5)
End Function

'獲取位圖的高度(以像素為單位)
Public Function GetPictureHeight(ByVal p As Picture) As Integer
GetPictureHeight = Int(p.Height / MILLICMETERCELL + 0.5)
End Function
　　用過Photoshop 5.0的用戶,一定不會忘記Trient工具,它可將一種色彩平滑過渡到另一種色彩。以下這個函數(shù)可以幫我們完成這個任務。

'獲取漸變色彩值
'入口參數(shù)：SrcColor 原色彩
' Steps 步驟數(shù)
' CurStep 當前的步子
' DstColor 目標色彩
'返回值：當前的色彩值
Public Function GetTrienColor(ByVal scrColor As Long,
ByVal dstColor As Long, ByVal Steps As Integer,
ByVal curStep As Integer) As Long
Dim sR, sG, sB, dR, dG, dB As Integer
sR = GetRed(scrColor)
sG = GetGreen(scrColor)
sB = GetBlue(scrColor)
dR = GetRed(dstColor)
dG = GetGreen(dstColor)
dB = GetBlue(dstColor)
sR = sR + curStep * (dR - sR) / Steps
sG = sG + curStep * (dG - sG) / Steps
sB = sB + curStep * (dB - sB) / Steps
GetTrienColor = RGB(sR, sG, sB)
End Function

　　以下兩個函數(shù)返回用戶用LoadPicture(PictureFileName)函數(shù)裝入的圖片的高、寬度(以像素為單位),原始的用MILLICMETER為單位。

　　以上的常見函數(shù),用戶也應該將其添加到API.bas中。

一、實現(xiàn)方法

　　為了從一個圖片P1平滑向另一個圖片P2過渡,如下圖(從右到左將一紅花的圖片過渡到雪景的圖片)：



　　若用戶仔細觀察,您會發(fā)現(xiàn),其實可以將過渡的畫面分為三個部分：原始圖片P1部分、過渡效果部分和目標圖片P2部分。對于原始部分和目標部分,我們可以利用Bitblt()直接SRCCOPY過去即可,因此重要的即是得處理過渡部分。

　　在上述的API.bas文件中，我們知道GetTrientColor，可以幫我們完成從一種色彩漸進到另一種色彩。我們設過渡部分的寬度為tw, 當前顯示區(qū)域的高為h,顯示的橫坐標為x,那么從右到左過渡,即是從目標色彩漸進到原始的色彩,換句話說：在色彩成分中,目標色由100%逐減到0%,而原始色彩則有0%逐增到100%,其處理方法如下：

　　for i=0 to tw
　　　xx=x+i '當前顯示的橫坐標X
　　　for j=0 to h-1
　　　　p1Color=GetPixel(p1,xx,j) '取圖片1的原始色彩
　　　　p2=Color=GetPixel(p2,xx,j)'取圖片2的原始色彩
　　　　CurColor=GetTreintColor(p1color,p2Color,tw,i) '取當前從p1Color平滑過渡到p2Color當前的漸進色
　　　　SetPixel(目標DC,xx,j,CurColor)
　　　Next j
　　Next i
　　以上只是處理一個片斷部分,若需要處理整個平滑過渡效果,還需要加入一個外循環(huán)。另外,為了能高效處理從p1到p2的過渡過程,需要將圖片加入到內(nèi)容兼容的DC中

　　dim p1 ,p2 as Picture
　　p1=LoadPicture(P1FileName) '裝入圖片1
　　p2=LoadPicture(p2)'裝入圖片2
　　p1Dc=CreateCompatibleDC(目標DC) '建立一個如目標dc兼容的dc
　　SelectObject(p1Dc,p1) '將圖片1選入其中
　　P2Dc=CreateCompatibleDC(目標DC)
　　SelectObject(p2Dc,p2)
　　以下程序PictureTranstion.bas可完成①整個圖片平滑過渡到另一個圖片②從左到右③從右到左④從上到下⑤從下到上等五種處理過程,用戶還可以根據(jù)以上原理加入其它處理方式,如由小圓逐漸擴展到大圓,從左右同時到中央等等。由于本程序采用取點畫點處理方法,處理的速度會因為平滑過渡圖片部分的寬度或高度(若是整個圖片的過渡,此時表示過渡的幀數(shù))的增加而變得非常慢,但此時的處理效果最好,當然若設置成非常小,即是一般的從左到右或其它類型的轉(zhuǎn)換處理方法。因此在實際的處理中,還應該充許用戶中斷,最好的辦法是的在處理的循環(huán)中加入DoEvents,而在函數(shù)傳遞入口處加入一個用地址傳送(VB默認的一種方式)的變量IsExit(表示是否中斷),用戶調(diào)用時,可以用一個變量傳遞,需要中斷時,可以將其變量設置成真。(當然,應該在編程中防止二次調(diào)用)

Attribute VB_Name = "Module2"
'定義效果類型
'整個圖片從1幅到另一幅
Public Const FromP1toP2 = 0
Public Const FromLeftToRight = 1 '從左到右
Public Const FromRightToLeft = 2 '從右到左
Public Const FromUpToDwon = 3 '從上到下
Public Const FromDownToUp = 4 '從下到上
'效果返回定義
Public Const TransOK = 0 '正常
Public Const TransP1NotFound = -1 '圖片1沒有找到或者不是圖片文件
Public Const TransP2NotFound = -2 '圖片1沒有找到或者不是圖片文件
Public Const TransUserBreak = -3 '用戶中斷
'下列程序完成從一幅圖片轉(zhuǎn)化到另一幅圖片的過程
'入口參數(shù): srcPictureFileName 原圖片文件名
'dstPictureFileName 轉(zhuǎn)換后的目標文件名
'w,h 目標設備的高,寬(以像素為單位)
'dstDc 目標設備DC
'Speed 轉(zhuǎn)化速度(值越大效果越好,但速度最慢)
'IsExit 表示是否中斷,請用變量傳遞
'例：Call P1ToP2(,....IsExit)
' 若要求中斷,可以在另外的動作中要求IsExit=true
'ShowType 效果類型(見TransEnum說明)
'返回值：見TransError說明

Public Function P1ToP2(
ByVal srcPictureFileName As String,
ByVal dstPictureFileName As String, ByVal dstDc As Long,
w As Long, h As Long, ByVal Speed As Integer,
ByVal ShowType As Integer, IsExit As Boolean) As Integer

Dim h1Dc, h2Dc, hMemDC, hMemPic As Long
Dim p1, p2 As Picture
Dim Result As integer
IsExit = False '進入時,不中斷
On Error Resume Next
Set p1 = LoadPicture(srcPictureFileName) '裝入圖片1
If Err Then
P1ToP2 = TransP1NotFound
Exit Function '若出錯,則退出
End If
Set p2 = LoadPicture(dstPictureFileName)
If Err Then '裝入圖片2,若出錯,則刪除裝入的圖片1,然后退出
Set p1 = Nothing
P1ToP2 = TransP2NotFound
Exit Function
End If
h1Dc = CreateCompatibleDC(dstDc) '建立一個和目標上下文環(huán)境兼容的DC
Call SelectObject(h1Dc, p1) '將圖片1選入中
h2Dc = CreateCompatibleDC(dstDc) '建立一個和目標上下文環(huán)境兼容的DC
Call SelectObject(h2Dc, p2) '將圖片2選入中
hMemDC = CreateCompatibleDC(dstDc) '建立一個兼容的內(nèi)存位圖
hMemPic = CreateCompatibleBitmap(dstDc, w, h)
Call SelectObject(hMemDC, hMemPic) '選入設備中
Result = PictureTransition(h1Dc, h2Dc, hMemDC,
　　　　　　　　　dstDc, w, h, Speed, ShowType, IsExit)
Set p1 = Nothing
Set p2 = Nothing
Call DeleteDC(h1Dc)
Call DeleteDC(h2Dc)
Call DeleteDC(hMemDC)
Call DeleteObject(hMemPic)
P1ToP2 = Result
End Function

'完成一幅圖片h1到另一幅圖片h2從左到右淡入
'入口參數(shù)：h1DC 原圖片DC
' h2DC目標圖片DC
' DscDC 目標DC
' hMemDC 緩存DC
' w 目標上下文的寬度
' h 目標上下文的高度
' TransType 過渡類型
' Speed 光帶長度(或者過渡的幀數(shù))
' IsExit 中斷處理變量
Public Function PictureTransition(ByVal h1Dc As Long,
ByVal h2Dc As Long, ByVal hMemDC As Long,
ByVal dstDc As Long, ByVal w As Long,
ByVal h As Long, ByVal Speed As Integer,
ByVal TransType As Integer, IsExit As Boolean) As Integer
Dim x, xx, yy, y, i, j, n As Long
Dim srcColor, dstColor, curColor As Long
Select Case TransType
Case 0 ' FromP1toP2:
For n = 0 To Speed
　　For x = 0 To w - 1
　　　For y = 0 To h - 1
　　　　srcColor = GetPixel(h1Dc, x, y):
　　　　If srcColor = -1 Then srcColor = GetBkColor(dstDc)
　　　　dstColor = GetPixel(h2Dc, x, y):
　　　　If dstColor = -1 Then dstColor = GetBkColor(dstDc)
　　　　curColor = GetTrienColor(srcColor, dstColor, Speed, n)
　　　　Call SetPixel(hMemDC, x, y, curColor)
　　　Next y
　　　DoEvents
　　　If IsExit = True Then GoTo exitPictureTransition
　　Next x
　　Call BitBlt(dstDc, 0, 0, w, h, hMemDC, 0, 0, SRCCOPY)
Next n
Case 1 'FromLeftToRight:
　　For xx = -Speed + 1 To w '光條從-Speed到結(jié)束
　　If xx > 0 Then '若左邊已經(jīng)有圖2出來
　　　　Call BitBlt(hMemDC, 0, 0, xx, h, h2Dc, 0, 0, SRCCOPY)
　　　　 '則COPY圖2的一部分
　　End If
　　If xx + Speed < w Then '圖1還沒有完全消失,則COPY部分圖1
　　　Call BitBlt(hMemDC, xx + Speed, 0, w - xx - Speed, h,
　　　　　　　　　 h1Dc, xx + Speed, 0, SRCCOPY)
　　End If
　　For i = 0 To Speed
　　　x = xx + i
　　　If x>=0 And xNext xx

Case 2 'FromRightToLeft:
　For xx = w To -Speed + 1 Step -1 '光條從-Speed到結(jié)束
　If xx > 0 Then '若左邊已經(jīng)有圖2出來
　　Call BitBlt(hMemDC, 0, 0, xx, h, h1Dc, 0, 0, SRCCOPY) '則COPY圖2的一部分
　End If
　If xx + Speed < w Then '圖1還沒有完全消失,則COPY部分圖1
　Call BitBlt(hMemDC, xx + Speed, 0, w - xx - Speed,
　　　　　　　　　　 h, h2Dc, xx + Speed, 0, SRCCOPY)
　End If
　For i = 0 To Speed
　　x = xx + i
　　If x >= 0 And x < w Then '當前的坐標在可視范圍內(nèi)
　　　For y = 0 To h - 1
　　　　srcColor = GetPixel(h1Dc, x, y):
　　　　If srcColor = -1 Then srcColor = GetBkColor(dstDc)
　　　　dstColor = GetPixel(h2Dc, x, y):
　　　　If dstColor = -1 Then dstColor = GetBkColor(dstDc)
　　　　curColor = GetTrienColor(srcColor, dstColor, Speed, i)
　　　　Call SetPixel(hMemDC, x, y, curColor)
　　　Next y
　　　DoEvents
　　　If IsExit = True Then GoTo exitPictureTransition
　　End If
　Next i
　Call BitBlt(dstDc, 0, 0, w, h, hMemDC, 0, 0, SRCCOPY)
　'將當前變化的結(jié)果寫入目標設備中
　Next xx
Case 3 'FromUptodown:
　For yy = -Speed + 1 To h '光條從-Speed到結(jié)束
　　If yy > 0 Then '若左邊已經(jīng)有圖2出來
　　　Call BitBlt(hMemDC, 0, 0, w, yy, h2Dc, 0, 0, SRCCOPY)
　　　 '則COPY圖2的一部分
　　End If
　　If yy + Speed < h Then '圖1還沒有完全消失,則COPY部分圖1
　　　Call BitBlt(hMemDC, 0, yy + Speed, w, h - yy - Speed,
　　　　　　　　　 h1Dc, 0, yy + Speed, SRCCOPY)
　　End If
　　For i = 0 To Speed
　　　y = yy + i
　　　If y >= 0 And y < h Then '當前的坐標在可視范圍內(nèi)
　　　　For x = 0 To w - 1
　　　　　srcColor = GetPixel(h1Dc, x, y):
　　　　 　If srcColor = -1 Then srcColor = GetBkColor(dstDc)
　　　　　dstColor = GetPixel(h2Dc, x, y):
　　　　　If dstColor = -1 Then dstColor = GetBkColor(dstDc)
　　　　　curColor = GetTrienColor(dstColor, srcColor, Speed, i)
　　　　　Call SetPixel(hMemDC, x, y, curColor)
　　　　Next x
　　　　DoEvents
　　　If IsExit = True Then GoTo exitPictureTransition
　　　End If
　　Next i
　　Call BitBlt(dstDc, 0, 0, w, h, hMemDC, 0, 0, SRCCOPY)
　　　　　　　　 '將當前變化的結(jié)果寫入目標設備中
　　Next yy
Case 4 ' FromDownToUp
　　For yy = h - 1 To -Speed + 1 Step -1
　　If yy > 0 Then '若左邊已經(jīng)有圖2出來
　　　Call BitBlt(hMemDC, 0, 0, w, yy, h1Dc, 0, 0, SRCCOPY)
　　　 '則COPY圖2的一部分
　　End If
　　If yy + Speed < h Then '圖1還沒有完全消失,則COPY部分圖1
　　　Call BitBlt(hMemDC, 0, yy + Speed, w, h - yy - Speed,
h2Dc, 0, yy + Speed, SRCCOPY)
　　End If
　　For i = 0 To Speed
　　　y = yy + i
　　　If y >= 0 And y < h Then '當前的坐標在可視范圍內(nèi)
　　　For x = 0 To w - 1
　　　　srcColor = GetPixel(h1Dc, x, y):
　　　　If srcColor = -1 Then srcColor = GetBkColor(dstDc)
　　　　dstColor = GetPixel(h2Dc, x, y):
　　　　If dstColor = -1 Then dstColor = GetBkColor(dstDc)
　　　　curColor = GetTrienColor(srcColor, dstColor, Speed, i)
　　　　Call SetPixel(hMemDC, x, y, curColor)
　　　Next x
　　　DoEvents
　　　If IsExit = True Then GoTo exitPictureTransition
　　End If
　　Next i
　　Call BitBlt(dstDc, 0, 0, w, h, hMemDC, 0, 0, SRCCOPY)
　　'將當前變化的結(jié)果寫入目標設備中
　　Next yy
End Select

exitPictureTransition:
　　If IsExit Then '退出為真
　　　　PictureTransition = TransUserBreak '表示用戶中斷
　　Else
　　　PictureTransition = TransOK '否則OK
　　End If
End Function
二、測試程序

　　理論講完了,下面該來用VB6.0制作這種迷人效果了：

　　1、新建一個工程,向Form中加入一系列控件,設置各自的Name和各自的相關屬性（注意：一定要將將Picture控件中的ScaleMode設置成3）。筆者設計的Form見上圖。

　　2、將下列代碼寫入窗體Code中：

Dim IsExit As Boolean
Private Sub AboutButton_Click()‘關于
　　MsgBox MainForm.Caption & Chr(13) & "date: 2000.2.2.",
vbInformation, "About TransPicture"
End Sub

Private Sub Form_Unload(Cancel As Integer)
　　IsExit = True ‘窗體Uload時,中斷為真
End Sub

Private Sub RunAndStopButton_Click()
Dim n, i As Integer
i = Picturelist.ListIndex
If RunAndStopButton.Caption = "Start" Then
Randomize
TextSpeed.Enabled = False
UpDown.Enabled = False
ShowStyle.Enabled = False
RunAndStopButton.Caption = "Stop"
Picturelist.Enabled = False
BrowButton.Enabled = False
n = ShowStyle.ListIndex
While 1
If n = 0 Then n = Int(Rnd * 5) + 1
ShowStyle.ListIndex = n
Picturelist.ListIndex = i
If P1ToP2(Picturelist.List(i),
　Picturelist.List((i + 1) Mod Picturelist.ListCount),
　　Pic.hdc, Pic.ScaleWidth, Pic.ScaleHeight, UpDown.Value,
　　ShowStyle.ListIndex - 1, IsExit) = TransUserBreak Then
GoTo exitwhile
End If
　i = i + 1
　If i = Picturelist.ListCount Then i = 0
Wend
　Else
　IsExit = True
End If
exitwhile:
　Picturelist.ListIndex = i
　RunAndStopButton.Caption = "Start"
　Picturelist.Enabled = True
　TextSpeed.Enabled = True
　UpDown.Enabled = True
　ShowStyle.Enabled = True
　BrowButton.Enabled = True
End Sub

Private Sub picturelist_Click()
　　On Error Resume Next
　　Set Pic.Picture = LoadPicture(Picturelist.List(Picturelist.ListIndex))
End Sub

Private Sub BrowButton_Click()
　On Error Resume Next
　Dim s, InitDir As String
　Dlg.Flags = cdlOFNExplorer '允許多選文件
　Dlg.Filter = "所有的圖形文件|(*.bmp;*.jpg;*.wfm;*.emf;*.ico;*.rle;*.gif;*.cur)
　|JPEG文件|*.jpg|BMP文件|(*.bmp)|GIF文件|*.gif|光標(*.Ico)和圖標(*.Cur)文件|
　(*.cur,*.ico)|WMF元文件(*.wmf,*.emf)|(*.wmf,*.emf)|RLE行程文件(*.rle)|*.rle"
　Dlg.ShowOpen
　If Err Then Exit Sub
　Set Pic.Picture = LoadPicture(Dlg.FileName)
　If Err Then
　　MsgBox "裝入圖片[" & Dlg.FileName & "]出錯.", vbOKOnly, "錯誤"
　Else
　　Picturelist.AddItem Dlg.FileName
　　Picturelist.ListIndex = Picturelist.ListCount - 1
　End If
　If ShowStyle.ListIndex >= 0 And Picturelist.ListCount >= 2 Then
　　RunAndStopButton.Enabled = True
　End If
End Sub

Private Sub Form_Load()
　ShowStyle.AddItem "隨機"
　ShowStyle.AddItem "整個圖片淡入淡出"
　ShowStyle.AddItem "從左到右淡入"
　ShowStyle.AddItem "從右到左淡入"
　ShowStyle.AddItem "從上到下淡入"
　ShowStyle.AddItem "從下到上淡入"
　ShowStyle.ListIndex = 0
　UpDown.Value = 20
End Sub

Private Sub ShowStyle_click()
　If ShowStyle.ListIndex >= 0 And Picturelist.ListCount >= 2 Then
　　　RunAndStopButton.Enabled = True
　End If
End Sub

Private Sub TextSpeed_Change()
　n = Int(Val(TextSpeed.Text))
　If n < UpDown.Min Or n > UpDown.Max Then
　　　n = 20
　End If
　UpDown.Value = n
　TextSpeed.Text = n
End Sub

Private Sub UpDown_Change()
　TextSpeed.Text = UpDown.Value
End Sub
　　代碼寫好了,現(xiàn)在您可以按下Play,運行您的測試程序。按下"Add",向PictureList加入幾個圖片,選中某一個過渡效果(或隨機),再按下"Start"。此時,您只需要來杯咖啡,靜靜地一旁欣賞,怎么樣,不亞于Anfy吧！

　　若想再您的網(wǎng)頁中加入這種效果,可以將其設計可OCX。下篇將向您介紹另一種加下雪效果的AddSnowCtrol,并且設計成ActiveX。

　　以上只是筆者的班門弄斧,不當之處,希望多多指教。另外程序由于采用讀點寫點方法處理,速度的確不盡人意,筆者曾試想直接處理DC中的hBitmap信息,但苦于手中沒有資料,只好罷了。若讀者對此技術感興趣,可以給我來信！(本文發(fā)表于2000年第6期《電腦編程技巧與維護》)

Word版下載地址：http://www.i0713.net/Download/Prog/Dragon/Doc/PicTrans.doc
源程序下載地址：http://www.i0713.net/Download/Prog/Dragon/Prog/PicTrans.zip