I have found many ways to load images in formats such as PNG, and I don't know which one is the fastest. Interested friends can test it out.
ShowPicStream.cls
Code:
Dim Gdi1 As New ShowPicStream
Private Sub Command1_Click()
Picture1.AutoRedraw = True
Dim Buffer() As Byte
Gdi1.CreateGraphics Picture1.hDC
Gdi1.GetFileByte app.path & "\01_alpha-big.png", Buffer
Gdi1.ShowPicFromStream Buffer
Picture1.Refresh
End SubCode:
Option Explicit
Const OK As Long = 0
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
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 Declare Function GdipSetSmoothingMode Lib "gdiplus" (ByVal Graphics As Long, ByVal SmoothingMd As SmoothingMode) As Long
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 Long
Private Declare Function GdipDrawImage Lib "gdiplus" (ByVal Graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
Private Declare Sub CreateStreamOnHGlobal Lib "ole32.dll" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ByRef ppstm As Any)
Private Declare Function GdipLoadImageFromStreamAPI Lib "gdiplus" Alias "GdipLoadImageFromStream" (ByVal stream As Any, Image As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal Graphics As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, Graphics As Long) As Long
Dim lngGraphics As Long, mToken As Long
Private Sub Class_Initialize()
InitGdiplus
End Sub
Sub ShowPicFromStream(ByteArr() As Byte, Optional x As Long, Optional y As Long, Optional W As Long, Optional H As Long, Optional ResSize As Long, Optional ByVal ResType As String = "CUSTOM")
Dim Image As Long
Call GdipSetSmoothingMode(lngGraphics, 4) 'SmoothingModeAntiAlias=4
Image = GdipCreateImageFromStream(ByteArr)
If W = 0 Then
Call GdipDrawImage(lngGraphics, Image, x, y)
Else
GdipDrawImageRect lngGraphics, Image, x, y, W, H
End If
Call GdipDisposeImage(Image)
End Sub
Function GdipCreateImageFromStream(PicFileByte() As Byte) As Long
Dim Image As Long
Dim IStream As Object
Dim hGlobal As Long
Dim pMem As Long
hGlobal = VarPtr(PicFileByte(0))
Call CreateStreamOnHGlobal(hGlobal, False, IStream)
Call GdipLoadImageFromStreamAPI(IStream, Image)
Set IStream = Nothing
GdipCreateImageFromStream = Image
End Function
Sub InitGdiplus()
Dim uInput As GdiplusStartupInput
Dim ret As Long
uInput.GdiplusVersion = 1
ret = GdiplusStartup(mToken, uInput)
If ret <> OK Then
MsgBox "err gdiplus"
End If
End Sub
Sub CreateGraphics(hDC As Long)
Call GdipCreateFromHDC(hDC, lngGraphics)
End Sub
Sub DeleteGraphics()
GdipDeleteGraphics lngGraphics
lngGraphics = 0
End Sub
Sub GetFileByte(Path As String, Data() As Byte)
On Error GoTo ErrFC
Dim FreeF As Integer, Len1 As Long
FreeF = FreeFile
Open Path For Binary Access Read As #FreeF
Len1 = LOF(FreeF)
If Len1 > 0 Then
ReDim Data(0 To Len1 - 1) As Byte
Get #FreeF, , Data
End If
Close #FreeF
If Len1 = 0 Then ReDim Data(-1 To -1)
Exit Sub
ErrFC:
ReDim Data(-1 To -1)
End Sub
Private Sub Class_Terminate()
If lngGraphics <> 0 Then DeleteGraphics
GdiplusShutdown mToken
End Sub