MouseOver HoverEffect With VBA | Free Code-snippet

[henrixon]

Hi Everyone!

Since I'm doing some code-snippets I thought I share one with you!


This simple script looks for any element on the active screen named "something_HOVER" and "theSameSomething_TRIGGER". It finds the _HOVER element and hides it when the screen is shown then if you drag your mouse over the trigger element with the same name it will un-hide the hidden element when your mouse is over the element.

E.g:
A400S1_HOVER <- Simple graphical element. Like a Rectangle or something
A400S1_TRIGGER <- Combined Element named the same but _TRIGGER. This should be placed on-top of the _HOVER element and should cover the same area as the _HOVER element. But it's up to you.. It will work anyway.

You need one more element aswell. Fill the background with another Combined Element and make sure to place it the furthest in the background.

These 2 elements should then be connected to the VBA macros under properties "VBA Macros"
A400S1_TRIGGER <- MouseOver: MouseOver_HoverEffect
{Combined element in the backgrond} <- Init: Init_HideAll & MouseOver: MouseOver_Reset


Here's a simple video tutorial on how to use it!


And here's the code:

' Initiated when active screen loads background object
' Hides all elements with "_HOVER" in the name

Public Sub Init_HideElements(obElem As Element)
    Dim i As Integer
    Dim objProj As Project
    Dim AllElements As Elements
    
    Set objProj = thisProject
    Set AllElements = objProj.DynPictures.Item(obElem.Parent.Parent.Name  ).Elements
   
    For i = 0 To AllElements.Count - 1

        If UCase(Right(AllElements.Item(i).Name, 6)) = "_HOVER" And AllElements.Item(i).Hide = False Then
            AllElements.Item(i).Hide = True
        End If
    Next
End Sub

' Called when mouse moves over background element.
' Hides all elements with "_HOVER" in the name that are visible

Public Sub MouseOver_Reset(obElem As Element, vPosX As Variant, vPosY As Variant)
    Dim i As Integer
    Dim objProj As Project
    Dim AllElements As Elements
    
    Set objProj = thisProject
    Set AllElements = objProj.DynPictures.Item(obElem.Parent.Parent.Name  ).Elements
   
    For i = 0 To AllElements.Count - 1

        If UCase(Right(AllElements.Item(i).Name, 6)) = "_HOVER" And AllElements.Item(i).Hide = False Then
            AllElements.Item(i).Hide = True
        End If
    Next
End Sub

Public Sub MouseOver_HoverEffect(obElem As Element, vPosX As Variant, vPosY As Variant)

    Dim i As Integer
    Dim objProj As Project
    Dim AllElements As Elements
    Dim HoverElement As Element
    
    Set objProj = thisProject
    Set AllElements = objProj.DynPictures.Item(obElem.Parent.Parent.Name  ).Elements
    
    Dim stringCount As Long: stringCount = (Len(obElem.Name) - 8)
    Dim ElementName As String: ElementName = Mid$(obElem.Name, 1, stringCount)
    
    For i = 0 To AllElements.Count - 1
    
        ' Hide all elements that is not this element
        If Left(AllElements.Item(i).Name, stringCount) <> ElementName And UCase(Right(AllElements.Item(i).Name, 6)) = "_HOVER" Then

            Set HoverElement = objProj.DynPictures.Item(obElem.Parent.Parent.Name  ).Elements.ItemById(AllElements.Item(i).ID)
            
            If HoverElement.Hide = False Then
                HoverElement.Hide = True
            End If
        
        End If
        
        ' Unhide the element your mouse is over
        If Left(AllElements.Item(i).Name, stringCount) = ElementName And UCase(Right(AllElements.Item(i).Name, 6)) = "_HOVER" Then

            Set HoverElement = objProj.DynPictures.Item(obElem.Parent.Parent.Name  ).Elements.ItemById(AllElements.Item(i).ID)
            
            If HoverElement.Hide = True Then
                HoverElement.Hide = False
            End If
        
        End If
    Next
    
End Sub

I've also included an export of the moduleElement file so you can simply import it to your project. You can find it under Attachements

This is how it should look in your project:

[yucefurkan]

Hi Everyone!



