Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 14

Thread: Userform FadeIn/FadeOut Ivan F Moala, read in please

  1. #1
    Board Regular merlin_the_magician's Avatar
    Join Date
    Jul 2002
    Location
    Gorinchem, The Netherlands
    Posts
    475
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Userform FadeIn/FadeOut Ivan F Moala, read in please

    Ivan,

    first of all i have to thank you for sending me an example workbook on fading userforms. It's lovely, exactly what i meant.
    I have been playing with it a little, but i think i will need a lity little bit of help.
    I cut parts of you code, and pasted them together like the code underneath. It seems to be working fine at first, but then it somehow gets stuck on the last piece of the code, Private Function MakeTransparent(lIndex As Long) As Long what is wrong?


    Private Sub UserForm_Activate()
    '// Main routine to FadeIn/FadeOut
    Application.Wait (Now + TimeValue("0:00:03"))
    Call FadeOut(256 * 4)
    Image1.Visible = False
    Me.BackColor = &H8000000F
    Call FadeIn(256 * 4)
    Application.Wait (Now + TimeValue("0:00:06"))
    Unload Me
    End Sub



    ' MODIFIED: Ivan F Moala 2/6/2002
    Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    '// Leave this here as your backdoor, incase you have NO CLOSE BUTTON
    Unload Me
    End Sub

    ''//
    Private Function ShowTitleBar(ByVal bState As Boolean)
    Dim lStyle As Long
    Dim tR As RECT

    '// Get the window's position:
    GetWindowRect lFrmHdl, tR

    '// Modify whether title bar will be visible:
    lStyle = GetWindowLong(lFrmHdl, GWL_STYLE)
    '
    If Not bState Then
    lStyle = lStyle And Not WS_SYSMENU
    lStyle = lStyle And Not WS_MAXIMIZEBOX
    lStyle = lStyle And Not WS_MINIMIZEBOX
    lStyle = lStyle And Not WS_CAPTION
    blnTitleVisible = True
    Else
    lStyle = lStyle Or WS_SYSMENU
    lStyle = lStyle Or WS_MAXIMIZEBOX
    lStyle = lStyle Or WS_MINIMIZEBOX
    lStyle = lStyle Or WS_CAPTION
    blnTitleVisible = False
    End If

    SetWindowLong lFrmHdl, GWL_STYLE, lStyle

    '// Ensure the style takes and make the window the
    '// same size, regardless that the title bar
    '// is now a different size:
    SetWindowPos lFrmHdl, 0, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, _
    SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED
    Me.Repaint

    End Function

    Private Sub FadeIn(Fin As Long)
    Dim X As Long

    MakeTransparent 0

    X = 0
    Do Until X = Fin
    DoEvents
    X = X + 1
    MakeTransparent X / 2
    Loop

    End Sub

    Private Function FadeOut(Fin As Long)
    Dim Y As Long

    Call MakeTransparent(255)

    Y = Fin '1000

    Do Until Y = 0
    DoEvents
    Y = Y - 1
    Call MakeTransparent(Y / 2)
    Loop

    End Function

    Private Function MakeTransparent(lIndex As Long) As Long

    End Function

    On Error Resume Next
    If lIndex < 0 Or lIndex > 255 Then
    MakeTransparent = 0 '1
    Else
    lResult = GetWindowLong(lFrmHdl, GWL_EXSTYLE)
    lResult = lResult Or WS_EX_LAYERED
    SetWindowLong lFrmHdl, GWL_EXSTYLE, lResult
    SetLayeredWindowAttributes lFrmHdl, 0, lIndex, LWA_ALPHA
    MakeTransparent = 0
    End If

    If Err Then MakeTransparent = 2

    End Function
    Merlin the Magician

  2. #2
    MrExcel MVP
    Moderator
    Andrew Poulsom's Avatar
    Join Date
    Jul 2002
    Posts
    73,092
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Userform FadeIn/FadeOut Ivan F Moala, read in please

    Try removing the superfluous End Function which appears immediately after Private Function MakeTransparent(lIndex As Long) As Long.

  3. #3
    Board Regular merlin_the_magician's Avatar
    Join Date
    Jul 2002
    Location
    Gorinchem, The Netherlands
    Posts
    475
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Userform FadeIn/FadeOut Ivan F Moala, read in please

    Obvious...

    But not quite the solution because it hangs on GetWindowLong and SetWindowLong now. What else could be buggy?
    Merlin the Magician

  4. #4
    MrExcel MVP
    Moderator
    Andrew Poulsom's Avatar
    Join Date
    Jul 2002
    Posts
    73,092
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Userform FadeIn/FadeOut Ivan F Moala, read in please

    Where have you declared those functions? Should be at the top of your module:

    Code:
    Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

  5. #5
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    You need all the routines

    But 1st off you need this in the Userform code

    Code:
    Private Sub UserForm_Initialize()
        '// Ivan F Moala
        lFrmHdl = FindWindowA(vbNullString, Me.Caption)
        ShowTitleBar False
        '// Need this call 1st to set > No Flicker
        MakeTransparent (255)
    End Sub
    Then you need to Export to you current code the API Routines

    This is the Module basAPI which should look like this;

    Code:
    Option Explicit
    
    '// Transparency
    Public Declare Function SetLayeredWindowAttributes _
        Lib "user32" ( _
        ByVal hWnd As Long, _
        ByVal crKey As Long, _
        ByVal bAlpha As Byte, _
        ByVal dwFlags As Long) _
    As Long
    
    '//
    Public Declare Function GetWindowRect Lib "user32" ( _
       ByVal hWnd As Long, _
       lpRect As RECT) 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 GetWindowLong Lib "user32" _
       Alias "GetWindowLongA" ( _
       ByVal hWnd As Long, _
       ByVal nIndex As Long) As Long
       
    '// Win Styles
    Public Const GWL_EXSTYLE = (-20)
    Public Const GWL_STYLE = (-16)
    
    Public Const WS_EX_LAYERED = &H80000
    Public Const WS_CAPTION = &HC00000            ' WS_BORDER Or WS_DLGFRAME
    Public Const WS_MAXIMIZEBOX = &H10000
    Public Const WS_MINIMIZEBOX = &H20000
    Public Const WS_SYSMENU = &H80000
    
    '//
    Public Const LWA_COLORKEY = &H1
    Public Const LWA_ALPHA = &H2
    Public Const ULW_COLORKEY = &H1
    Public Const ULW_ALPHA = &H2
    Public Const ULW_OPAQUE = &H4
    
    '// Used for moving Captionless form
    Public Declare Function SetWindowPos Lib "user32" ( _
       ByVal hWnd As Long, _
       ByVal hWndInsertAfter As Long, _
       ByVal X As Long, _
       ByVal Y As Long, _
       ByVal cx As Long, _
       ByVal cy As Long, _
       ByVal wFlags As Long) As Long
    
    Public Declare Function SendMessage Lib "user32" _
       Alias "SendMessageA" ( _
       ByVal hWnd As Long, _
       ByVal wMsg As Long, _
       ByVal wParam As Long, _
       lParam As Any) As Long
    
     
    Public Declare Function FindWindowA _
        Lib "user32" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) _
    As Long
      
    Public Const SWP_SHOWWINDOW = &H40
    Public Const SWP_HIDEWINDOW = &H80
    Public Const SWP_FRAMECHANGED = &H20 ' The frame changed: send WM_NCCALCSIZE
    Public Const SWP_NOACTIVATE = &H10
    Public Const SWP_NOCOPYBITS = &H100
    Public Const SWP_NOMOVE = &H2
    Public Const SWP_NOOWNERZORDER = &H200    ' Don't do owner Z ordering
    Public Const SWP_NOREDRAW = &H8
    Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
    Public Const SWP_NOSIZE = &H1
    Public Const SWP_NOZORDER = &H4
    Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
    Public Const HWND_NOTOPMOST = -2
    
    Public Type RECT
        Left   As Long
        Top    As Long
        Right  As Long
        Bottom As Long
    End Type
    
    Public lResult As Long
    Public frmHdl As Long
    Public blnTitleVisible As Boolean
    Public blnCtrlShow As Boolean
    
    Public lFrmHdl  As Long
    Kind Regards,
    Ivan F Moala From the City of Sails

  6. #6
    Board Regular merlin_the_magician's Avatar
    Join Date
    Jul 2002
    Location
    Gorinchem, The Netherlands
    Posts
    475
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Eh... i'm confused... Ivan, i emailed you my workbook. Would you mind having a breef look at it to see what's wrong please?
    Merlin the Magician

  7. #7
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    This will cost you lol
    Kind Regards,
    Ivan F Moala From the City of Sails

  8. #8
    Board Regular merlin_the_magician's Avatar
    Join Date
    Jul 2002
    Location
    Gorinchem, The Netherlands
    Posts
    475
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Don't think i can find the time to bring something by, it quite a long trip you know

    Sending it by pigeon is probably no option eighter
    Merlin the Magician

  9. #9
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Send by all means ......
    Kind Regards,
    Ivan F Moala From the City of Sails

  10. #10
    Board Regular merlin_the_magician's Avatar
    Join Date
    Jul 2002
    Location
    Gorinchem, The Netherlands
    Posts
    475
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Ivan.... i think i love you

    This is great!!! Thank you so very much!

    One minor thing: there is an piece of code that will prevent flickering of the userform on startup. I still can see a flicker however. Can this be fixed?

    Private Sub UserForm_Initialize()
    '// Ivan F Moala
    lFrmHdl = FindWindowA(vbNullString, Me.Caption)
    ShowTitleBar False
    '// Need this call 1st to set > No Flicker
    MakeTransparent (255)
    End Sub
    Merlin the Magician

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •