多媒体软件设计技术Word文件下载.docx
《多媒体软件设计技术Word文件下载.docx》由会员分享，可在线阅读，更多相关《多媒体软件设计技术Word文件下载.docx（14页珍藏版）》请在冰豆网上搜索。
图片的切换效果
滑入
程序源代码
PublicStopProgramAsBoolean'
定义开始按钮的能否开始
PublicSwapPicsAsBoolean
PrivateEnumSideSelecting
Off=0
HV=1
LRDU=2
All=3
EndEnum
DimAAsInteger'
A进入速度变量
DimBAsInteger'
B单步刷新变量
DimCAsInteger'
C条宽度
PrivateSubcmdStart_Click（）
StaticStartModeAsBoolean'
设置开始按钮的caption属性
IfNotStartModeThen
IfNotIsReadyThenExitSub
cmdStart.Caption="
停止"
StartMode=True
RunEffect
Picture1.Refresh
StartMode=False
IfStopProgramThenExitSub
IfSwapPicsThen
'
BitBltPicture2.hdc,0,0,640,480,Picture3.hdc,0,0,SRCCOPY
BitBltPicture3.hdc,0,0,640,480,Picture1.hdc,0,0,SRCCOPY
SwapPicturesPicture1,Picture2,Picture3
EndIf
Picture2.Refresh
Picture3.Refresh
开始"
Else
mblnRunning=False
EndSub
PrivateSubForm_Load（）
WithList1'
list的选项
.AddItem"
滑入"
从外向内滑入"
从内向外滑入"
缩放推入"
从内缩放推入"
淡入"
融入"
百叶窗"
旋转引入"
圆形切出"
扇形切入"
双面斜切入"
斜切入"
斜切出"
EndWith
StopProgram=False
lngSpeed=1
List1.ListIndex=0
SetPicture1.Picture=LoadPicture（App.Path&
"
\Effect-x1.jpg"
）
SetPicture2.Picture=LoadPicture（App.Path&
\Effect2-x1.jpg"
SetPicture3.Picture=LoadPicture（App.Path&
PrivateSubForm_QueryUnload（CancelAsInteger,UnloadModeAsInteger）
StopProgram=True
UnloadMe
PrivateSubFrame6_DragDrop（SourceAsControl,xAsSingle,yAsSingle）
PrivateSubList1_Click（）
A=1'
滑入速度设为1
SelectCaseList1.ListIndex'
选择list的内容风别为0到13
Case0'
B=5'
B单步刷新变量设为5
Case1'
从外向内滑入
B=4'
B单步刷新变量设为4
Case2'
从内向外滑入
Case3'
缩放推入
B=5
Case4'
从外向内推入
Case5'
淡入
B=2'
Case6'
融入
C=1'
设置条大小为1
Case7'
百叶窗
A=50
B=1
C=20
SelectCaseList1.ListIndex
Case8
Case9
Case10
Case11To13
B=10
EndSelect
CaseElse
PrivateFunctionGetSideLRDU（）AsLong
GetSideLRDU=4
EndFunction
PrivateFunctionGetSideHV（）AsLong
GetSideHV=1
PrivateFunctionGetPushMode（）AsLong
GetPushMode=1
PrivateSubRunEffect（）
SwapPics=True
Case0
WipePicture1,Picture2,GetSideLRDU,CLng（B）'
执行滑入函数
Case1
Wipe_InPicture1,Picture2,GetSideHV,CLng（B）'
执行从外向内滑入
Case2
Wipe_OutPicture1,Picture2,GetSideHV,CLng（B）'
执行从内向外滑入
Case3
DimiAsLong
i=1
StretchingPicture1,Picture3,Picture2,i,CLng（B）,,GetPushMode'
执行缩放推入
Case4
Stretching_Wipe_InPicture1,Picture3,Picture2,GetSideHV,CLng（B）,,GetPushMode'
执行从外向内推入
Case5
RandomLinesPicture1,Picture2,GetSideHV,CLng（B）'
执行淡入
Case6
Bars_DrawPicture1,Picture2,GetSideHV,CLng（B）,CLng（C）'
执行融入
Case7
Bars_WipePicture1,Picture2,GetSideLRDU,CLng（B）,CLng（C）'
执行百叶窗
MaskEffectPicture1,Picture2,1,Me.hdc,CLng（B）'
执行旋转引入
MaskEffectPicture1,Picture2,2,Me.hdc,CLng（B）'
执行圆形切出
MaskEffectPicture1,Picture2,3,Me.hdc,CLng（B）'
执行扇形切入
Case11
MaskEffectPicture1,Picture2,4,Me.hdc,CLng（B）'
执行双面斜切入
Case12
MaskEffectPicture1,Picture2,5,Me.hdc,CLng（B）'
执行斜切入
Case13
MaskEffectPicture1,Picture2,6,Me.hdc,CLng（B）'
执行斜切出
PrivateSubquit_Click（）
End
（部分模块）
PublicSubAlpha_Wipe（DestPicAsPictureBox,PrevPicAsPictureBox,NewPicAsPictureBox,FlagAsLong,OptionalBarSizeAsLong=50,OptionalStepsAsLong=5）
Dimr1AsLong,g1AsLong,b1AsLong
Dimr2AsLong,g2AsLong,b2AsLong
DimrmAsLong,gmAsLong,bmAsLong
DimyAsLong
IfIsReadyThen
Ended=False
DimpxWidthAsLong,pxHeightAsLong
DimScreenTXAsLong,ScreenTYAsLong
DimXlengAsLong,CntrAsLong
Dimt1AsLong,t2AsLong
ScreenTX=Screen.TwipsPerPixelX
ScreenTY=Screen.TwipsPerPixelY
pxWidth=DestPic.ScaleWidth\ScreenTX
pxHeight=DestPic.ScaleHeight\ScreenTY
SelectCaseFlag
擦除
Xleng=pxWidth+BarSize
过渡
Xleng=255
Cntr=1
Xleng=Sqr（pxWidth*pxWidth+pxHeight*pxHeight）/2
Xleng=Xleng+BarSize
DimUBAsLong,UB2AsLong
GetObjectAPIDestPic.Picture,Len（Bmp1）,Bmp1
GetObjectAPIPrevPic.Picture,Len（Bmp3）,Bmp3
GetObjectAPINewPic.Picture,Len（Bmp2）,Bmp2
WithSA1
.cbElements=1
.cDims=2
.Bounds（0）.lLbound=0
.Bounds（0）.cElements=Bmp1.bmHeight
.Bounds
（1）.lLbound=0
.Bounds
（1）.cElements=Bmp1.bmWidthBytes
.pvData=Bmp1.bmBits
WithSA2
.Bounds（0）.cElements=Bmp2.bmHeight
.Bounds
（1）.cElements=Bmp2.bmWidthBytes
.pvData=Bmp2.bmBits
WithSA3
.Bounds（0）.cElements=Bmp3.bmHeight
.Bounds
（1）.cElements=Bmp3.bmWidthBytes
.pvData=Bmp3.bmBits
CopyMemoryByValVarPtrArray（Pic1）,VarPtr（SA1）,4
CopyMemoryByValVarPtrArray（Pic2）,VarPtr（SA2）,4
CopyMemoryByValVarPtrArray（Pic3）,VarPtr（SA3）,4
mblnRunning=True'
开始循环
DoWhilemblnRunning
IfmlngTimer+lngSpeed<
=GetTickCount（）Then
BitBlting
IfCntr>
=XlengThen
SetDestPic.Picture=DestPic.Picture
UB=UBound（Pic1,1）+1
UB2=UBound（Pic1,2）+1
CopyMemoryPic1（0,0）,Pic2（0,0）,UB*UB2
CopyMemoryPic2（0,0）,Pic3（0,0）,UB*UB2
CopyMemoryPic3（0,0）,Pic1（0,0）,UB*UB
CopyMemoryByValVarPtrArray（Pic1）,0&
4
CopyMemoryByValVarPtrArray（Pic2）,0&
CopyMemoryByValVarPtrArray（Pic3）,0&
4'
停止
mblnRunning=False'
新图片可以使用更多的bitblt.
ExitSub
擦除
t2=UBound（Pic1,1）-3
t1=UBound（Pic1,2）
Forint_i=0Tot2Step3
Forint_j=0Tot1
GetRGBr1,g1,b1,3
GetRGBr2,g2,b2,2
y=int_i/3
Ify<
Cntr-BarSizeThen
r1=r2
b1=b2
g1=g2
ElseIfy<
=CntrAndy>
=Cntr-BarSizeThen
rm=255-（（（Cntr-y）/BarSize）*255）
CheckRGBrm,0,0
r1=（（r1*rm）+（r2*（255-rm）））\255
g1=（（g1*rm）+（g2*（255-rm）））\255
b1=（（b1*rm）+（b2*（255-rm）））\255
CheckRGBr1,g1,b1
Pic1（int_i,int_j）=b1
Pic1（int_i+1,int_j）=g1
Pic1（int_i+2,int_j）=r1
Nextint_j
Nextint_i
Cntr=Cntr+Steps
Forint_i=0ToUBound（Pic1,1）-3Step3
Forint_j=0ToUBound（Pic1,2）
rm=255-Cntr
透明圆型擦除
DimpxCenterWidthAsLong,pxCenterHeight
pxCenterWidth=pxWidth\2
pxCenterHeight=pxHeight\2
y=int_i\3
rm=Sqr（（pxCenterWidth-y）*（pxCenterWidth-y）+（pxCenterHeight-int_j）*（pxCenterHeight-int_j））
Ifrm>
CntrThen
rm=255
ElseIfrm<
rm=0
rm=255-（（（Cntr-rm）/BarSize）*255）
Cntr=Cntr+20
刷新图片
DestPic.Refresh
刷新时间
mlngTimer=GetTickCount（）'
复位时间变量
DoEvents
Loop
CopyMemoryPic3（0,0）,Pic1（0,0）,UB*UB2
Ended=True
6）程序问题分析
1.图片的进入速度控制不住，有时候图片变化很快，有时候很慢，不好控制。
可以再加入程序，使其控制图片的进出速度。
2.由于以原有的程序进行了大部分的改动，但所学知识有限，模块中的程序无法全部看懂，希望在以后自学过程中搞懂它。
7）总结
通过这次设计，我对VB的运用更加灵活，对知识的掌握更加牢固。
在程序设计的过程中，遇到了一些问题，通过查阅资料和借助网络，解决了一部分问题，但仍有一部分还无法解决。
我还需继续努力，继续学习VB，充实自己。
升级会员 