c32bppdib.cls

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

    Else
        
        
        If m_hDC = 0& Then  ' do we have a DC to select our image into?
            tDC = GetDC(0&) ' if not create one, if ManageOwnDC=True, we will have one
            m_hDC = CreateCompatibleDC(tDC)
            ReleaseDC 0&, tDC
            hOldImage = SelectObject(m_hDC, m_Handle)
        Else
            ' we have a DC, but is the image selected into it?
            If m_prevObj = 0 Then hOldImage = SelectObject(m_hDC, m_Handle)
        End If
        
        If m_osCAP = 0& Or (destWidth < 0& Or destHeight < 0&) Or m_StretchQuality = True Then
            ' win95/NT4, or other nonAlphaBlend Friendly systems w/o GDI+
            ' or mirroring is in effect. AlphaBlend does not support mirroring, therefore, need to manually do it
            ' AlphaBlend does not support BiLinear/BiCubic interpolation; only supports Nearest Neighbor
            
            targetBmp = GetCurrentObject(destinationDC, OBJ_BITMAP) ' used to reduce amount of pixels rendered if possible
            If Not (srcWidth = destWidth And srcHeight = destHeight) Then
                ' stretching is involved, resize. First mirror if needed
                MirrorDIB srcX, srcY, srcWidth, srcHeight, destWidth, destHeight, aMirrorBytes()
                If pvResize(targetBmp, aResizedBytes(), aMirrorBytes(), Nothing, srcX, srcY, srcWidth, srcHeight, destX, destY, destWidth, destHeight) = False Then Exit Function
            End If
            ' use custom blending routine
            Render = Win9xBlend(targetBmp, destinationDC, aResizedBytes(), srcX, srcY, destX, destY, destWidth, destHeight, (255& * Opacity) \ 100&)
        
        Else
        
            ' Stretch_Halftone not compatible with win9x
            If SetHalfTone Then
                If (m_osCAP And 1) = 1 Then lStretchMode = SetStretchBltMode(destinationDC, STRETCH_HALFTONE)
            End If
            
            ' calculate the opacity required & add it to the BlendFunction variable
            lBlendFunc = AC_SRC_OVER Or (((255& * Opacity) \ 100&) * &H10000)
            ' if the image has transparency, then we add the AC_SRC_ALPHA flag too
            If m_AlphaImage = True And Blend = True Then lBlendFunc = lBlendFunc Or (AC_SRC_ALPHA * &H1000000)
            Render = Not (AlphaBlend(destinationDC, destX, destY, destWidth, destHeight, m_hDC, srcX, srcY, srcWidth, srcHeight, lBlendFunc) = 0)
            
            If SetHalfTone Then
                If (m_osCAP And 1) = 1 Then SetStretchBltMode destinationDC, lStretchMode
            End If
            
        End If
        
        ' remove the image from the DC if necessary
        If Not hOldImage = 0 Then SelectObject m_hDC, hOldImage
        If Not tDC = 0& Then    ' if we created a DC, let's destroy it now
            DeleteDC m_hDC
            m_hDC = 0&
        End If
        
    End If
    
End Function

