'声明略
Public Function ResizePic(ByVal sFromFile As String, ByVal sSaveToFile As String, Optional ByVal Quality As Byte = 80) As Boolean
    Dim tSI As GdiplusStartupInput
    Dim lRes As Long
    Dim lGDIP As Long
    Dim lBitmap As Long
    Dim img As Long    '初始化 GDI+
    tSI.GdiplusVersion = 1
    lRes = GdiplusStartup(lGDIP, tSI, 0)    If lRes = 0 Then
        '从文件创建 GDI+ 图像
        GdipLoadImageFromFile StrPtr(sFromFile), lBitmap        If lRes = 0 Then
        
            Dim graphics As Long
            
            GdipCreateFromHDC frmMain!picSmall.hDC, graphics
            
            '运行完下面的这句代码后,在窗体中可以看到picSmall中成功绘制了缩小的图片
            GdipDrawImageRect graphics, lBitmap, 0, 0, frmMain!picSmall.ScaleWidth, frmMain!picSmall.ScaleHeight
            
            GdipCreateBitmapFromGraphics frmMain!picSmall.ScaleWidth, frmMain!picSmall.ScaleHeight, graphics, img
            GdipDrawImageRectI graphics, lBitmap, 0, 0, frmMain!picSmall.ScaleWidth, frmMain!picSmall.ScaleHeight
            
            Dim tJpgEncoder As Guid
            Dim tParams As EncoderParameters            '初始化解码器的GUID标识
            CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder            '设置解码器参数
            tParams.count = 1
            With tParams.Parameter ' Quality
                '得到Quality参数的GUID标识
                CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .Guid
                .NumberOfValues = 1
                .type = 4
                .value = VarPtr(Quality)
            End With            '保存图像
            lRes = GdipSaveImageToFile(img, StrPtr(sSaveToFile), tJpgEncoder, tParams)            '销毁GDI+图像
            GdipDisposeImage lBitmap
            GdipDisposeImage img
            GdipDeleteGraphics graphics '释放graphics占用的内存
        End If        '销毁 GDI+
        GdiplusShutdown lGDIP
    End If    If lRes Then
        ResizePic = False
    Else
        ResizePic = True
    End If
End Function
用上面的函数无法保存调整大小后的图片,即只能保存一张全黑的图片,我对GDI+基本一窍不通,今下午研究了老半天了也没头绪,请朋友们指点一下迷津,谢谢!

解决方案 »

  1.   

    下面是我改过的代码,有相同疑问的朋友们可以参考一下,也许还有更好的方法,请高手指正:
    Public Sub ResizePic(pic As PictureBox, ByVal sFromFile As String, ByVal sSaveToFile As String, Optional ByVal Quality As Byte = 100)
        Dim tSI As GdiplusStartupInput
        Dim lRes As Long
        Dim lGDIP As Long
        Dim lBitmap As Long
        Dim img As Long
        
        '初始化 GDI+
        tSI.GdiplusVersion = 1
        lRes = GdiplusStartup(lGDIP, tSI, 0)    If lRes = 0 Then
            '创建 GDI+ 图像
            GdipLoadImageFromFile StrPtr(sFromFile), lBitmap        If lRes = 0 Then
            
                Dim graphics As Long
                
                'GdipCreateFromHWND pic.Image.Handle, graphics
                GdipCreateFromHDC pic.hDC, graphics
                
                GdipDrawImageRect graphics, lBitmap, 0, 0, pic.ScaleWidth, pic.ScaleHeight
                
                GdipCreateBitmapFromHBITMAP pic.Image.Handle, 0, img
                
                Dim tJpgEncoder As Guid
                Dim tParams As EncoderParameters            '初始化解码器的GUID标识
                CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder            '设置解码器参数
                tParams.count = 1
                With tParams.Parameter ' Quality
                    '得到Quality参数的GUID标识
                    CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .Guid
                    .NumberOfValues = 1
                    .type = 4
                    .value = VarPtr(Quality)
                End With            '保存图像
                lRes = GdipSaveImageToFile(img, StrPtr(sSaveToFile), tJpgEncoder, tParams)            '销毁GDI+图像
                GdipDisposeImage lBitmap
                GdipDisposeImage img
                GdipDeleteGraphics graphics '释放graphics占用的内存
            End If        '销毁 GDI+
            GdiplusShutdown lGDIP
        End IfEnd Sub