[Tasos]

Καλησπέρα σε όλους!

Τζίμη η Access, ως εφαρμογή βάσης δεδομένων περιλαμβάνει μόνο βασικές λειτουργίες παραθύρων στις φόρμες της.
Ωστόσο αν σε μια φόρμα δώσουμε την ιδιότητα "Αναδυόμενη" μπορούμε με χρήση της VB σε
συνδυασμό με κάποια API των Windows μπορούμε να έχουμε ικανοποιητικά αποτελέσματα.

Θα δώσω ένα παράδειγμα.

Αρχικά φρόντισε η αρχική φόρμα:

• Να ξεκινά από κάποια μακροεντολή(AutoExec) ή κώδικα, όχι σαν φόρμα εκκίνησης από τις ρυθμίσεις της εφαρμογής.
• Να έχει ιδιότητα "Αναδυόμενη"
• Να ανοίγει σε κατάσταση παραθύρου "Κρυφό". πχ: DoCmd.OpenForm "Form1", acNormal, , , , acHidden

Κατόπιν σε μια κοινή λειτουργίκή μονάδα πέρασε τον παρακάτω κώδικα:

Option Compare Database
Option Explicit

Public Enum FadeDirection
    FadeIn = -1
    FadeOut = 0
End Enum

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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 wNewWord 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 Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const LWA_ALPHA = &H2&

Public Function FadeForm(frmHWND As Long, _
        Optional Direction As FadeDirection = FadeDirection.FadeIn, _
        Optional iDelay As Integer = 5, _
        Optional Fulltranperancy As Boolean)
        
    Dim frmStyle As Long
    Dim i As Integer

    frmStyle = GetWindowLong(frmHWND, GWL_EXSTYLE)
    SetWindowLong frmHWND, GWL_EXSTYLE, frmStyle Or WS_EX_LAYERED
    If Fulltranperancy Then
        SetLayeredWindowAttributes frmHWND, 0, CByte(5), LWA_ALPHA
        Exit Function
    End If
    
    Select Case Direction
    Case FadeDirection.FadeIn
        For i = 5 To 255 Step 20
            DoEvents
            SetLayeredWindowAttributes frmHWND, 0, CByte(i), LWA_ALPHA
            Sleep iDelay
        Next
        SetLayeredWindowAttributes frmHWND, 0, CByte(255), LWA_ALPHA
    Case FadeDirection.FadeOut
        For i = 255 To 1 Step -20
            SetLayeredWindowAttributes frmHWND, 0, CByte(i), LWA_ALPHA
            DoEvents
            Sleep iDelay
        Next
    End Select
    
End Function

και στη λειτουργική μονάδα της φόρμας πέρασε το παρακάτω:

Option Compare Database
Option Explicit

Private Sub Form_Load()
    FadeForm Me.hWnd, , , True
    Me.Visible = True
    FadeForm Me.hWnd, FadeIn, 35  ' προσαρμόζει τη διάρκεια του εφέ.
End Sub

Private Sub Form_Unload(Cancel As Integer)
    FadeForm Me.hWnd, FadeOut, 35
End Sub

Δοκίμασε το και τα λέμε.

Φιλικά

Τάσος