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,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+失败!","加载错误"
- End
- End If
- End Sub
- Public Sub DisposeGDIP()
- GdipDisposeImage gdip_Image
- GdipDeleteGraphics gdip_Graphics
- GdiplusShutdown gdip_Token
- End Sub