Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: Harmmy en Diciembre 16, 2012, 12:34:31 pm
-
Hello firends.
Visual basic 6 : LoadImageStream Function And sample project could you give
Thank you in advance
-
Hello, I give an example using GDI + to also be able to read PNG
Option Explicit
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GdiPlus.dll" (ByVal mBitmap As Long, ByRef mHbmReturn As Long, ByVal mBackground As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef Token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal Token As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipGetImageDimension Lib "gdiplus" (ByVal Image As Long, ByRef Width As Single, ByRef Height As Single) As Long
Private Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As Any, ByRef Image As Long) As Long
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Sub CreateStreamOnHGlobal Lib "ole32.dll" (ByRef hGlobal As Any, ByVal fDeleteOnRelease As Long, ByRef ppstm As Any)
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Type GDIPlusStartupInput
GdiPlusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Const GdiPlusVersion As Long = 1&
Private GdipToken As Long
Private ArrImage() As Byte
Public Function GetStdPictureFromStream(ByRef bvData() As Byte, Optional oBackColor As Long = vbButtonFace) As StdPicture
Dim hImage As Long
Dim hBitmap As Long
Dim lBackColor As Long
If Not IsArrayDim(VarPtrArray(bvData)) Then Exit Function
Call InitGDI
ArrImage = bvData '<-----this is optional, if the image are need preserve, in this case is not necessary, because the hImage is release in the end function
If LoadImageFromStream(ArrImage, hImage) Then
OleTranslateColor oBackColor, 0, lBackColor
If GdipCreateHBITMAPFromBitmap(hImage, hBitmap, lBackColor) = 0 Then
Set GetStdPictureFromStream = CreateBitmapPicture(hBitmap, 0&)
End If
GdipDisposeImage hImage
End If
Call TerminateGDI
End Function
Private Function LoadImageFromStream(ByRef bvData() As Byte, ByRef hImage As Long) As Boolean
On Local Error GoTo LoadImageFromStream_Error
Dim IStream As IUnknown
Call CreateStreamOnHGlobal(bvData(0), 0&, IStream)
If Not IStream Is Nothing Then
If GdipLoadImageFromStream(IStream, hImage) = 0 Then
LoadImageFromStream = True
End If
End If
Set IStream = Nothing
LoadImageFromStream_Error:
End Function
Private Sub InitGDI()
Dim GdipStartupInput As GDIPlusStartupInput
GdipStartupInput.GdiPlusVersion = GdiPlusVersion
Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0&)
End Sub
Private Sub TerminateGDI()
If GdipToken <> 0 Then Call GdiplusShutdown(GdipToken)
End Sub
Private Function IsArrayDim(ByVal lpArray As Long) As Boolean
Dim lAddress As Long
Call CopyMemory(lAddress, ByVal lpArray, &H4)
IsArrayDim = Not (lAddress = 0)
End Function
Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
Dim Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With Pic
.Size = Len(Pic)
.Type = vbPicTypeBitmap
.hBmp = hBmp
.hPal = hPal
End With
Call OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
Set CreateBitmapPicture = IPic
End Function
Private Sub Form_Load()
Dim ArrImage() As Byte
Open "C:\Users\Windows\Desktop\Bar0.png" For Binary As #1
ReDim ArrImage(LOF(1) - 1)
Get #1, , ArrImage
Close #1
Me.Picture = GetStdPictureFromStream(ArrImage)
End Sub
is just an example, you can improve for your needs.
-
Que bueno esta esto Leandro hay alguna manera de cargar varios iconos al mismo tiempo.
Algo asi:
Private Sub Form_Load()
Command1.Picture = LoadPicture(App.Path & "\1.png")
Command2.Picture = LoadPicture(App.Path & "\2.png")
Command3.Picture = LoadPicture(App.Path & "\3.png")
Command4.Picture = LoadPicture(App.Path & "\4.png")
End Sub
-
really thanks very good :) very thanks