Option Compare Database 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& 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) If frm Is Nothing Then: Exit Sub On Error GoTo van Dim lOriginalStyle As Long Dim iCtr As Integer If (frm.PopUp = True) Then lOriginalStyle = GetWindowLong(frm.hWnd, GWL_EXSTYLE) SetWindowLong frm.hWnd, GWL_EXSTYLE, lOriginalStyle Or WS_EX_LAYERED If (lOriginalStyle = 0) And (Direction <> FadeDirection.SetOpacity) Then FadeForm frm, SetOpacity, , StartOpacity End If Select Case Direction Case FadeDirection.Fadezero iCtr = StartOpacity SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA Case FadeDirection.Fadein If StartOpacity < 1 Then StartOpacity = 1 For iCtr = StartOpacity To 255 Step 1 SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA DoEvents ' Debug.Print iCtr Sleep iDelay Next Case FadeDirection.Fadeout If StartOpacity < 6 Then StartOpacity = 255 For iCtr = StartOpacity To 1 Step -1 SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA DoEvents Sleep iDelay Next Case Else Select Case StartOpacity Case Is < 1: StartOpacity = 1 Case Is > 255: StartOpacity = 255 End Select SetLayeredWindowAttributes frm.hWnd, 0, CByte(StartOpacity), LWA_ALPHA DoEvents Sleep iDelay End Select Else MsgBox "Forma mora biti Popup", vbOKOnly & vbInformation, "Ne e ii" End If van: End Sub