VB中如何使得窗体内的图片淡出淡入
我在窗体内放了5幅图片，我想让它们淡出淡入循环显示，不知道代码该如何写，麻烦给解决一下；写下原码
[解决办法]
Private Declare Function AlphaBlend Lib "Msimg32.dll " ( _
ByVal hdcDest As Long, _
ByVal nXOriginDest As Long, _
ByVal nYOriginDest As Long, _
ByVal nWidthDest As Long, _
ByVal nHeightDest As Long, _
ByVal hdcSrc As Long, _
ByVal nXOriginSrc As Long, _
ByVal nYOriginSrc As Long, _
ByVal nWidthSrc As Long, _
ByVal nHeightSrc As Long, _
ByVal BLENDFUNCTION As Long) As Boolean
Const AC_SRC_OVER = &H0
Const AC_SRC_ALPHA = &H1
Private Type BLENDFUNCTION
BlendOP As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Declare Sub Sleep Lib "kernel32 " _
( _
ByVal dwMilliseconds As Long _
)
'Sleep为延时函数以毫秒为单位指定等待的时间
Dim sBlendFunction As BLENDFUNCTION
Dim LnBlendPtr As Long
Private Sub Form_Load()
Timer1.Interval = 2000
sBlendFunction.BlendOP = AC_SRC_OVER
sBlendFunction.BlendFlags = 0
sBlendFunction.AlphaFormat = 0
FrmTs.ScaleMode = 3
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3
'设置Form、Picture1和Picture2的标志单位为像素
Picture1.AutoRedraw = False
Picture2.AutoRedraw = False
Picture1.Picture = LoadPicture(App.Path + "\1.bmp ")
End Sub
Private Sub Timer1_Timer()
Dim LnBlendPtr As Long
Static j As Integer
j = j + 1
If j = 1 Then
Picture1.Picture = LoadPicture(App.Path + "\fore.bmp ")
trtc
ElseIf j = 2 Then
j = j - 2
Picture1.Picture = LoadPicture(App.Path + "\1.bmp ")
trtc
End If
End Sub
Public Function trtc()
'淡入效果
Picture2.Cls
For i = 0 To 50
sBlendFunction.SourceConstantAlpha = i * 5
CopyMemory LnBlendPtr, sBlendFunction, 4
AlphaBlend Picture2.hDC, 0, 0, Picture2.Width, Picture2.Height, _
Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, _
LnBlendPtr
Sleep (50)
DoEvents
Next
'淡出效果
Picture2.Cls
For i = 0 To 10
sBlendFunction.SourceConstantAlpha = 250 - i * 25
CopyMemory LnBlendPtr, sBlendFunction, 4
AlphaBlend Picture2.hDC, 0, 0, Picture2.Width, _
Picture2.Height, Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, _
LnBlendPtr
Sleep (50)
Picture2.Refresh
DoEvents
Next
End Function
[解决办法]
以下代码用动画方式显示图片:
Option Explicit
Dim w, h As Single
'w和h分别记录图片的宽度和高度
Dim x, y As Single
'x和y分别为取图位置的X坐标和Y坐标
'或者也可以说成是所取区域的宽度和高度
Dim b As Boolean
Dim i, m, n, j As Integer
Private Sub Reset()
w = Picture1.Width
h = Picture1.Height
'保存图片的宽度和高度
Picture2.Width = w
Picture2.Height = h
'根据图片设置Picture2的宽度和高度
'重新设置List1控件的位置
Me.Width = w + 700
'设置窗口的宽度
Me.Height = h + 700
'设置窗口的高度
'注意留出菜单的高度
b = False
End Sub
Private Sub Form_Load()
Picture1.Left = 0
Picture1.Top = 0
'使Picture1位于窗口的左上角
Picture1.AutoSize = True
'使Picture1能够根据图片自动更改自己的宽度和高度
Picture1.Visible = False
'隐藏Picture1
Picture1.Picture = LoadPicture(App.Path + "\water.jpg ")
'在Picture1中显示一幅图片
Picture2.Left = 0
Picture2.Top = 0
Reset
Timer1.Interval = 50
End Sub
Private Sub Timer1_Timer()
'网格效果
m = w / 20
n = h / 20
x = x + w / 200
y = y + h / 200
If x > m Then
Picture2.Picture = Picture1.Picture
End If
For i = 0 To 20
For j = 0 To 20
Picture2.PaintPicture Picture1.Picture, i * m, j * n, , , i * m, j * n, x, y
Next j, i
End Sub
