VB中使用GDI+进行图像缩放的实例

精选转载

yygll123 2014-02-06 07:36:22

VISUAL BASIC（VB）对图形图像的处理一直以来是弱项，并受到很多人的垢病。关于图形图像的放大缩小，一般使用PICTUREBOX的PAINTPICTURE方法来处理。但这个处理方法最大的问题就是图像的失真。比方说图像中原来有网格线的，处理以后网格线会丢失，处理效果不好。后来在网上找到几个材料，是关于GDI+的用法的。试验了一下，果然效果非凡。以下为程序处理的关键代码：

Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long                                      
    SuppressExternalCodecs As Long
End Type
Private Enum GpStatus  'Status
    Ok = 0
    GenericError = 1
    InvalidParameter = 2
    OutOfMemory = 3
    ObjectBusy = 4
    InsufficientBuffer = 5
    NotImplemented = 6
    Win32Error = 7
    WrongState = 8
    Aborted = 9
    FileNotFound = 10
    ValueOverflow = 11
    AccessDenied = 12
    UnknownImageFormat = 13
    FontFamilyNotFound = 14
    FontStyleNotFound = 15
    NotTrueTypeFont = 16
    UnsupportedGdiplusVersion = 17
    GdiplusNotInitialized = 18
    PropertyNotFound = 19
    PropertyNotSupported = 20
End Enum
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As GpStatus
Private Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal X As Single, ByVal Y As Single, ByVal Width As Single, ByVal Height As Single) As GpStatus
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, graphics As Long) As GpStatus
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, Image As Long) As GpStatus
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As GpStatus
Dim gdip_Token As Long
Dim gdip_Image As Long
Dim gdip_Graphics As Long
'--------------------------------------
'-- 使用者请保留作者版权
'--  作者:BEAR-BEN
'--  QQ:453628001
'--------------------------------------
'-------------缩略图函数-----------
Public Sub ShowTNImg(PBox As Object, ImagePath As String, WidthMax As Long, HeightMax As Long)
    LoadGDIP
    If GdipCreateFromHDC(PBox.hDC, gdip_Graphics) <> 0 Then
        MsgBox "出现错误！", vbCritical, "错误"
        GdiplusShutdown gdip_Token
        End
    End If
    '载入图片到内存中
    GdipLoadImageFromFile StrConv(ImagePath, vbUnicode), gdip_Image
    '使用GDI+直接从内存中缩略并绘图，GDI+有很好的反锯齿能力
    If GdipDrawImageRect(gdip_Graphics, gdip_Image, 0, 0, WidthMax, HeightMax) <> Ok Then Debug.Print "显示失败。。。"
    DisposeGDIP
End Sub
Public Sub LoadGDIP()
    Dim GpInput As GdiplusStartupInput
    GpInput.GdiplusVersion = 1
    If GdiplusStartup(gdip_Token, GpInput) <> 0 Then
        MsgBox "加载GDI+失败！", vbCritical, "加载错误"
        End
    End If
End Sub
Public Sub DisposeGDIP()
    GdipDisposeImage gdip_Image
    GdipDeleteGraphics gdip_Graphics
    GdiplusShutdown gdip_Token
End Sub