Since I'm doing some code-snippets I thought I share one with you!





This simple script looks for any element on the active screen named "something_HOVER" and "theSameSomething_TRIGGER". It finds the _HOVER element and hides it when the screen is shown then if you drag your mouse over the trigger element with the same name it will un-hide the hidden element when your mouse is over the element.



E.g:

A400S1_HOVER <- Simple graphical element. Like a Rectangle or something

A400S1_TRIGGER <- Combined Element named the same but _TRIGGER. This should be placed on-top of the _HOVER element and should cover the same area as the _HOVER element. But it's up to you.. It will work anyway.



You need one more element aswell. Fill the background with another Combined Element and make sure to place it the furthest in the background.



These 2 elements should then be connected to the VBA macros under properties "VBA Macros"

A400S1_TRIGGER <- MouseOver: MouseOver_HoverEffect

{Combined element in the backgrond} <- Init: Init_HideAll & MouseOver: MouseOver_Reset





Here's a simple video tutorial on how to use it!





And here's the code:

' Initiated when active screen loads background object

' Hides all elements with "_HOVER" in the name



Public Sub Init_HideElements(obElem As Element)

    Dim i As Integer

    Dim objProj As Project

    Dim AllElements As Elements

    

    Set objProj = thisProject

    Set AllElements = objProj.DynPictures.Item(obElem.Parent.Parent.Name  ).Elements

   

    For i = 0 To AllElements.Count - 1



        If UCase(Right(AllElements.Item(i).Name, 6)) = "_HOVER" And AllElements.Item(i).Hide = False Then

            AllElements.Item(i).Hide = True

        End If

    Next

End Sub



' Called when mouse moves over background element.

' Hides all elements with "_HOVER" in the name that are visible



Public Sub MouseOver_Reset(obElem As Element, vPosX As Variant, vPosY As Variant)

    Dim i As Integer

    Dim objProj As Project

    Dim AllElements As Elements

    

    Set objProj = thisProject

    Set AllElements = objProj.DynPictures.Item(obElem.Parent.Parent.Name  ).Elements

   

    For i = 0 To AllElements.Count - 1



        If UCase(Right(AllElements.Item(i).Name, 6)) = "_HOVER" And AllElements.Item(i).Hide = False Then

            AllElements.Item(i).Hide = True

        End If

    Next

End Sub



Public Sub MouseOver_HoverEffect(obElem As Element, vPosX As Variant, vPosY As Variant)



    Dim i As Integer

    Dim objProj As Project

    Dim AllElements As Elements

    Dim HoverElement As Element

    

    Set objProj = thisProject

    Set AllElements = objProj.DynPictures.Item(obElem.Parent.Parent.Name  ).Elements

    

    Dim stringCount As Long: stringCount = (Len(obElem.Name) - 8)

    Dim ElementName As String: ElementName = Mid$(obElem.Name, 1, stringCount)

    

    For i = 0 To AllElements.Count - 1

    

        ' Hide all elements that is not this element

        If Left(AllElements.Item(i).Name, stringCount) <> ElementName And UCase(Right(AllElements.Item(i).Name, 6)) = "_HOVER" Then



            Set HoverElement = objProj.DynPictures.Item(obElem.Parent.Parent.Name  ).Elements.ItemById(AllElements.Item(i).ID)

            

            If HoverElement.Hide = False Then

                HoverElement.Hide = True

            End If

        

        End If

        

        ' Unhide the element your mouse is over

        If Left(AllElements.Item(i).Name, stringCount) = ElementName And UCase(Right(AllElements.Item(i).Name, 6)) = "_HOVER" Then



            Set HoverElement = objProj.DynPictures.Item(obElem.Parent.Parent.Name  ).Elements.ItemById(AllElements.Item(i).ID)

            

            If HoverElement.Hide = True Then

                HoverElement.Hide = False

            End If

        

        End If

    Next

    

End Sub

I've also included an export of the moduleElement file so you can simply import it to your project. You can find it under Attachements



This is how it should look in your project:

that was very cool. 
I created a symbol with your whole things. but when I try to drag and drop this symbol for second one , it seems not cool. Because your code based on Element Name. so then how can we do that?
thanks already