cgdiplus.cls

很棒的网页音乐播放器,可以嵌入网页。界面很漂亮

    If Not hImg = 0& Then
        
        If GdipCreateFromHDC(hDC, hGraphics) = 0& Then   ' wrap GDI+ around our target DC
            
            If Not hGraphics = 0& Then
                
                ' Interpolation quality? There is a 3rd quality which falls between the following two. It is InterpolationModeHighQualityBilinear
                If highQuality = True Then
                    Call GdipSetInterpolationMode(hGraphics, InterpolationModeHighQualityBicubic)
                Else
                    Call GdipSetInterpolationMode(hGraphics, InterpolationModeNearestNeighbor)
                End If
                
                mirrorOffsetX = 1&                           ' angle rotation offset (X)
                If destHeight < 0& Then
                    destHeight = -destHeight                ' no flipping needed; bottom up dibs are flipped vertically naturally
                    mirrorOffsetY = -1&                      ' reverse angle rotation offset
                Else
                    mirrorROP = 6&                           ' flip vertically
                    mirrorOffsetY = 1&                       ' angle rotation offsets(Y)
                End If
                If destWidth < 0& Then
                    mirrorROP = mirrorROP Xor 4&             ' flip horizontally (mirror horizontally)
                    destWidth = -destWidth
                    mirrorOffsetX = -mirrorOffsetX          ' reverse angle rotation offset
                End If
                
                GdipImageRotateFlip hImg, mirrorROP         ' flip image as needed
                
                If Angle = 0& And Alpha = 100& Then ' no blending and no rotation being used

                    RenderGDIplus = (GdipDrawImageRectRectI(hGraphics, hImg, destX, destY, destWidth, destHeight, srcX, srcY, srcWidth, srcHeight, UnitPixel, hImgAttr, 0&, 0&) = 0&)
                
                Else ' we are blending and/or rotating
                    
                    If GdipCreateImageAttributes(hImgAttr) = 0 Then ' create image attributes for blending/rotating
                        ' Blending?
                        clrMatrix(0, 0) = 1
                        clrMatrix(1, 1) = 1
                        clrMatrix(2, 2) = 1
                        clrMatrix(3, 3) = CSng(Alpha / 100&) ' value between 0 & 1
                        clrMatrix(4, 4) = 1 ' required; cannot be anything else
                        
                        If GdipSetImageAttributesColorMatrix(hImgAttr, ColorAdjustTypeBitmap, -1&, clrMatrix(0, 0), clrMatrix(0, 0), 0&) = 0& Then
                            If Angle = 0& Then   ' blending, not rotating
                                RenderGDIplus = (GdipDrawImageRectRectI(hGraphics, hImg, destX, destY, destWidth, destHeight, srcX, srcY, srcWidth, srcHeight, UnitPixel, hImgAttr, 0&, 0&) = 0&)
                                
                            Else ' rotating & maybe blending... different coordinates system
                            
                                If GdipRotateWorldTransform(hGraphics, CSng(Angle + 180), 0&) = 0& Then
                                    GdipTranslateWorldTransform hGraphics, destX + (destWidth \ 2) * mirrorOffsetX, destY + (destHeight \ 2) * mirrorOffsetY, 1
                                End If
                                RenderGDIplus = (GdipDrawImageRectRectI(hGraphics, hImg, destWidth \ 2, destHeight \ 2, -destWidth, -destHeight, srcX, srcY, srcWidth, srcHeight, UnitPixel, hImgAttr, 0&, 0&) = 0&)
                            End If
                        End If
                        
                        GdipDisposeImageAttributes hImgAttr ' clean up
                        
                    End If
                End If
                    
                GdipDeleteGraphics hGraphics ' clean up
                
            End If
        End If
        
        GdipDisposeImage hImg   ' clean up
        
    End If
    
    Call InitializeGDIplus(gdiToken, True) ' terminate GDI+

End Function

