c32bppdib.cls

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

Public Property Get ImageType() As eImageFormat
    ImageType = m_Format    ' returns image format of the source image
End Property
Friend Property Let ImageType(iType As eImageFormat)
    m_Format = iType    ' set by the various image parsers. This is not used
    ' anywhere in these classes, you can do with it what you want -- for now.
End Property

Public Property Get Width() As Long
    Width = m_Width     ' width of image in pixels
End Property
Public Property Get Height() As Long
    Height = m_Height   ' height of image in pixels
End Property
Public Property Get BitsPointer() As Long
    BitsPointer = m_Pointer ' pointer to the bits of the image
End Property
Public Property Get scanWidth() As Long
    scanWidth = m_Width * 4&    ' number of bytes per scan line
End Property
Public Property Get Handle() As Long
    Handle = m_Handle   ' the picture handle of the image
End Property

Public Function LoadDIBinDC(ByVal bLoad As Boolean) As Long

    ' Purpose: Select/Unselect the DIB into a DC.
    ' Returns the DC handle when image is loaded
    ' Called by image parser if it needs to paint the image into the DIB
       
    If bLoad = True Then
        Dim tDC As Long
        If Not m_Handle = 0& Then    ' do we have an image?
            If m_hDC = 0& Then        ' do we have a DC?
                tDC = GetDC(0&)     ' if not create one
                m_hDC = CreateCompatibleDC(tDC)
                ReleaseDC 0&, tDC
            End If
            If m_prevObj = 0& Then
                m_prevObj = SelectObject(m_hDC, m_Handle)
            End If
            LoadDIBinDC = m_hDC
        End If
    Else
        If Not m_prevObj = 0& Then
            SelectObject m_hDC, m_prevObj
            If m_ManageDC = False Then
                DeleteObject m_hDC
                m_hDC = 0&
            End If
            m_prevObj = 0&
        End If
    End If
End Function

Public Property Let ManageOwnDC(bManage As Boolean)
    ' Determines whether or not this class will manage its own DC
    ' If false, then a DC is created each time the image needs to be Rendered
    Dim tDC As Long
    If bManage = False Then     ' removing management of DC
        If Not m_hDC = 0& Then   ' DC does exist, destroy it
            ' first remove the dib, if one exists
            If Not m_Handle = 0& Then SelectObject m_hDC, m_prevObj
            m_prevObj = 0&
        End If
        DeleteDC m_hDC
        m_hDC = 0&
    Else                        ' allowing creation of dc
        If m_hDC = 0& Then        ' create DC only if we have a dib to put in it
            If Not m_Handle = 0& Then
                tDC = GetDC(0&)
                m_hDC = CreateCompatibleDC(tDC)
                ReleaseDC 0&, tDC
            End If
        End If
    End If
    m_ManageDC = bManage
End Property
Public Property Get ManageOwnDC() As Boolean
    ManageOwnDC = m_ManageDC
End Property

Public Property Get isAlphaBlendFriendly() As Boolean
    ' Read Only - Available for FYI only. Not used in this class
    isAlphaBlendFriendly = ((m_osCAP And 1) = 1)
    ' WinNT4 & below and Win95 are not shipped with msimg32.dll (AlphaBlend API)
    ' Win98 has bugs & would believe that WinME is buggy too but don't know for sure
    ' Therefore, the Rendering in this class will not use AlphaBlend on these
    ' operating systems even if the DLL exists, but will use GDI+ if available
End Property
Public Property Get isGDIplusEnabled() As Boolean
    ' When GDI+ can be used, it will be used by default for following
    ' rotations, if system not AlphaBlend friendly, all other renderings
    ' if HighQualityInterpolation=True
    ' See the Let Property for more.
    isGDIplusEnabled = ((m_osCAP And 2) = 2)
End Property
Public Property Let isGDIplusEnabled(Enabled As Boolean)
    ' You can force the class not to use GDI plus by setting this property to False
    ' When setting it to true, the setting will only take if GDI+ can be started on the system
    
    ' TIP: If this property returns true and isAlphaBlendFriendly returns True,
    ' recommend setting HighQualityInterpolation to True. That setting will force
    ' routines to use GDI+ for all rendering vs AlphaBlend.
    ' If isAlphaBlendFriendly=False and isGDIplusEnabled=True then GDI+ is always used,
    ' otherwise manual rendering will be used if HighQualityInterpolation=True, rotating, or mirroring
    
    m_osCAP = (m_osCAP And Not 2)
    If Enabled Then
        Dim cGDIp As New cGDIPlus
        If cGDIp.isGDIplusOk() = True Then m_osCAP = m_osCAP Or 2
    End If
End Property

Public Property Get isZlibEnabled() As Boolean
    ' The SaveToFile_PNGex & SaveToStream_PNGex require zLIB.
    ' You can test this property to see if zLIB exists in the user's DLL path
    isZlibEnabled = iparseValidateZLIB(vbNullString, 0, False, False, True)
    
End Property

