Public Sub I_touxiang(ByVal file As String, ByVal Graphics As Long, Width As Long, Height As Long, Optional SavePath As String)

'做这个是因为昨天晚上雅铭居士的论坛登录器的有需要。一个利用GDI +制作的QQ头像效果

'By 2019.2.16 22:00 InkHin

Dim Bitmap As Long, bmW As Long, bmH As Long

Dim Brush As Long

Dim Path As Long

Dim newImg As Long, newGraphics As Long

Call GdipCreateBitmapFromFile(StrPtr(file), Bitmap)  '获取Bitmap

Call GdipGetImageWidth(Bitmap, bmW)  '得到Bitmap的尺寸

Call GdipGetImageHeight(Bitmap, bmH)

Call GdipCreateTexture2I(Bitmap, WrapModeTile, , , bmW, bmH, Brush) '

Call GdipCreateBitmapFromScan0(bmW, bmH, , PixelFormat32bppARGB, ByVal , newImg) '

Call GdipGetImageGraphicsContext(newImg, newGraphics) '

Call GdipGraphicsClear(newGraphics, &HFFFFFF) '

Call GdipSetSmoothingMode(Graphics, SmoothingModeAntiAlias)  '反锯齿

Call GdipCreatePath(FillModeAlternate, Path) '

Call GdipAddPathArcI(Path, , , bmW, bmH, , ) '

Call GdipFillPath(newGraphics, Brush, Path) '

Call GdipDrawImageRectI(Graphics, newImg, , , Width, Height)

If Not IsMissing(SavePath) Then
If SaveImageToPNG(newImg, SavePath) <>  Then MsgBox "保存失败。"
End If

'一堆删除

Call GdipDeleteGraphics(Graphics)

Call GdipDisposeImage(Bitmap)

Call GdipDeleteGraphics(newGraphics)

Call GdipDisposeImage(newImg)

Call GdipDeletePath(Path)

Call GdipDeleteBrush(Brush)

End Sub