Public Function SaveToFile(ByVal FileName As String, Optional ByVal PromptOverwrite As Boolean = True) As Boolean

    ' Should you want to save a 32bpp image to a file
    ' Did you know? A 32bpp "XP-icon" saved in bitmap format is actually smaller
    '               than saving it in an icon format....
    '   BMP Format: 14byte header + 40byte BitmapInfo + 32bpp image bytes
    '   ICO Format: 22byte header + 40byte BitmapInfo + 32bpp image bytes + 1bpp mask bytes
    
    ' FileName :: full path & name of file to be created
    ' PromptOverwrite :: if True, the user will be offered an option to abort
    '    if the target file already exists
    
    If FileName = vbNullString Then Exit Function
    If m_Handle = 0& Then Exit Function
    
    On Error GoTo ExitRoutine
    If iparseFileExists(FileName) Then
        If PromptOverwrite = True Then
            If MsgBox("Overwrite current file?", vbYesNo + vbDefaultButton2 + vbQuestion, "Overwrite Confirmation") = vbNo Then
                Exit Function
            End If
        End If
    End If
    
    Dim fileNum As Long, rwLen As Long
    Dim tBMPI As BITMAPINFO
    
    ' CREATE_ALWAYS will delete previous file if necessary
    fileNum = CreateFile(FileName, GENERIC_READ Or GENERIC_WRITE, _
              ByVal 0&, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0&)
    If (fileNum = INVALID_HANDLE_VALUE) Then Exit Function
    
    With tBMPI.bmiHeader
        .biHeight = m_Height
        .biPlanes = 1
        .biSize = 40
        .biWidth = m_Width
        .biBitCount = 32
        .biSizeImage = .biWidth * .biHeight * 4&
    End With
    
    ' simply write the file
    WriteFile fileNum, &H4D42&, 2&, rwLen, ByVal 0& ' write BMP magic number
    If rwLen = 2& Then                              ' write the overall size of bitmap
        WriteFile fileNum, CLng(54& + tBMPI.bmiHeader.biSizeImage), 4&, rwLen, ByVal 0&
        If rwLen = 4& Then                          ' write reserved bytes
            WriteFile fileNum, 0&, 4&, rwLen, ByVal 0&
            If rwLen = 4& Then                      ' write image offset from beginning of file
                WriteFile fileNum, 54&, 4&, rwLen, ByVal 0&
                If rwLen = 4& Then                  ' write the bitmap info structure
                    WriteFile fileNum, tBMPI.bmiHeader.biSize, 40&, rwLen, ByVal 0&
                    If rwLen = 40& Then             ' write the bitmap pixels
                        WriteFile fileNum, ByVal m_Pointer, tBMPI.bmiHeader.biSizeImage, rwLen, ByVal 0&
                        SaveToFile = (rwLen = tBMPI.bmiHeader.biSizeImage)
                    End If
                End If
            End If
        End If
    End If
    
ExitRoutine:
If Not fileNum = 0& Then CloseHandle fileNum
If Err Then Err.Clear

End Function

'Public Function SaveToFile_PNG(ByVal FileName As String, Optional ByVal PromptOverwrite As Boolean = True) As Boolean
'
'    ' Requires GDI+ and/or zLib installed on the system, otherwise function fails
'    ' TEST isGDIplusEnabled or isZlibEnabled
'    ' To use the optional PNG properties, isZlibEnabled must be True
'    '   See PngPropertySet and PngPropertyGet
'
'    ' Function saves the 32bpp image to file, converting it to a PNG format first
'    ' FileName :: full path & name of file to be created
'    ' PromptOverwrite :: if True, the user will be offered an option to abort
'    '    if the target file already exists
'    ' Per PNG recommendations, the PNG is converted to non-premultiplied pixels
'
'    If FileName = vbNullString Then Exit Function
'    If m_Handle = 0& Then Exit Function
'
'    If iparseFileExists(FileName) Then
'        If PromptOverwrite = True Then
'            If MsgBox("Overwrite current file?", vbYesNo + vbDefaultButton2 + vbQuestion, "Overwrite Confirmation") = vbNo Then
'                Exit Function
'            End If
'        End If
'    End If
'
'    Dim aDummy() As Byte
'    Dim cGDIp As cGDIPlus, cZlib As cPNGwriter
'    Dim bSuccess As Boolean
'
'    If m_PNGprops Is Nothing Then
'        Set cGDIp = New cGDIPlus
'        If cGDIp.SaveToPNG(FileName, aDummy(), Me) = False Then
'            Set cZlib = New cPNGwriter
'            bSuccess = cZlib.SavePNGex(Me, FileName, aDummy())
'        Else
'            bSuccess = True
'        End If
'    Else
'        If m_PNGprops.SavePNGex(Me, FileName, aDummy()) = False Then
'            Set cGDIp = New cGDIPlus
'            bSuccess = cGDIp.SaveToPNG(FileName, aDummy(), Me)
'        Else
'            bSuccess = True
'        End If
'    End If
'    SaveToFile_PNG = bSuccess
'
'End Function

