myprogressbar.ctl

用visual basic语言开发的动网论坛自动注册代码

VERSION 5.00
Begin VB.UserControl MyProgressBar 
   AutoRedraw      =   -1  'True
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   ToolboxBitmap   =   "MyProgressBar.ctx":0000
   Begin VB.PictureBox PicScroll 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   720
      ScaleHeight     =   25
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   25
      TabIndex        =   3
      Top             =   2040
      Width           =   375
   End
   Begin VB.PictureBox PicRight 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   1680
      ScaleHeight     =   25
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   25
      TabIndex        =   2
      Top             =   1560
      Width           =   375
   End
   Begin VB.PictureBox PicMid 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   960
      ScaleHeight     =   25
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   25
      TabIndex        =   1
      Top             =   1560
      Width           =   375
   End
   Begin VB.PictureBox PicLeft 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   360
      ScaleHeight     =   25
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   25
      TabIndex        =   0
      Top             =   1560
      Width           =   375
   End
End
Attribute VB_Name = "MyProgressBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
'缺省属性值:
Const m_def_Min = 0
Const m_def_Max = 10
Const m_def_Value = 0
'属性变量:
Dim m_Min As Long
Dim m_Max As Long
Dim m_Value As Long
Dim StopValue As Long, ScrollY As Long
Dim StopValueSng As Single

Private Sub UserControl_Initialize()
PicLeft.Picture = LoadPicture(AppPath & "\Skins\PBLeft.bmp")
PicRight.Picture = LoadPicture(AppPath & "\Skins\PBRight.bmp")
PicMid.Picture = LoadPicture(AppPath & "\Skins\PBMid.bmp")
PicScroll.Picture = LoadPicture(AppPath & "\Skins\PBScroll.bmp")
ScrollY = (PicMid.Height - PicScroll.Height) / 2
StopValue = 1
End Sub

Private Function AppPath() As String
If Right(App.path, 2) = ":\" Then
  AppPath = Left(App.path, Len(App.path) - 1)
Else
  AppPath = App.path
End If
End Function
'
Private Function DrawProgressBar(Max As Long, Value As Long)
On Error Resume Next
Dim i As Long
Dim ScrollX As Long
Dim CountsScroll As Long
BitBlt UserControl.hdc, 0, 0, PicLeft.Width, PicLeft.Height, PicLeft.hdc, 0, 0, vbSrcCopy
For i = PicLeft.Width To UserControl.ScaleWidth - PicRight.Width Step PicMid.Width
  BitBlt UserControl.hdc, i, 0, 16, 16, PicMid.hdc, 0, 0, vbSrcCopy
Next i
CountsScroll = Value / StopValueSng
If StopValueSng <= 0 Then CountsScroll = Value
If Value <> 0 Then
  For i = 0 To CountsScroll
    ScrollX = i * PicScroll.Width + PicLeft.Width
    BitBlt UserControl.hdc, ScrollX, ScrollY, PicScroll.Width, PicScroll.Height, PicScroll.hdc, 0, 0, vbSrcCopy
  Next i
End If
BitBlt UserControl.hdc, UserControl.ScaleWidth - PicRight.Width, 0, PicRight.Width, PicRight.Height, PicRight.hdc, 0, 0, vbSrcCopy
UserControl.Refresh
End Function

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    m_Max = m_def_Max
    m_Value = m_def_Value
    m_Min = m_def_Min
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Max = PropBag.ReadProperty("Max", m_def_Max)
    m_Value = PropBag.ReadProperty("Value", m_def_Value)
    m_Min = PropBag.ReadProperty("Min", m_def_Min)
End Sub

Private Sub UserControl_Resize()
DrawProgressBar m_Max, Value
End Sub

Private Sub UserControl_Show()
UserControl.Height = PicLeft.Height * Screen.TwipsPerPixelY
DrawProgressBar m_Max, m_Value
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Max", m_Max, m_def_Max)
    Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
    Call PropBag.WriteProperty("Min", m_Min, m_def_Min)
End Sub

'注意！不要删除或修改下列被注释的行！
'MemberInfo=14
Function SetValue(Value As Long) As Boolean
On Error Resume Next
'If StopValue Mod Value = 0 Then
'  DrawProgressBar m_Max, Value
'  DoEvents
'End If
If Value Mod StopValue = 0 Then
  DrawProgressBar m_Max, Value
  DoEvents
End If
'If Value = m_Min Then DrawProgressBar m_Max, Value
End Function

Function StopToDo()
StopValueSng = PicScroll.Width / (UserControl.ScaleWidth - PicLeft.Width - PicRight.Width) * m_Max
StopValue = StopValueSng
If StopValue <= 0 Then StopValue = 1
End Function

'注意！不要删除或修改下列被注释的行！
'MemberInfo=8,0,0,0
Public Property Get Max() As Long
    Max = m_Max
End Property

Public Property Let Max(ByVal New_Max As Long)
    m_Max = New_Max
    PropertyChanged "Max"
    StopToDo
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=8,0,0,0
Public Property Get Value() As Long
    Value = m_Value
End Property

Public Property Let Value(ByVal New_Value As Long)
    m_Value = New_Value
    PropertyChanged "Value"
    SetValue Value
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=8,0,0,0
Public Property Get Min() As Long
    Min = m_Min
End Property

Public Property Let Min(ByVal New_Min As Long)
    m_Min = New_Min
    PropertyChanged "Min"
End Property