vbalprogressbar.ctl

使用vb寫出完美網頁遊戲外掛的原始碼分享

         MoveToEx lHDC, tR.Left, tR.Bottom - 1, tJunk
         hPenOld = SelectObject(lHDC, hPenDark)
         LineTo lHDC, tR.Left, tR.Top
         LineTo lHDC, tR.Right, tR.Top
         SelectObject lHDC, hPenOld
         MoveToEx lHDC, tR.Right - 1, tR.Top + 1, tJunk
         hPenOld = SelectObject(lHDC, hPenLight)
         LineTo lHDC, tR.Right - 1, tR.Bottom - 1
         LineTo lHDC, tR.Left, tR.Bottom - 1
         SelectObject lHDC, hPenOld
      End If
      DeleteObject hPenDark
      DeleteObject hPenLight
   Case 2
      If bRaised Then
         DrawEdge lHDC, tR, EDGE_RAISED, BF_RECT Or BF_SOFT
      Else
         DrawEdge lHDC, tR, EDGE_SUNKEN, BF_RECT Or BF_SOFT
      End If
   End Select
End Sub
      
Private Sub TileArea( _
        ByVal hdc As Long, _
        ByVal x As Long, _
        ByVal y As Long, _
        ByVal Width As Long, _
        ByVal Height As Long, _
        ByVal lSrcDC As Long, _
        ByVal lBitmapW As Long, _
        ByVal lBitmapH As Long, _
        ByVal lSrcOffsetX As Long, _
        ByVal lSrcOffsetY As Long _
    )
Dim lSrcX As Long
Dim lSrcY As Long
Dim lSrcStartX As Long
Dim lSrcStartY As Long
Dim lSrcStartWidth As Long
Dim lSrcStartHeight As Long
Dim lDstX As Long
Dim lDstY As Long
Dim lDstWidth As Long
Dim lDstHeight As Long

    lSrcStartX = ((x + lSrcOffsetX) Mod lBitmapW)
    lSrcStartY = ((y + lSrcOffsetY) Mod lBitmapH)
    lSrcStartWidth = (lBitmapW - lSrcStartX)
    lSrcStartHeight = (lBitmapH - lSrcStartY)
    lSrcX = lSrcStartX
    lSrcY = lSrcStartY
    
    lDstY = y
    lDstHeight = lSrcStartHeight
    
    Do While lDstY < (y + Height)
        If (lDstY + lDstHeight) > (y + Height) Then
            lDstHeight = y + Height - lDstY
        End If
        lDstWidth = lSrcStartWidth
        lDstX = x
        lSrcX = lSrcStartX
        Do While lDstX < (x + Width)
            If (lDstX + lDstWidth) > (x + Width) Then
                lDstWidth = x + Width - lDstX
                If (lDstWidth = 0) Then
                    lDstWidth = 4
                End If
            End If
            'If (lDstWidth > Width) Then lDstWidth = Width
            'If (lDstHeight > Height) Then lDstHeight = Height
            BitBlt hdc, lDstX, lDstY, lDstWidth, lDstHeight, lSrcDC, lSrcX, lSrcY, vbSrcCopy
            lDstX = lDstX + lDstWidth
            lSrcX = 0
            lDstWidth = lBitmapW
        Loop
        lDstY = lDstY + lDstHeight
        lSrcY = 0
        lDstHeight = lBitmapH
    Loop
End Sub


Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Gets/sets the back colour of the control. Not applicable when using XPStyle."
   BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(oColor As OLE_COLOR)
   UserControl.BackColor = oColor
   pDraw
   PropertyChanged "BackColor"
End Property
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Gets/sets the colour of text which is drawn over the background of the bar."
   ForeColor = m_oForeColor
End Property
Public Property Let ForeColor(oColor As OLE_COLOR)
   m_oForeColor = oColor
   pDraw
   PropertyChanged "ForeColor"
End Property
Public Property Get Font() As IFont
Attribute Font.VB_Description = "Gets/sets the font used to draw text on the progress bar."
   Set Font = UserControl.Font
