AJP Excel Information AJP Excel Information

Rollover image magnifier


The rollover image magnification effect is created by moving a frame, containing an image control, over the source image. By setting the image contained within the frame to a size factor of the compressed image it gives the illusion of magnifying the image under the frame.
Option Explicit

Private m_ZoomFactor As Double
Private Sub CheckBox1_Click()

    If CheckBox1.Value Then
        Image2.AutoSize = False
        Image2.PictureSizeMode = fmPictureSizeModeStretch
        Image2.Width = Image2.Width * 2
        Image2.Height = Image2.Height
    Else
        Image2.PictureSizeMode = fmPictureSizeModeClip
        Image2.AutoSize = True
    End If
    
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Button = 1 Then
        With Frame1
            .Left = X
            .Top = Y
            .Visible = True
        End With
    End If
    
End Sub

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Dim RatioX As Double
    Dim RatioY As Double
        
    If Button = 1 Then
        Frame1.Left = Image1.Left + X - (Frame1.Width / 2)
        Frame1.Top = Image1.Top + Y - (Frame1.Height / 2)
    
        RatioX = X / Image1.Width
        RatioY = Y / Image1.Height
        
        Image2.Left = -(Image2.Width * RatioX) + (Frame1.Width / 2)
        Image2.Top = -(Image2.Height * RatioY) + (Frame1.Height / 2)
        
    End If
End Sub

Private Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Button = 1 Then
        Frame1.Left = Image1.Left + Image1.Width
        Frame1.Top = Image1.Top + Image1.Height
        Frame1.Visible = False
    End If
End Sub

Private Sub UserForm_Initialize()

    Image2.Picture = Image1.Picture
    Image2.AutoSize = True
    Frame1.SpecialEffect = fmSpecialEffectRaised
    Frame1.Visible = False
    
    m_ZoomFactor = 1
    ZoomFactor.List = Array("1.0", "1.5", "2.0", "2.5", "3.0", "3.5", "4.0", "5.0", "10.0")
    ZoomFactor.ListIndex = 0
    
End Sub

Private Sub ZoomFactor_Change()

    m_ZoomFactor = CDbl(ZoomFactor.Value)
    
    Image2.AutoSize = True
    If ZoomFactor.ListIndex > 0 Then
        Image2.AutoSize = False
        Image2.PictureSizeMode = fmPictureSizeModeStretch
        Image2.Width = Image2.Width * m_ZoomFactor
        Image2.Height = Image2.Height * m_ZoomFactor
    Else
        Image2.PictureSizeMode = fmPictureSizeModeClip
    End If
    
End Sub
For the best effect the large source image should be size such that it retains it's aspect ratio.

 

Created 15th Novemebr 2014
Last updated 15th November 2014 


Return to main page Chart Section VBA section Fun and games section Forum files Tips section Links section Book section Site information Site Search RSS feed Top of page


Microsoft® and Microsoft® Excel are registered trademarks of the Microsoft Corporation.
andypope.info is not associated with Microsoft. Copyright ©2007-2016 Andy Pope