Блок для загрузки PNG-Portable Network Graphics
Создаем модуль класса с именем PNG 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 GdipLoadImageFromFile Lib "GDIPlus" (ByVal filename As String, 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 GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As GpStatus Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) 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 GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long Private Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End Type Private Enum GpStatus Ok = 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Const DIB_RGB_COLORS As Long = 0 Private Const AC_SRC_ALPHA As Long = &H1 Private Const AC_SRC_OVER = &H0 Private Type BLENDFUNCTION BlendOp As Byte BlendFlags As Byte SourceConstantAlpha As Byte AlphaFormat As Byte End Type Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUAD End Type Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByRef lplpVoid As Any, ByVal handle As Long, ByVal dw As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long) Dim blendFunc32bpp As BLENDFUNCTION Dim cloudDC As Long Dim cloudBMP As Long Dim lbf As Long Dim token As Long Dim go As Boolean Dim GpInput As GdiplusStartupInput 'К Make Dim lngHeight As Long Dim lngWidth As Long Public Sub ReLoad(File As String, Alpha) GpInput.GdiplusVersion = 1 GdiplusStartup token, GpInput MakeTrans File, Alpha End Sub Private Function MakeTrans(pngPath As String, Alpha) Dim tempBI As BITMAPINFO Dim img As Long Dim graphics As Long With tempBI.bmiHeader .biSize = 40 .biBitCount = 32 .biHeight = Form1.ScaleHeight .biWidth = Form1.ScaleWidth .biPlanes = 1 .biSizeImage = .biWidth * .biHeight * (.biBitCount / 8) End With cloudDC = CreateCompatibleDC(Form1.hdc) cloudBMP = CreateDIBSection(cloudDC, tempBI, DIB_RGB_COLORS, ByVal 0, 0, 0) SelectObject cloudDC, cloudBMP Call GdipCreateFromHDC(cloudDC, graphics) Call GdipLoadImageFromFile(StrConv(pngPath, vbUnicode), img) Call GdipGetImageHeight(img, lngHeight) Call GdipGetImageWidth(img, lngWidth) Call GdipDrawImageRect(graphics, img, 0, 0, lngWidth, lngHeight) With blendFunc32bpp .AlphaFormat = AC_SRC_ALPHA .BlendFlags = 0 .BlendOp = AC_SRC_OVER .SourceConstantAlpha = Alpha End With RtlMoveMemory lbf, blendFunc32bpp, 4 End Function Public Sub render(X As Single, Y As Single, Pic As Object) AlphaBlend Pic.hdc, X - lngWidth / 2, Y - lngHeight, 200, 200, cloudDC, 0, 0, 200, 200, lbf End Sub Public Sub STOPSESSION() DeleteObject (cloudBMP): DeleteObject (cloudDC) GdiplusShutdown (token) End Sub Использование модуля класса PNG Dim V As New PNG Private Sub Form_Load() V.ReLoad "Апельсин\1.png", 255 End Sub Private Sub Timer1_Timer() gamep.Cls V.render 100, 100, gamep End Sub Private Sub Form_Unload(Cancel As Integer) V.STOPSESSION End Sub где gamep - PictureBox  | |
| Просмотров: 1571 | Комментарии: 1 | |
| Всего комментариев: 0 | |