2017-08-24 17 views
0

フォームを正しくフェードアウトさせることができましたが、何らかの理由でフェードインが正しく機能しません。負荷がかかっているときにフォームが「ヒッチ」します。それは正常にロードされ、次にフェードインします。Ms Windows APIを使用してフェードインでアクセスする

これは、モジュールを作成して、フォーム内でコード化することで完了です。

フォームコード:

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 

何かアドバイス?閉じるフェードはなぜ機能するのですが、ロードフェードはなぜですか?おかげさまで

+1

てみOpenイベントは、」ロードしないタイマにMe.Visible = Trueを設定する必要があります次のイベントがこの順序で発生します: 開く→読み込み→サイズ変更→有効化→現在 " – 4dmonster

+0

はい、私はそれを試みましたが、私はまだ同じ問題を抱えています。しかし、 –

+1

WindowMode = acHiddenでOpenFormを実行し、フェードイン中にAPI呼び出しで表示されないようにするには、TimerでMe.Visible = Trueを設定してください。 – 4dmonster

答えて

1

あなたが

  • 移動コードLoadからWindowMode = acHidden
  • とのコールOpenForm
  • イベントOpenには、あなたが最初にフォームを開いたとき
関連する問題