Public Function InitializeDIB(ByVal Width As Long, ByVal Height As Long) As Boolean

    ' Creates a blank (all black, all transparent) DIB of requested height & width
    
    Dim tBMPI As BITMAPINFO, tDC As Long
    
    DestroyDIB ' clear any pre-existing dib
    
    If Width < 0& Then Exit Function
    If Height = 0& Then
        Exit Function
    ElseIf Height < 0& Then
        Height = Abs(Height) ' no top-down dibs
    End If
    
    On Error Resume Next
    With tBMPI.bmiHeader
        .biBitCount = 32
        .biHeight = Height
        .biWidth = Width
        .biPlanes = 1
        .biSize = 40&
        .biSizeImage = .biHeight * .biWidth * 4&
    End With
    If Err Then
        Err.Clear
        ' only possible error would be that Width*Height*4& is absolutely huge
        Exit Function
    End If
    
    tDC = GetDC(0&) ' get screen DC
    m_Handle = CreateDIBSection(tDC, tBMPI, 0&, m_Pointer, 0&, 0&)
    If m_ManageDC = True Then
        ' create a DC if class is managing its own & one isn't created yet
        If m_hDC = 0& Then m_hDC = CreateCompatibleDC(tDC)
    End If
    ' release the screen DC if we captured it
    ReleaseDC 0&, tDC
    
    If Not m_Handle = 0& Then    ' let's hope system resources allowed DIB creation
        m_Width = Width
        m_Height = Height
        m_AlphaImage = True
        m_Format = imgNone
        InitializeDIB = True
    End If

End Function

Public Sub DestroyDIB()
    
    ' PURPOSE: Destroy any existing image
    If Not m_hDC = 0 Then   ' do we have a DC?
        ' do we have an image; if so get it out of the DC
        If Not m_prevObj = 0 Then SelectObject m_hDC, m_prevObj
        ' destroy our DC, no point in keeping it w/o image
        DeleteObject m_hDC
        m_hDC = 0
    End If
    ' if we do have an image, destroy it now
    If Not m_Handle = 0 Then
        DeleteObject m_Handle
        Erase m_ImageByteCache
    End If
    ' reset other image attributes
    m_Width = 0
    m_Height = 0
    m_Handle = 0
    m_Pointer = 0
    m_prevObj = 0
    m_AlphaImage = False
    m_Format = imgError
End Sub

Public Function Render(ByVal destinationDC As Long, _
                Optional ByVal destX As Long, Optional ByVal destY As Long, _
                Optional ByVal destWidth As Long, Optional ByVal destHeight As Long, _
                Optional ByVal srcX As Long, Optional ByVal srcY As Long, _
                Optional ByVal srcWidth As Long, Optional ByVal srcHeight As Long, _
                Optional ByVal Opacity As Long = 100, _
                Optional ByVal Blend As Boolean = True, _
                Optional ByVal SetHalfTone As Boolean = True) As Boolean

    ' PURPOSE: Render an existing 32bpp DIB to a target DC
    ' Note: Scaling, if needed, must be done before routine is called
    
    ' Parameters.
    ' destinationDC :: target DC to draw to
    ' destX, destY :: the top/left coordinates to draw to, default is 0,0
    ' destWidth, destHeight :: the width and height to draw to, default is the image's width & height
    ' srcX, srcY :: the left & top offset within the DIB
    ' srcWidth, srcHeight :: the amount of DIB to be rendered
    ' Opacity :: how opaque to draw the image, default is 100% opaque
    ' Blend :: if True, then AlphaBlend will use AC_SRC_ALPHA (per pixel alpha blending)
    '       -- this option is ignored if the class' Alpha property is False
    ' SetHalfTone :: if True, then the destination DC's stretch mode will be modified to
    '       produce better quality results. This option is not available on Win9x systems.
    '       Tip: When AlphaBlending to another DIB set to False
    '            When AlphaBlending to CompatibleBitmap (DDB) or visible DC set to True

    Dim lBlendFunc As Long, tDC As Long, hOldImage As Long
    Dim lStretchMode As Long
    Dim aResizedBytes() As Byte, aMirrorBytes() As Byte
    Dim targetBmp As Long
    Dim bMirrored As Boolean
    
    ' validate a few things
    If m_Handle = 0& Then
        Exit Function
    ElseIf destinationDC = 0& Then
        Exit Function
    ElseIf srcWidth < 0 Then   ' AlphaBlend is not compatible with negative width/height
        Exit Function          ' negative values used in APIs like StretchBlt for mirroring
    ElseIf srcHeight < 0 Then
        Exit Function
    End If
    
    If Opacity = 0 Then
        Render = True
        Exit Function   ' pointless if image is 100% transparent
    Else
        Opacity = Abs(Opacity) Mod 100
        If Opacity = 0 Then Opacity = 100
    End If
    
    ' validate optional parameters for source image
        If srcWidth = 0& Then srcWidth = m_Width
        If srcHeight = 0& Then srcHeight = m_Height
        If srcX < 0 Then srcX = 0&  ' source X,Y cannot be negative
        If srcY < 0 Then srcY = 0&  ' but the dest X,Y can be
    ' validate optional parameters for destination image
        If destWidth = 0 Then destWidth = m_Width
        If destHeight = 0 Then destHeight = m_Height
    ' one more check, AlphaBlend requires that the source rectangle fit within the image
        If srcX + srcWidth > m_Width Then Exit Function
        If srcY + srcHeight > m_Height Then Exit Function
    
    bMirrored = (destWidth < 0 Or destHeight < 0)
    
    If (m_osCAP And 2) = 2 And (m_StretchQuality = True Or ((m_osCAP And 1) = 0)) Then
        ' we can use GDI+ to render when higher quality interpolation is desired
        ' also use GDI+ by default if O/S has GDI+ and system is not AlphaBlend friendly (WinME and lower)
        Dim cGDIp As New cGDIPlus
        cGDIp.RenderGDIplus Me, destinationDC, 0&, Opacity, destX, destY, destWidth, destHeight, srcX, srcY, srcWidth, srcHeight, m_StretchQuality