7,765
社区成员
发帖
与我相关
我的任务
分享
Public Sub PreviewfromGdi(TempPaintvalue As Single, Temphidepicture As PictureBox, Tempshowpicture As PictureBox) '缩放图像
Dim GpInput As GdiplusStartupInput
Dim TempIm As Long
Dim TempGp As Long
Dim HdcScreen As Long
Dim hBitmap As Long
Dim HdcMem As Long
Dim Ret As Long
DeleteDC HdcMem
HdcScreen = GetDC(0) ' DC
HdcMem = CreateCompatibleDC(HdcScreen) ' 建立 DC
hBitmap = CreateCompatibleBitmap(HdcScreen, Temphidepicture.Width * TempPaintvalue, Temphidepicture.Height * TempPaintvalue) ' 建立点阵图
Ret = SelectObject(HdcMem, hBitmap) ' hDCMem
Rectangle HdcMem, 0, 0, Temphidepicture.Width * TempPaintvalue, Temphidepicture.Height * TempPaintvalue
GpInput.GdiplusVersion = 1
If GdiplusStartup(Gdip_Token, GpInput) <> Ok Then
MsgBox "Error loading GDI+!", vbCritical
Exit Sub
End If
Call GdipCreateFromHDC(HdcMem, TempGp) '获取Graphics对象的句柄MyG,与Picture绑定
Temphidepicture.AutoSize = True
Call GdipCreateBitmapFromHBITMAP(Temphidepicture.Picture.Handle, 0, TempIm) '得到一个image对象
GdipSetInterpolationMode TempGp, 7 'SMC_HighQualityBicubic,设置压缩质量
Call GdipDrawImageRectI(TempGp, TempIm, 0, 0, Temphidepicture.Width * TempPaintvalue, Temphidepicture.Height * TempPaintvalue)
BitBlt Tempshowpicture.hDC, 0, 0, Tempshowpicture.Width, Tempshowpicture.Height, HdcMem, (Temphidepicture.Width * TempPaintvalue - Tempshowpicture.Width) / 2, (Temphidepicture.Height * TempPaintvalue - Tempshowpicture.Height) / 2, vbSrcCopy '从内寸复制到图片框,居中
Call GdipDisposeImage(TempIm) '/////当不需要image对象的时候需要释放
Call GdipDeleteGraphics(TempGp) '释放Graphics
Call GdiplusShutdown(Gdip_Token) '关闭GDI+
DeleteDC HdcScreen
DeleteObject hBitmap
End Sub
API声明自己找:)