End Property
Public Property Set Font(ByRef fnt As IFont)
   Set UserControl.Font = fnt
   pDraw
   PropertyChanged "Font"
End Property
Public Property Let Font(ByRef fnt As IFont)
   Set UserControl.Font = fnt
   pDraw
   PropertyChanged "Font"
End Property
Public Property Get BarColor() As OLE_COLOR
Attribute BarColor.VB_Description = "Gets/sets the colour of the progress bar.  Not applicable when using XPStyle."
   BarColor = m_oBarColor
End Property
Public Property Let BarColor(oColor As OLE_COLOR)
   m_oBarColor = oColor
   pDraw
   PropertyChanged "BarColor"
End Property
Public Property Get BarForeColor() As OLE_COLOR
Attribute BarForeColor.VB_Description = "Gets/sets the colour of text which is drawn over the bar."
   BarForeColor = m_oBarForeColor
End Property
Public Property Let BarForeColor(oColor As OLE_COLOR)
   m_oBarForeColor = oColor
   pDraw
   PropertyChanged "BarForeColor"
End Property

Public Function ModifyBarPicture( _
      Optional ByVal fLuminance As Double = 1, _
      Optional ByVal fSaturation As Double = 1 _
   )
Attribute ModifyBarPicture.VB_Description = "Applies image processing to the bar picture, allowing you to adjust the luminance or saturation of the image."
   If (pbPic(picBar)) Then
      Dim cDib As New pcDibSection
      cDib.CreateFromPicture picBar
      cDib.ModifyHLS 1, fLuminance, fSaturation
      cDib.PaintPicture picBar.hdc
   End If
End Function
Public Function ModifyPicture( _
      Optional ByVal fLuminance As Double = 1, _
      Optional ByVal fSaturation As Double = 1 _
   )
Attribute ModifyPicture.VB_Description = "Applies image processing to the background picture, allowing you to adjust the luminance or saturation of the image."
   If (pbPic(picBack)) Then
      Dim cDib As New pcDibSection
      cDib.CreateFromPicture picBack
      cDib.ModifyHLS 1, fLuminance, fSaturation
      cDib.PaintPicture picBack.hdc
   End If
End Function

Public Property Get BarPicture() As IPicture
Attribute BarPicture.VB_Description = "Gets/sets a picture to use as the bar in the progress bar."
   Set BarPicture = picBar.Picture
End Property
Public Property Let BarPicture(pic As IPicture)
   pPicture pic, picBar
End Property
Public Property Set BarPicture(pic As IPicture)
   pPicture pic, picBar
End Property
Public Property Get BarPictureMode() As EVPRGPictureModeConstants
Attribute BarPictureMode.VB_Description = "Gets/sets the drawing mode (stretch or tile) applied when drawing the bar picture."
   BarPictureMode = m_eBarPictureMode
End Property
Public Property Let BarPictureMode(ByVal eMode As EVPRGPictureModeConstants)
   m_eBarPictureMode = eMode
   pDraw
   PropertyChanged "BarPictureMode"
End Property
Public Property Get BackPictureMode() As EVPRGPictureModeConstants
Attribute BackPictureMode.VB_Description = "Gets/sets the drawing mode (stretch or tile) applied when drawing the background picture."
   BackPictureMode = m_eBackPictureMode
End Property
Public Property Let BackPictureMode(ByVal eMode As EVPRGPictureModeConstants)
   m_eBackPictureMode = eMode
   pDraw
   PropertyChanged "BackPictureMode"
End Property

Public Property Get Picture() As IPicture
Attribute Picture.VB_Description = "Gets/sets the picture shown in the background of the progress bar control."
   Set Picture = picBack.Picture
End Property
Public Property Let Picture(pic As IPicture)
   pPicture pic, picBack
End Property
Public Property Set Picture(pic As IPicture)
   pPicture pic, picBack
End Property
Private Sub pPicture(pic As IPicture, picStore As PictureBox)
   Set picStore.Picture = pic
   pDraw
   PropertyChanged "Picture"
   PropertyChanged "BarPicture"
