Сжатие, изменение размеров изображений - VB

Формулировка задачи:

Всем привет! Помогите разобраться как сжать изображение, т.е. есть рисунок безумного размера (к примеру 6000*4000 ) как его подогнать под квадратный

PictureBox

? Так же интересует выбор определенной области изображения для сохранения. А в идеале может есть специальная форма, на которую можно загрузить изображение и затем сохранить только определенную область (ну знаете как выбор аватарки в контакте: выбираешь фотку и потом перетягиваешь специальный квадратик для выбора определенной части изображения)?

Решение задачи: «Сжатие, изменение размеров изображений»

textual
                            Листинг программы 
                        
 
                            
                        
Option Explicit
 
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Type PicBmp
    size As Long
    Type As Long
    hBmp As Long
    hpal As Long
    Reserved As Long
End Type
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
 
Public Function Conv(hBmp As Long) As StdPicture
    Dim Pic As PicBmp
    Dim IID_IDispatch As GUID
    With IID_IDispatch
       .Data1 = &H20400
       .Data4(0) = &HC0
       .Data4(7) = &H46
    End With
    With Pic
       .size = Len(Pic)
       .Type = vbPicTypeBitmap
       .hBmp = hBmp
    End With
    OleCreatePictureIndirect Pic, IID_IDispatch, 1, Conv
End Function
Private Sub imgPic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim d As Single, w As Long, h As Long, ohBmp As Long, hBmp As Long, DC As Long, p As IPicture
    If Button = vbLeftButton Then d = 1.5 Else d = 0.66
        w = ScaleX(imgPic.Picture.Width, vbHimetric, vbPixels) * d
        h = ScaleY(imgPic.Picture.Height, vbHimetric, vbPixels) * d
        If w > 0 And h > 0 Then
        imgPic.Width = w: imgPic.Height = h
        DC = CreateCompatibleDC(Me.hdc)
        hBmp = CreateCompatibleBitmap(Me.hdc, w, h)
        ohBmp = SelectObject(DC, hBmp)
        Set p = imgPic.Picture
        p.Render DC, 0, 0, w, h, 0, imgPic.Picture.Height, imgPic.Picture.Width, -imgPic.Picture.Height, ByVal 0
        SelectObject DC, ohBmp
        DeleteDC DC
        Set imgPic.Picture = Conv(hBmp)
        Me.Width = (Me.Width / Screen.TwipsPerPixelX - Me.ScaleWidth + w + imgPic.Left * 2) * Screen.TwipsPerPixelX
        Me.Height = (Me.Height / Screen.TwipsPerPixelY - Me.ScaleHeight + h + imgPic.Top * 2) * Screen.TwipsPerPixelY
    End If
End Sub