how can i resize an image and save it at runtime in vb

Here's how you can allow the user to stretch the image at runtime:

Private m_Dragging As Boolean

Private Sub Form_Load()
    Image1.Stretch = True
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    m_Dragging = True
End Sub


Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not m_Dragging Then Exit Sub

    Image1.Move 0, 0, X, Y
End Sub


Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    m_Dragging = False
End Sub

Try the below code


b. rgds
Jayesh


         'Add this code to cmdPicture.
Private Sub cmdPicture_Click()

    Dim str As String, str2 As String
    Dim strDrive As String
   
    On Error GoTo Oops
   
         'Get a picture.
    cdlPicture.ShowOpen
    Image1 = LoadPicture(cdlPicture.FileName)
   
         'Resize the picture.
    Call sResizePicture
   
        'If the report was saved anywhere other
        'than the default directory (App.Path),
        'the whole application will look for
        'its support in that other directory.
        'The next few lines ensure that we are
        'in the correct path.
    str2 = App.Path
    strDrive = Mid$(App.Path, 1, 1)
    str = CurDir
   
    If str <> str2 Then
        ChDrive strDrive
        ChDir str2
        str = CurDir
    End If
   
    Exit Sub
   
Oops:
    MsgBox Err.Description, vbExclamation
   
End Sub

Private Sub sResizePicture()
   
    Dim dblRatio As Double
   
    If Image1.Picture.Height > Image1.Picture.Width Then
        dblRatio = Image1.Picture.Width / Image1.Picture.Height
        Image1.Height = 2160    'Two inches
        Image1.Width = 2160 * dblRatio   'Two inches
    ElseIf Image1.Picture.Width > Image1.Picture.Height Then
        dblRatio = Image1.Picture.Height / Image1.Picture.Width
        Image1.Height = 2160 * dblRatio    'Two inches
        Image1.Width = 2160   'Two inches
    End If
   
    Image1.Stretch = True

End Sub

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!

No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in Community Support that this question is:
- refund and close
Please leave any comments here within the
next seven days.