Expand image with animation

The code below animates the resizing effect properly but from the left corner of the image. How can it be done from the center expanding in all directions?

Code:

---

Private Sub Timer1_Timer()

If Image1.Width >= 2916 Then
    Image1.Width = 2916
    Timer1.Enabled = False
    Exit Sub
End If
Image1.Width = Image1.Width + 50
Image1.Height = Image1.Height + 50
End Sub

---

Thanks

Thread moved from the 'CodeBank VB6' forum (which is for you to post working code examples, not questions) to the 'VB6 and earlier' forum

Code:

---

Private Sub Timer1_Timer()

If Image1.Width >= 2916 Then
    Image1.Width = 2916
    Timer1.Enabled = False
    Exit Sub
End If
Image1.Top = Image1.Top - 25
Image1.Left = Image1.Left - 25
Image1.Width = Image1.Width + 50
Image1.Height = Image1.Height + 50
End Sub

---

It has to expand in ALL directions from the CENTER of the Picture box

It does expand in all directions... you just need to set the start position (presumably top and left of 2916/2) and size (0).

In other words, if Image1 is inside a picturbox, you have to center Image1 in the picturebox at the start.
Then, as the Image1 is expanded, it is also moved (top, left) to keep the center of Image1 at the same location it started, which will be the center of the picturebox, if you had it centered in the picturebox to start with.

This example preserves the aspect ratio of the specified image as it is enlarged:

Code:

---

Option Explicit 'Copy & paste in a blank Form

Private Const HALF        As Single = 0.5!

Private m_AspectRatio    As Single
Private Image1            As VB.Image
Private Picture1          As VB.PictureBox
Private WithEvents Timer1 As VB.Timer

Private Sub Form_Activate()
    Const PROMPT = "No picture data or picture filename found in the Clipboard!" & vbCrLf & vbCrLf & "Try again?"
    Const STYLES = vbCritical Or vbRetryCancel Or vbDefaultButton1

    WindowState = vbMaximized

    Set Picture1 = Controls.Add("VB.PictureBox", "Picture1")
    Set Image1 = Controls.Add("VB.Image", "Image1", Picture1)

    Do: Select Case True
            Case Clipboard.GetFormat(vbCFText):  On Error Resume Next
                                                  Image1 = LoadPicture(Replace(Clipboard.GetText, """", vbNullString))
                                                  On Error GoTo 0

            Case Clipboard.GetFormat(vbCFBitmap): Image1 = Clipboard.GetData
        End Select

        If Image1.Picture.Handle Then Exit Do
        If MsgBox(PROMPT, STYLES) = vbCancel Then Unload Me: Exit Sub
    Loop

    Picture1.Move ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight
    Picture1.ScaleMode = vbPixels
    Picture1.Visible = True

    Image1.Move Picture1.ScaleWidth * HALF, Picture1.ScaleHeight * HALF, 0!, 0!
    Image1.Stretch = True
    Image1.Visible = True
    m_AspectRatio = Image1.Picture.Width / Image1.Picture.Height

    Set Timer1 = Controls.Add("VB.Timer", "Timer1")
    Timer1.Interval = 1&
End Sub

Private Sub Timer1_Timer()
    Dim NewWidth As Single, NewHeight As Single

    With Image1
        If .Width < Picture1.ScaleWidth And .Height < Picture1.ScaleHeight Then
            NewWidth = .Width + 2! 'Pixels
            NewHeight = NewWidth / m_AspectRatio

          .Move .Left - 1!, .Top - (NewHeight - .Height) * HALF, NewWidth, NewHeight
        Else
            Timer1 = False
        End If
    End With
End Sub

---

Good point.

Seems to do what I need! Many thanks