VB 6.0 - Image Resizing - Asked By Cris Alexander on 27-Sep-06 02:14 PM

I need to load a bitmap image into a form (frmPlot.Picture = ...) and then resize the image to fit the form. Is there a way to do this in VB6?

You can use PaintPicture in VB6 to resize image

For sample check out

http://vb-helper.com/howto_resize_picture_save.html

<extract>

Private Sub Command1_Click()
Dim file_name As String
    ' Resize the picture.
    Picture2.AutoRedraw = True
    Picture2.PaintPicture Picture1.Picture, _
        Picture2.ScaleLeft, Picture2.ScaleTop, _
            Picture2.ScaleWidth, Picture2.ScaleHeight, _
        Picture1.ScaleLeft, Picture1.ScaleTop, _
            Picture1.ScaleWidth, Picture1.ScaleHeight
    Picture2.Picture = Picture2.Image
    ' Save the result.
    file_name = App.Path
    If Right$(file_name, 1) <> "\" Then file_name = _
        file_name & "\"
    SavePicture Picture2.Picture, file_name & "small.bmp"
End Sub
Private Sub Form_Load()
Dim edge As Single
    edge = Picture1.Width - Picture1.ScaleWidth
    Picture2.Width = (Picture1.Width - edge) / 2 + edge
    Picture2.Height = (Picture1.Height - edge) / 2 + edge
    Me.Width = Picture2.Left + Picture2.Width + 240
End Sub

</extract>

That is perfect! Many thanks!

You are a rock star.

end of post

Option Explicit
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, _
                                       ByVal szApp As String, _
                                       ByVal szOtherStuff As String, _
                                       ByVal hIcon As Long) As Long
Private Declare Function GetMenu Lib "user32" _
   (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" _
   (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" _
   (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, _
    ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Const MF_BYPOSITION = &H400&

Sub picStrech(ByVal picbox As PictureBox)
If picbox.Picture = 0 Then
MsgBox "Please Load A Image", vbCritical, "No Image"
Else
    picbox.ScaleMode = 3
    picbox.AutoRedraw = True
    picbox.PaintPicture picbox.Picture, 0, 0, picbox.ScaleWidth, picbox.ScaleHeight, 0, 0, picbox.Picture.Width / 26.46, picbox.Picture.Height / 26.46
    picbox.Picture = picbox.Image
End If
End Sub
Private Sub MenuIcons(ByVal menuindex As Integer, ByVal submenuindex As Integer, ByVal myicon As PictureBox)
On Error Resume Next
Dim hMenu As Long
Dim hSubMenu As Long
Dim Ret As Long
   hMenu = GetMenu(hwnd)
   hSubMenu = GetSubMenu(hMenu, menuindex)
   Ret = SetMenuItemBitmaps(hSubMenu, submenuindex, MF_BYPOSITION, myicon, myicon)
End Sub

Private Sub Form_Load()
Picture1.Picture = LoadPicture("D:\User Profile\Desktop\GCF\Data\Css\game.ico")
picStrech Picture1
MenuIcons 0, 0, Picture1
MenuIcons 1, 3, Picture1
End Sub