GDI绘图相关,不希望使用ShowTNImg(PBox As Object)如何实现?
原码如下,但它要调用一个窗口的picturebox的控件进行输出,希望在内存里的API直接输出,然后可以把内存保存为一个文件.
窗口文件中,建好一个picture2的图片控件.
然后调用
CALL ShowTNImg(picture2,文件路径,宽度,高度)
由于要做成DLL,希望能在内存中虚拟一个picture的图片控件,但总是出错.
'----------------------------------
'----------------------------------
'----------------使用者请保留作者版权----------------------------------
'-- 作者:BEAR-BEN ---------------------------------------------------
'-- QQ:453628001 ----------------------------------------------------
'-- 天才动力 --- GENIUS POWER ---------------------------------------
'-- WebSite:www.tcdongli.com ----------------------------------------
'----------------------------------
'----------------------------------
'****************模块
Public Type ImageInfo
Height As Long
Width As Long
FilePath As String
ImageName As String
type As String
FileSize As Long 'KB
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Enum GpStatus 'Status
Oka = 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 GdipDrawImage Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal X As Single, ByVal Y As Single) 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
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 GdipDrawImageRectI Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long) As GpStatus
Dim gdip_Token As Long
Dim gdip_Image As Long
Dim gdip_Graphics As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
''Private Declare Function GetObj Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
'Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
' Private Type Bitmap '14 bytes
' bmType As Long
' bmWidth As Long
' bmHeight As Long
' bmWidthBytes As Long
' bmPlanes As Integer
' bmBitsPixel As Integer
' bmBits As Long
' End Type
'-------------缩略图函数-----------
Public Function ShowTNImg(PBox As Object, ImagePath As String, WMax As Long, HMax As Long) As ImageInfo
'WMax为最大宽度，HMax为最大高度，这段代码会根据最大宽度和高度调整图片大小。
Dim Wid As Long, Hgt As Long, Top As Long, Left 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
'获取图片长和宽
GdipGetImageWidth gdip_Image, Wid
GdipGetImageHeight gdip_Image, Hgt
With ShowTNImg
.Width = Wid
.Height = Hgt
.FilePath = ImagePath
.FileSize = FileLen(ImagePath) / 1024
.ImageName = Right(ImagePath, Len(ImagePath) - InStrRev(ImagePath, "\"))
.type = Right(ImagePath, Len(ImagePath) - InStrRev(ImagePath, "."))
End With
'智能调整图片大小和留空处理，根据最长边调整
If (Wid > WMax) Or (Hgt > HMax) Then
If Wid > Hgt Then
Hgt = Hgt / Wid * WMax
Wid = WMax
Top = (HMax - Hgt) / 2
Else
Wid = Wid / Hgt * HMax
Hgt = HMax
Left = (WMax - Wid) / 2
End If
Else
Top = (HMax - Hgt) / 2
Left = (WMax - Wid) / 2
End If
If WMax > Left And Left <= 0 Then Left = 0
If HMax > Top And Top <= 0 Then Top = 0
If GdipDrawImageRect(gdip_Graphics, gdip_Image, tw, th, bw, bh) <> Ok Then Debug.Print "显示失败。。。"
DisposeGDIP
End Function
'加载显示完整图片
Public Sub ShowFullImg(PBox As PictureBox, ImagePath As String)
LoadGDIP
If GdipCreateFromHDC(PBox.hDC, gdip_Graphics) <> Ok Then
MsgBox "出现错误！", vbCritical, "错误"
GdiplusShutdown gdip_Token
End
End If
GdipLoadImageFromFile StrConv(ImagePath, vbUnicode), gdip_Image
If GdipDrawImage(gdip_Graphics, gdip_Image, 0, 0) <> 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+失败！", vbCritical, "加载错误"
End
End If
End Sub
Public Sub DisposeGDIP()
GdipDisposeImage gdip_Image
GdipDeleteGraphics gdip_Graphics
GdiplusShutdown gdip_Token
End Sub
[解决办法]
哥顶你,不让你溺水
