Magnify Image

BOTJOE 2015-06-25

展開全文

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.