Friend Function GDIplusLoadPNG(FileName As String, pngStream() As Byte, cHost As c32bppDIB) As Boolean
'Exit Function
    ' Purpose: Use GDI+ to load a PNG either by fileName or by array/stream
    ' FileName :: if vbNullString, then the pngStream() array contains the
    '   PNG file else FileName is full path & name of the PNG file
    
    Dim gdiToken As Long
    ' does the system have GDI+ on it?
    If iparseValidateDLL("gdiplus.dll", "GdiplusStartup") = False Then Exit Function
    If InitializeGDIplus(gdiToken, False) = False Then Exit Function
     
    Dim hImage As Long, hGraphics As Long
    Dim tDC As Long, lRtn As Long
    Dim rDimensions As RECTF, pStream As IUnknown
    
    On Error GoTo ExitRoutine
    
    If FileName = vbNullString Then ' we need an array vs file name
        ' hack of my own. Create an IUnknown Stream that has the same properties
        ' and minimum methods needed as the IStream interface which VB does not
        ' expose. Once the stream is created, we have GDI+ load from it
        Set pStream = CreateStream(pngStream())
        If Not pStream Is Nothing Then Call GdipLoadImageFromStream(pStream, hImage)

    Else    ' we use the passed file name; have GDI+ load the file
        Call GdipLoadImageFromFile(StrConv(FileName, vbUnicode), hImage)
    End If
    
    If Not hImage = 0& Then
        ' get size of PNG
        lRtn = GdipGetImageBounds(hImage, rDimensions, UnitPixel)
        If lRtn = 0& Then

            ' build 32bpp
            cHost.InitializeDIB CLng(rDimensions.nWidth), CLng(rDimensions.nHeight)

            ' wrap a GDI+ DC around our DIB's DC
            tDC = cHost.LoadDIBinDC(True)
            lRtn = GdipCreateFromHDC(tDC, hGraphics)
            If lRtn = 0& Then
                ' now draw the PNG into our 32bpp. GDI+ is nice enough to pre-multiply
                ' the RGB values for us during the rendering
                With rDimensions
                    GdipDrawImageRectRectI hGraphics, hImage, 0&, 0&, .nWidth, .nHeight, .nLeft, .nTop, .nWidth, .nHeight, UnitPixel, 0&, 0&, 0&
                End With
                GdipDeleteGraphics hGraphics    ' remove the GDI+ DC wrapper
                hGraphics = 0&
            End If
            cHost.LoadDIBinDC False ' unselect our DIB
        End If

        If lRtn = 0& Then                    ' return results
            GDIplusLoadPNG = True
            Call GdipGetImagePixelFormat(hImage, lRtn)
            GdipDisposeImage hImage             ' destroy the GDI+ image
            cHost.Alpha = (lRtn = PixelFormat32bppARGB Or lRtn = PixelFormat32bppPARGB)
            cHost.ImageType = imgPNG
        Else
            GdipDisposeImage hImage             ' destroy the GDI+ image
            cHost.DestroyDIB
        End If
        hImage = 0&
    End If
        
ExitRoutine:
    If Not gdiToken = 0& Then
        If Not hGraphics = 0& Then GdipDeleteGraphics hGraphics
        If Not hImage = 0& Then GdipDisposeImage hImage
        Call InitializeGDIplus(gdiToken, True)   ' stop GDI+
    End If
End Function


