0
我已經設法使表單正常淡出,但出於某種原因,我的淡入功能無法正常工作。加載過程中形式爲「掛鉤」。它正常加載,然後淡入。而不是在開始時淡化。使用Windows API在窗體中使用Ms Access淡入淡出
這是通過創建一個模塊,然後在表單內編碼完成的。
形式代碼:
Option Compare Database
Dim gintC
Private Sub Form_Load()
Me.TimerInterval = 2
FadeForm Me, Fadezero, 1, 5
End Sub
Private Sub Form_Timer()
If IsEmpty(gintC) Then
FadeForm Me, Fadein, 1, 15
End If
gintC = 1
Me.TimerInterval = 0
End Sub
Private Sub Form_Close()
FadeForm Me, Fadeout, 1, 255
End Sub
模塊:
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const WS_EX_TRANSPARENT = &H20&
Public Const LWA_ALPHA = &H2&
'Enum for determining the direction of the fade.
Public Enum FadeDirection
Fadein = -1
Fadeout = 0
Fadezero = 1
SetOpacity = 1
End Enum
Public Sub FadeForm(frm As Form, Optional Direction As FadeDirection = FadeDirection.Fadein, _
Optional iDelay As Integer = 0, Optional StartOpacity As Long = 5)
Dim lOriginalStyle As Long
Dim iCtr As Integer
'You can only set a form's opacity if it's Popup property = True.
If (frm.PopUp = True) Then
'Get the form window’s handle, and remember its original style.
lOriginalStyle = GetWindowLong(frm.hWnd, GWL_EXSTYLE)
SetWindowLong frm.hWnd, GWL_EXSTYLE, lOriginalStyle Or WS_EX_LAYERED
'If the form’s original style = 0, it hasn’t been faded since it was opened.
'To get fading to work, we have to set its style to something other than zero.
If (lOriginalStyle = 0) And (Direction <> FadeDirection.SetOpacity) Then
'Recursively call this same procedure to set the value.
FadeForm frm, SetOpacity, , StartOpacity
End If
'Depending on the direction of the fade...
Select Case Direction
Case FadeDirection.Fadezero
iCtr = StartOpacity
SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
Case FadeDirection.Fadein
'Just in case.
If StartOpacity < 1 Then StartOpacity = 1
'Fade the form in by varying its opacity
'from the value supplied in 'StartOpacity'
'to 255 (completely opaque).
For iCtr = StartOpacity To 255 Step 1
SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
'Process any outstanding events.
DoEvents
'Wait a while, so the user can see the effect.
Sleep iDelay
Next
Case FadeDirection.Fadeout
'Just in case.
If StartOpacity < 6 Then StartOpacity = 255
'Fade the form out by varying its opacity
'from 255 to 1 (almost transparent).
For iCtr = StartOpacity To 1 Step -1
SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
'Process any outstanding events.
DoEvents
'Wait a while, so the user can see the effect.
Sleep iDelay
Next
Case Else 'FadeDirection.SetOpacity.
'Just in case.
Select Case StartOpacity
Case Is < 1: StartOpacity = 1
Case Is > 255: StartOpacity = 255
End Select
'Set the form's opacity to a specific value.
SetLayeredWindowAttributes frm.hWnd, 0, CByte(StartOpacity), LWA_ALPHA
'Process any outstanding events.
DoEvents
'Wait a while, so the user can see the effect.
Sleep iDelay
End Select
Else
'The form’s Popup property MUST = True
DoCmd.Beep
MsgBox "The form's Popup property must be set to True.", vbOKOnly & vbInformation, "Cannot fade form"
End If
End Sub
任何建議?任何想法爲什麼關閉淡入淡出效果,但加載淡入淡出不? 謝謝。
嘗試打開事件無法加載「當你第一次打開窗體,按以下順序發生以下事件: 打開→裝載→調整大小→激活→當前「 – 4dmonster
是的,我曾嘗試過,但仍然遇到同樣的問題。雖然 –
然後你應該OpenForm與WindowMode = acHidden,並且如果API調用不會使其可見時淡入,設置Me.Visible = True在定時器 – 4dmonster