Public Function SaveToStream(outStream() As Byte) As Boolean

    ' Should you want to serialize the 32bpp DIB
    
    On Error GoTo ExitRoutine   ' should out of memory occur?
    
    If m_Handle = 0& Then Exit Function
    
    Dim tBMPI As BITMAPINFO
    
    With tBMPI.bmiHeader
        .biBitCount = 32
        .biHeight = m_Height
        .biPlanes = 1
        .biSize = 40
        .biSizeImage = m_Width * m_Height * 4&
        .biWidth = m_Width
    End With
    
    ReDim outStream(0 To 54 + tBMPI.bmiHeader.biSizeImage - 1)
    
    CopyMemory outStream(0), &H4D42, 2& ' bmp magic number
    CopyMemory outStream(2), CLng(54 + tBMPI.bmiHeader.biSizeImage), 4& ' overall size of image
    ' ^^ 54 = 14 byte bmp header + 40 for the tBMPI structure
    CopyMemory outStream(10), 54&, 4& ' image offset from beginning of file
    CopyMemory outStream(14), tBMPI, 40&
    CopyMemory outStream(54), ByVal m_Pointer, tBMPI.bmiHeader.biSizeImage
    
    SaveToStream = True
    
ExitRoutine:
    If Err Then
        Err.Clear
        Erase outStream()
    End If
End Function

'Public Function SaveToStream_PNG(outStream() As Byte) As Boolean
'
'    ' Requires GDI+ and/or zLib installed on the system, otherwise function fails
'    ' TEST isGDIplusEnabled or isZlibEnabled
'    ' To use the optional PNG properties, isZlibEnabled must be True
'    '   See PngPropertySet and PngPropertyGet
'
'    ' Function saves the current 32bpp DIB to an array containing the DIB in PNG format
'    ' Per PNG recommendations, the PNG is converted to non-premultiplied pixels
'
'    If m_Handle = 0& Then Exit Function
'
'    Dim cGDIp As cGDIPlus, cZlib As cPNGwriter
'    Dim bSuccess As Boolean
'
'    If m_PNGprops Is Nothing Then
'        Set cGDIp = New cGDIPlus
'        If cGDIp.SaveToPNG(vbNullString, outStream(), Me) = False Then
'            Set cZlib = New cPNGwriter
'            bSuccess = cZlib.SavePNGex(Me, vbNullString, outStream())
'        Else
'            bSuccess = True
'        End If
'    Else
'        If m_PNGprops.SavePNGex(Me, vbNullString, outStream()) = False Then
'            Set cGDIp = New cGDIPlus
'            bSuccess = cGDIp.SaveToPNG(vbNullString, outStream(), Me)
'        Else
'            bSuccess = True
'        End If
'    End If
'    SaveToStream_PNG = bSuccess
'
'End Function

'Public Function PngPropertySet(ByVal PropertyID As ePngProperties, Optional PropertyValue As Variant, Optional ByVal LargeBlockCaption As String) As Boolean
'
'    ' Sets up to 13 properties: the properties are described below
'    ' Once set, properties are forever applied until PngPropetySet(ClearAllProperties)
'    '   is called or this class is terminated
'
'    ' [PropertyID]
'    ' txtTitle - Short (one line) title or caption for image
'    ' txtAuthor - Name of image's creator
'    ' txtDescription - Description of image
'    ' txtCopyright - Copyright notice
'    ' txtCreationTime - Creation Time of original image creation
'    ' txtSoftware - Software used to create the image
'    ' txtDisclaimer - Legal disclaimer
'    ' txtWarning - Warning or nature of content
'    ' txtSource - Device used to create the image
'    ' txtComment - Comment
'    ' :: the above are registered/recognized keywords usable in PNGs
'
'    ' txtLargeBlockText -