用VB实现“百叶窗”的图形特效

  
在Powerpoint这样的软件中,各种各样的图形特效层出不穷,其中“百叶窗”的切
换效果尤为新颖奇特。在VB中实现这样的图形特效十分简单方便。其方法是调用
WINDOWS的API函数Bitblt。BitBlt函数就类似于C语言中的getimage、putimage两
个函数的组合运用。BitBlt原意是“Bit Block Transfer”,其主要用途是位图的
复制。用BitBlt函数显示图形特效,其原理十分简单,制作时先在表单中绘制两个
图片框,将图片存入一个图片框,同时将另一个图片框设为空,然后调用BitBlt函
数将第一个图片框中的图形一部分一部分地复制到第二个图片框中,这样就可以实
现千奇百怪的图形特效。其步骤如下:
  在VB环境中新建一个窗体,绘制两个图片框picSour和picDest,两个命令按钮
cmdShow和cmdExit。首先在窗体的通用过程中声明BitBlt函数即所需要的常量名,
在载入窗体同时在picSour中载入图片,在按钮cmdShow的事件中调用BitBlt函数。
程序如下:
API函数声明:
Declare Function BitBlt Lib″GDI″(ByVal hDestDC As Integer,ByVal X As 
Integer,ByVal Y As Integer,ByVal nWidth AS Integer,ByVal nHeight As 
Integer,ByVal hSrcDC As Integer,ByVal xSrc As Integer,ByVal ySrc As 
Integer,ByVal dwRop As Long)As Integer
  Const COPY-PUT=&HCC0020′BitBlt的15种算法之一,表示直接拷贝
  载入图片:
Sub Form-Load()
picsour.Picture=LoadPicture(″c:/windows/LEAVES.bmp″)
picsour.ScaleMode=3′以象素为单位
End Sub
显示“百叶窗”的切换效果:
Sub Comshow-Click()
H%=picsour.ScaleHeight
W%=picsour.ScaleWidth
scanlines=4
For i=0 To(scanlines-1)
For j=i To H% Step scanlines
s%=BitBlt%(picdest.hDC,0,j,W%,1,picsour.hDC,0,j,copy-Put)
delay 500′延时
Next j
Next i
End Sub
  其中delay是一个通用子过程,用于延时,以便于能看清楚切换效果。代码如
下:
Sub delay(delaytime As Integer)
For i=1 To delaytime
Next i
End Sub
  通过这样简单的程序就可以实现“百叶窗”的切换特效,其实,只要有合适的
算法,运用BitBlt函数能够实现的图形特效是无穷的。有兴趣的读者可以查阅有关
VB的参考书。


 
  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
基于VB的文字动画特效代码Private Sub TextEffect( _ ByVal sText As String, _ ByVal lX As Long, ByVal lY As Long, _ Optional ByVal bLoop As Boolean = False, _ Optional ByVal lStartSpacing As Long = 128, _ Optional ByVal lEndSpacing As Long = -1, _ Optional ByVal oColor As OLE_COLOR = vbWindowText _ ) Dim i As Long Dim x As Long Dim lLen As Long Dim lHDC As Long Dim hBrush As Long '定义各种变量 Static tR As RECT Dim iDir As Long Dim bNotFirstTime As Boolean Dim lTime As Long Dim lIter As Long Dim bSlowDown As Boolean Dim lCOlor As Long Dim bDoIt As Boolean iDir = -1 i = lStartSpacing '为变量赋值 tR.left = lX: tR.tOp = lY: tR.Right = lX: tR.Bottom = lY OleTranslateColor oColor, 0, lCOlor hBrush = CreateSolidBrush(GetSysColor(COLOR_BTNFACE)) lLen = Len(sText) lHDC = Me.hdc SetTextColor lHDC, lCOlor '设置文字颜色 bDoIt = True Do While m_bDoEffect And bDoIt lTime = timeGetTime If (i < -3) And Not (bLoop) And Not (bSlowDown) Then bSlowDown = True iDir = 1 lIter = (i + 4) End If If (i > 128) Then iDir = -1 If Not (bLoop) And iDir = 1 Then If (i = lEndSpacing) Then bDoIt = False Else lIter = lIter - 1 If (lIter <= 0) Then i = i + iDir lIter = (i + 4) End If End If Else i = i + iDir End If FillRect lHDC, tR, hBrush '调用FillRect函数 x = 32 - (i * lLen) SetTextCharacterExtra lHDC, i DrawText lHDC, sText, lLen, tR, DT_CALCRECT '调用API函数DrawText tR.Right = tR.Right + 4 If (tR.Right > Me.ScaleWidth \ Screen.TwipsPerPixelX) Then tR.Right = Me.ScaleWidth \ Screen.TwipsPerPixelX DrawText lHDC, sText, lLen, tR, DT_LEFT Me.Refresh '窗体刷新 Do DoEvents '后台运行 Loop While (timeGetTime - lTime) < 20 Loop DeleteObject hBrush End Sub
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值