VB6添加PNG图片

Posted 2023-05-16

窗体Image要显示半透明的图像，而ICO必须是32位的，VB6不支持，所以就剩下PNG了。。可PNG又不支持VB6。怎么办让VB6添加PNG图像，或者，怎样使这个控件半透明？分不是问题！

vb要显示透明png，gdi+是最好的办法了，它支持半透明。但是，要下载gdiplus.tlb( http://www.vbaccelerator.com/article.asp?id=4588外国网站)并且引用才行。如果引用了gdiplus.tlb ，那么可以使用下面的代码。Private TOKEN As Long
Private Graphics As Long Private Sub InitGDIPlus()
'初始化GDI+
Dim uInput As GdiplusStartupInput

uInput.GdiplusVersion = 1
If GdiplusStartup(TOKEN, uInput) <> Ok Then
'初始化错误
MsgBox "GDI+ 初始化错误。程序即将关闭。", vbCritical, "InitError"
End
End If
GdipCreateFromHDC Me.hDC, Graphics
GdipSetSmoothingMode Graphics, SmoothingModeAntiAlias
End Sub
Private Sub Form_Load()
InitGDIPlus Dim image As Long GdipCreateBitmapFromFile "E:\image1.png", image
GdipDrawImage Graphics, image, 0, 0
GdipDisposeImage image
End Sub
Private Sub TerminateGDIPlus()
GdipDeleteGraphics Graphics '释放graphics占用的内存
GdiplusShutdown TOKEN '关闭GDI+
End Sub
Private Sub Form_Unload(Cancel As Integer)
TerminateGDIPlus
End Sub看看flash控件那种完美的半透明效果，谁说做不了，不过我也不懂。哎，如果实在没招，用个flash也不错。 参考技术A 半透明的？好像只有窗体才可以吧，一般做半透明的效果我用PS做。VB做透明效果，窗体透明，那么控件也跟着窗体透明而透明的。 参考技术B 控件不能半透明,因为没有扩展消息

VB如何使用PNG图片

我用了GIF控件,会把PNG图片上的透明状态破坏,把图片改成别的格式也是如此

请问能告诉我像picturebox一样方便的方法吗？
非常感谢！
看了你的问题，你回答说你已经知道像picturebox一样方便的方法了
是怎么弄的啊？或者说把PNG图片怎么处理
反正跟你的问题一样背景要透明
麻烦你告诉我弄下，Thanks.

picturebox控件好像不能显示空白背景（.gif.png等），只有image可以加载gif的图片可以使图片透明。image好像不能加载png的图片。追问

那请问有什么办法加载PNG图片么？我用的是精简版，没有控件！

追答

估计没有

参考技术A API 加载 loadimage 参考技术B PNG貌似不可以，我也没能成功 应用 参考技术C Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

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 Long
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, _
hbmReturn As Long, ByVal background As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, _
RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

Public Function LoadImage(ByVal strFName As String) As IPicture
Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As Long
Dim hGdiImage As Long
Dim hBitmap As Long

uGdiInput.GdiplusVersion = 1

If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
Set LoadImage = ConvertToIPicture(hBitmap)
GdipDisposeImage hGdiImage
End If
GdiplusShutdown hGdiPlus
End If

End Function

Public Function ConvertToIPicture(ByVal hPic As Long) As IPicture

Dim uPicInfo As PICTDESC
Dim IID_IDispatch As GUID
Dim IPic As IPicture

Const PICTYPE_BITMAP = 1

With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With

With uPicInfo
.Size = Len(uPicInfo)
.Type = PICTYPE_BITMAP
.hPic = hPic
.hPal = 0
End With

OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic

Set ConvertToIPicture = IPic
End Function