Friend Function MakeGrayScale(cHost As c32bppDIB, ByVal GrayScaleType As Long) As Boolean


    Dim gdiToken As Long
    If InitializeGDIplus(gdiToken, False) = False Then Exit Function

    Dim hImg         As Long
    Dim hGraphics As Long, hImgAttr As Long, tDC As Long
    Dim clrMatrix(0 To 4, 0 To 4) As Single
    
    ' have GDI+ create a DIB from our host pointer
    Call GdipCreateBitmapFromScan0(cHost.Width, cHost.Height, cHost.scanWidth, PixelFormat32bppPARGB, ByVal cHost.BitsPointer, hImg)
    
    If Not hImg = 0& Then
        GdipImageRotateFlip hImg, 6& ' flip vertically. Our DIBs are bottom up but that GDI+ function creates top down dibs
        
        tDC = cHost.LoadDIBinDC(True)   ' ensure we have a DC
        If GdipCreateFromHDC(tDC, hGraphics) = 0& Then ' wrap GDI+ around our target DC
            If Not hGraphics = 0& Then
                
                ' create image attributes and identify how RGB will be multiplied to create GrayScale
                If GdipCreateImageAttributes(hImgAttr) = 0& Then
                    
                    Select Case GrayScaleType
                    Case 1                      ' Formula.NtscPal
                        clrMatrix(0, 0) = 0.299!
                        clrMatrix(0, 1) = 0.587!
                        clrMatrix(0, 2) = 0.114!
                    Case 2                      ' Formula.SimpleAverage
                        clrMatrix(0, 0) = 0.333!
                        clrMatrix(0, 1) = 0.334!
                        clrMatrix(0, 2) = 0.333!
                    Case Else                   ' Formula.CCIRRec709
                        clrMatrix(0, 0) = 0.213! ' r
                        clrMatrix(0, 1) = 0.715! ' g
                        clrMatrix(0, 2) = 0.072! ' b
                    
                    End Select
                    clrMatrix(1, 0) = clrMatrix(0, 0)
                    clrMatrix(2, 0) = clrMatrix(0, 0)
                    clrMatrix(1, 1) = clrMatrix(0, 1)
                    clrMatrix(2, 1) = clrMatrix(0, 1)
                    clrMatrix(1, 2) = clrMatrix(0, 2)
                    clrMatrix(2, 2) = clrMatrix(0, 2)
                    
                    clrMatrix(3, 3) = 1! ' global alpha value
                    clrMatrix(4, 4) = 1! ' required; cannot be anything else
                    
                    If GdipSetImageAttributesColorMatrix(hImgAttr, ColorAdjustTypeBitmap, -1, clrMatrix(0, 0), clrMatrix(0, 0), 0&) = 0 Then
                            
                        FillMemory ByVal cHost.BitsPointer, cHost.scanWidth * cHost.Height, 0&   ' erase existing image & render grayscale to it
                        
                        MakeGrayScale = (GdipDrawImageRectRectI(hGraphics, hImg, 0&, 0&, cHost.Width, cHost.Height, 0&, 0&, cHost.Width, cHost.Height, UnitPixel, hImgAttr, 0&, 0&) = 0&)
                    End If
                    
                    GdipDisposeImageAttributes hImgAttr ' clean up
                    
                End If
                
                GdipDeleteGraphics hGraphics    ' clean up
            End If
        End If
        
        GdipDisposeImage hImg       ' clean up
        cHost.LoadDIBinDC False
    End If
    Call InitializeGDIplus(gdiToken, True) ' terminate GDI+

End Function

Private Function ArrayFromStream(Stream As IUnknown, arrayBytes() As Byte) As Boolean

    ' Purpose: Return the array contained in an IUnknown interface
    
    Dim o_hMem As Long, o_lpMem As Long
    Dim o_lngByteCount As Long
    
    If Not Stream Is Nothing Then
    
        If GetHGlobalFromStream(ByVal ObjPtr(Stream), o_hMem) = 0 Then
            o_lngByteCount = GlobalSize(o_hMem)
            If o_lngByteCount > 0 Then
                o_lpMem = GlobalLock(o_hMem)
                If o_lpMem <> 0 Then
                    ReDim arrayBytes(0 To o_lngByteCount - 1)
                    CopyMemory arrayBytes(0), ByVal o_lpMem, o_lngByteCount
                    GlobalUnlock o_hMem
                    ArrayFromStream = True
                End If
            End If
        End If

    End If
    
End Function

Private Function CreateStream(bytContent() As Byte, Optional byteOffset As Long = 0&) As stdole.IUnknown
    
    ' Purpose: Create an IStream-compatible IUnknown interface containing the
    ' passed byte aray. This IUnknown interface can be passed to GDI+ functions
    ' that expect an IStream interface -- neat hack
    
    On Error GoTo HandleError
    Dim o_lngLowerBound As Long
    Dim o_lngByteCount  As Long
    Dim o_hMem As Long
    Dim o_lpMem  As Long
     
    If iparseIsArrayEmpty(Not bytContent) Then    ' create a growing stream as needed
         Call CreateStreamOnHGlobal(0, 1, CreateStream)
    Else                                    ' create a fixed stream
         o_lngByteCount = UBound(bytContent) - byteOffset + 1
         o_hMem = GlobalAlloc(&H2, o_lngByteCount)
         If o_hMem <> 0 Then
             o_lpMem = GlobalLock(o_hMem)
             If o_lpMem <> 0 Then
                 CopyMemory ByVal o_lpMem, bytContent(byteOffset), o_lngByteCount
                 Call GlobalUnlock(o_hMem)
                 Call CreateStreamOnHGlobal(o_hMem, 1, CreateStream)
             End If
         End If
     End If
    
HandleError:
End Function


Private Function InitializeGDIplus(gToken As Long, ShutDown As Boolean) As Boolean

    ' function starts/stops GDI+
    
    If ShutDown Then
        GdiplusShutdown gToken
        
    Else
    
        Dim gdiSI As GdiplusStartupInput
        gdiSI.GdiplusVersion = 1
        If GdiplusStartup(gToken, gdiSI) = 0& Then
            InitializeGDIplus = True
        Else
            gToken = 0&
        End If
     
    End If

End Function