Prikazi cijelu temu 12.09.2012-11:40
roko Offline
Clan
Registrovan/a od: 02.02.2009-00:23
Lokacija: Rijeka


Subject: Fadein & Out Forme
Fade in out Form

Modul :
DownloadIzvorni kod (Visual Basic):
  1. Option Compare Database
  2. Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
  3. (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  4. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  5. (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  6. Public Declare Function SetLayeredWindowAttributes Lib "user32" _
  7. (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
  8. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  9. Public Const GWL_EXSTYLE = (-20)
  10. Public Const WS_EX_LAYERED = &H80000
  11. Public Const WS_EX_TRANSPARENT = &H20&
  12. Public Const LWA_ALPHA = &H2&
  13. Public Enum FadeDirection
  14.    Fadein = -1
  15.    Fadeout = 0
  16.    Fadezero = 1
  17.    SetOpacity = 1
  18. End Enum
  19. Public Sub FadeForm(frm As Form, Optional Direction As FadeDirection = FadeDirection.Fadein, _
  20. Optional iDelay As Integer = 0, Optional StartOpacity As Long = 5)
  21. If frm Is Nothing Then: Exit Sub
  22. On Error GoTo van
  23.    Dim lOriginalStyle As Long
  24.    Dim iCtr As Integer
  25.    If (frm.PopUp = True) Then
  26.        lOriginalStyle = GetWindowLong(frm.hWnd, GWL_EXSTYLE)
  27.        SetWindowLong frm.hWnd, GWL_EXSTYLE, lOriginalStyle Or WS_EX_LAYERED
  28.        If (lOriginalStyle = 0) And (Direction <> FadeDirection.SetOpacity) Then
  29.           FadeForm frm, SetOpacity, , StartOpacity
  30.        End If
  31.        Select Case Direction
  32.           Case FadeDirection.Fadezero
  33.               iCtr = StartOpacity
  34.               SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
  35.           Case FadeDirection.Fadein
  36.               If StartOpacity < 1 Then StartOpacity = 1
  37.               For iCtr = StartOpacity To 255 Step 1
  38.                  SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
  39.                  DoEvents
  40.                '  Debug.Print iCtr
  41.                 Sleep iDelay
  42.               Next
  43.           Case FadeDirection.Fadeout
  44.               If StartOpacity < 6 Then StartOpacity = 255
  45.               For iCtr = StartOpacity To 1 Step -1
  46.                  SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
  47.                  DoEvents
  48.                  Sleep iDelay
  49.               Next
  50.           Case Else
  51.               Select Case StartOpacity
  52.                  Case Is < 1: StartOpacity = 1
  53.                  Case Is > 255: StartOpacity = 255
  54.               End Select
  55.               SetLayeredWindowAttributes frm.hWnd, 0, CByte(StartOpacity), LWA_ALPHA
  56.                  DoEvents
  57.                  Sleep iDelay
  58.        End Select
  59.    Else
  60.        MsgBox "Forma mora biti Popup", vbOKOnly & vbInformation, "Ne
  61. e ii"
  62.    End If
  63. van:
  64. End Sub
Poziv na formi:
DownloadIzvorni kod (Visual Basic):
  1. Option Compare Database
  2. Dim MojInt
  3. Private Sub Form_Open(Cancel As Integer)
  4. Me.TimerInterval = 2
  5. FadeForm Me, Fadezero, 1, 5
  6. End Sub
  7. Private Sub Form_Timer()
  8. On Error Resume Next
  9. If IsEmpty(MojInt) Then
  10.     FadeForm Me, Fadein, 1, 15
  11.    MojInt = 1
  12. End If
  13.  Me.TimerInterval = 0
  14. End Sub


Prilozi:
Fade_in_out.rar
Preuzimanja: 141
Veličina: 29.98 KB