'加载并打开资源文件,点击"添加自定义资源",添加一个PNG文件,保存。
'在代码编辑窗口复制粘贴以下代码,按F5运行后鼠标点击窗口即可显示资源文件中的PNG文件
Option Explicit
Private Enum GpStatus
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 Enum QualityMode
QualityModeInvalid = -1
QualityModeDefault = 0
QualityModeLow = 1
QualityModeHigh = 2
End Enum
Private Enum SmoothingMode
SmoothingModeInvalid = QualityModeInvalid
SmoothingModeDefault = QualityModeDefault
SmoothingModeHighSpeed = QualityModeLow
SmoothingModeHighQuality = QualityModeHigh
SmoothingModeNone
SmoothingModeAntiAlias
End Enum
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
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 Sub CreateStreamOnHGlobal Lib “ole32.dll” (ByRef hGlobal As Any, ByVal fDeleteOnRelease As Long, ByRef ppstm As Any)
Private Declare Function GdipLoadImageFromStream Lib “gdiplus” (ByVal Stream As Any, ByRef Image As Long) As Long
Private Declare Function GdipGetImageWidth Lib “gdiplus” (ByVal Image As Long, Width As Long) As GpStatus
Private Declare Function GdipGetImageHeight Lib “gdiplus” (ByVal Image As Long, Height As Long) As GpStatus
Private Declare Function GdipCreateFromHDC Lib “gdiplus” (ByVal hdc As Long, Graphics As Long) As GpStatus
Private Declare Function GdipSetSmoothingMode Lib “gdiplus” (ByVal Graphics As Long, ByVal SmoothingMd As Long) As GpStatus
Private Declare Function GdipDrawImageRectRectI Lib “gdiplus” (ByVal Graphics As Long, ByVal hImage As Long, ByVal dstx As Long, ByVal dsty As Long, ByVal dstwidth As Long, ByVal dstheight As Long, ByVal srcx As Long, ByVal srcy As Long, ByVal srcwidth As Long, ByVal srcheight As Long, ByVal srcUnit As Long, Optional ByVal imageAttributes As Long = 0, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As Long
Private Declare Function GdipDisposeImage Lib “gdiplus” (ByVal Image As Long) As GpStatus
Private Declare Function GdipDeleteGraphics Lib “gdiplus” (ByVal Graphics As Long) As GpStatus
Private Const UnitPixel = 2
'开启/关闭GDI+
Private Function SwitchGDI(ByVal On_Off As Boolean) As GpStatus
Dim Token As Long, gdipInit As GdiplusStartupInput
Select Case On_Off
Case True
gdipInit.GdiplusVersion = 1
SwitchGDI = GdiplusStartup(Token, gdipInit, ByVal 0&)
Case False
GdiplusShutdown Token
End Select
End Function
'显示资源文件中的PNG(场景DC,左偏移X值,右偏移Y值,显示局部宽度,显示局部高度,资源文件的ID号,类型)
Private Function LoadPng(ByVal DC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal W1 As Long, ByVal H1 As Long, ByVal ImgID As Long, ByVal FileType As String) As Long
'参数是资源ID和类型
Dim Pimg As Long '图像句柄
Dim ImgW As Long, ImgH As Long '图像的宽度高度
Dim Graphics As Long
Dim ResData() As Byte, Stream As Object
On Error GoTo Nx
'加载资源文件到一个byte变量数组中
ResData = LoadResData(ImgID, FileType)
'从句柄中获取信息并保存在内存中进行处理
Call CreateStreamOnHGlobal(ResData(0), False, Stream)
'根据文件创建图片对象–流 Stream
Call GdipLoadImageFromStream(Stream, Pimg)
'获得图像宽度
Call GdipGetImageWidth(Pimg, ImgW)
'获得图像高度
Call GdipGetImageHeight(Pimg, ImgH)
'创建与指定设备上下文相关联的图像对象(Graphics)显示到设备上
Call GdipCreateFromHDC(Me.hdc, Graphics)
'设置图像对象的渲染质量(反锯齿)
Call GdipSetSmoothingMode(Graphics, SmoothingModeNone)
'在指定位置绘制图像。
Call GdipDrawImageRectRectI(Graphics, Pimg, X1, X1, W1, H1, 0, 0, ImgW, ImgH, UnitPixel, 0, 0, 0)
LoadPng = 1
Call GdipDisposeImage(Pimg)
Call GdipDeleteGraphics(Graphics)
Exit Function
Nx:
LoadPng = 0
Set Stream = Nothing
End Function
'鼠标点击窗口显示PNG
Private Sub Form_Click()
Me.Cls
Call LoadPng(Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 101, “CUSTOM”)
Me.Refresh
End Sub
'初始化
Private Sub Form_Load()
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
Call SwitchGDI(True) '初始化GDI+
End Sub
'退出窗口
Private Sub Form_Unload(Cancel As Integer)
Call SwitchGDI(False) '关闭GDI+
End Sub