Чтение png - VB

Узнай цену своей работы

Формулировка задачи:

В общем, беда.. есть куча нужных для программы картинок... вот только все они в формате png... при открытии которого, вб выдает ошибку инвалид пикчер... можно ли как-нибудь сразу все картинки перевести в jpg? или, незнаю, научить бейсик их открывать)) в ручную каждую картинку - не вариант... их больше 100..

Решение задачи: «Чтение png»

textual
Листинг программы
Option Explicit
 
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 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 OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) 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
 
Public Function LoadPictureEx(FileName As String) As StdPicture
    Dim Pic As PicBmp
    Dim IPic As IPicture
    Dim IID_IDispatch As GUID
    Dim SI As GdiplusStartupInput
    Dim token As Long
    Dim bmp As Long
    Dim hBmp As Long
    
    SI.GdiplusVersion = 1
    
    If GdiplusStartup(token, SI) Then Exit Function
    If GdipCreateBitmapFromFile(StrPtr(FileName), bmp) = 0 Then
        If GdipCreateHBITMAPFromBitmap(bmp, hBmp, vbBlack) = 0 Then
            GdipDisposeImage (bmp)
        End If
        GdiplusShutdown token
    Else
        GdiplusShutdown token
    End If
    
    With IID_IDispatch
       .Data1 = &H20400
       .Data4(0) = &HC0
       .Data4(7) = &H46
    End With
    With Pic
       .size = Len(Pic)          ' Length of structure.
       .Type = vbPicTypeBitmap   ' Type of Picture (bitmap).
       .hBmp = hBmp              ' Handle to bitmap.
       .hpal = 0
    End With
    
    OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic
    
    Set LoadPictureEx = IPic
End Function

Оцени полезность:

10   голосов , оценка 3.5 из 5
Похожие ответы