End Sub

Private Function TranslateColor(ByVal oClr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
    ' Convert Automation color to Windows color
    If OleTranslateColor(oClr, hPal, TranslateColor) Then
        TranslateColor = CLR_INVALID
    End If
End Function

Private Sub UserControl_Initialize()
   Set m_cMemDC = New pcMemDC
   m_eAppearance = epba3DThin
   m_eBorderStyle = epbsInset
   m_oBarColor = &H800000
   m_oBarForeColor = &HFFFFFF
   m_eBarPictureMode = epbpTile
   m_eBackPictureMode = epbpTile
   m_lMax = 100
   m_eTextAlignX = epbthCenter
   m_eTextAlignY = epbtvVCenter
End Sub

Private Sub UserControl_InitProperties()
   m_hWnd = UserControl.hwnd
End Sub

Private Sub UserControl_Paint()
   pDraw
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   m_hWnd = UserControl.hwnd
   Picture = PropBag.ReadProperty("Picture", Nothing)
   BackColor = PropBag.ReadProperty("BackColor", vbButtonFace)
   ForeColor = PropBag.ReadProperty("ForeColor", vbWindowText)
   Appearance = PropBag.ReadProperty("Appearance", epba3DThin)
   BorderStyle = PropBag.ReadProperty("BorderStyle", epbsInset)
   BarColor = PropBag.ReadProperty("BarColor", &H800000)
   BarForeColor = PropBag.ReadProperty("BarForeColor", &HFFFFFF)
   BarPicture = PropBag.ReadProperty("BarPicture", Nothing)
   BarPictureMode = PropBag.ReadProperty("BarPictureMode", epbpTile)
   BackPictureMode = PropBag.ReadProperty("BackPictureMode", epbpTile)
   Min = PropBag.ReadProperty("Min", 0)
   Max = PropBag.ReadProperty("Max", 100)
   Value = PropBag.ReadProperty("Value", 0)
   ShowText = PropBag.ReadProperty("ShowText", False)
   TextAlignX = PropBag.ReadProperty("TextAlignX", epbthCenter)
   TextAlignY = PropBag.ReadProperty("TextAlignY", epbtvVCenter)
   Text = PropBag.ReadProperty("Text", "")
   Font = PropBag.ReadProperty("Font", UserControl.Font)
   Segments = PropBag.ReadProperty("Segments", False)
   XpStyle = PropBag.ReadProperty("XpStyle", False)
End Sub

Private Sub UserControl_Resize()
   pDraw
End Sub

Private Sub UserControl_Terminate()
   Set m_cMemDC = Nothing
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
   PropBag.WriteProperty "Picture", Picture, Nothing
   PropBag.WriteProperty "BackColor", BackColor, vbButtonFace
   PropBag.WriteProperty "ForeColor", ForeColor, vbWindowText
   PropBag.WriteProperty "Appearance", Appearance, epba3DThin
   PropBag.WriteProperty "BorderStyle", BorderStyle, epbsInset
   PropBag.WriteProperty "BarColor", BarColor, &H800000
   PropBag.WriteProperty "BarForeColor", BarForeColor, &HFFFFFF
   PropBag.WriteProperty "BarPicture", BarPicture, Nothing
   PropBag.WriteProperty "BarPictureMode", BarPictureMode, epbpTile
   PropBag.WriteProperty "BackPictureMode", BackPictureMode, epbpTile
   PropBag.WriteProperty "Min", Min, 0
   PropBag.WriteProperty "Max", Max, 100
   PropBag.WriteProperty "Value", Value, 0
   PropBag.WriteProperty "ShowText", ShowText, False
   PropBag.WriteProperty "TextAlignX", TextAlignX, epbthCenter
   PropBag.WriteProperty "TextAlignY", TextAlignY, epbtvVCenter
   PropBag.WriteProperty "Text", Text, ""
   PropBag.WriteProperty "Font", Font
   PropBag.WriteProperty "Segments", Segments, False
   PropBag.WriteProperty "XpStyle", XpStyle, False
End Sub