vb 制作高质量缩略图?

Question

想对一些图像做缩略图.用PaintPicture方法图象失真得很厉害.有谁有好一点的办法啊?
在网上看到过有人用GDI+做的缩略图,很漂亮,不知道谁有这方面的研究或代码,指导一下.

Answer 1

http://hi.baidu.com/overown/blog/item/41a24490e1638189a877a46d.html
参考

Answer 2

'模块部分
Option ExplicitPrivate Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End TypePrivate 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 EnumPrivate 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 GpStatusPrivate Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As LongDim gdip_Token As Long
Dim gdip_Image As Long
Dim gdip_Graphics As Long'-------------缩略图函数-----------
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 SubPublic Sub LoadGDIP()
    Dim GpInput As GdiplusStartupInput
    GpInput.GdiplusVersion = 1
    If GdiplusStartup(gdip_Token, GpInput) <> 0 Then
        MsgBox "加载GDI+失败！", vbCritical, "加载错误"
        End
    End If
End SubPublic Sub DisposeGDIP()
    GdipDisposeImage gdip_Image
    GdipDeleteGraphics gdip_Graphics
    GdiplusShutdown gdip_Token
End SubPublic Sub ShowIco(PBox As Object, ImagePath As String, WidthMax As Long, HeightMax As Long)
    Dim hIco As Long
    
    hIco = ExtractIcon(0, ImagePath, 0)
    DrawIcon PBox.hdc, 44, 29, hIco
    DestroyIcon hIco
End Sub

Answer 3

凋用
ShowTNImg Picture1, filepath, Picture1.Width, Picture1.Height第一个参数为PICTURE控件，第二个参数图片文件全路径，第三个参数缩略图宽度，第四个参数缩略图高度

Answer 4

非常感谢.在laviewpbt的指导下,成功实现.呵呵!
也感谢楼上贴的代码,代码实现过程基本差不多.就此结贴.