frmmain.frm

很好的进度条控件

            Strikethrough   =   0   'False
         EndProperty
         Height          =   312
         Left            =   4140
         TabIndex        =   7
         ToolTipText     =   "Browse for an image file"
         Top             =   1500
         Width           =   396
      End
      Begin VB.CheckBox chkReverseFill 
         Caption         =   "Reverse Fill"
         Enabled         =   0   'False
         ForeColor       =   &H00000080&
         Height          =   192
         HelpContextID   =   21
         Left            =   1560
         TabIndex        =   8
         ToolTipText     =   "Sets whether or not the progress bar is filled in reverse to the normal direction"
         Top             =   1860
         Width           =   1452
      End
      Begin VB.CheckBox chkGraphical 
         Caption         =   "Graphical"
         ForeColor       =   &H00000080&
         Height          =   192
         HelpContextID   =   24
         Left            =   180
         TabIndex        =   5
         ToolTipText     =   "Sets whether the control should be in a graphical mode and paint itself using a custom picture "
         Top             =   1560
         Width           =   1272
      End
      Begin VB.ComboBox cbo3DEffect 
         Height          =   288
         ItemData        =   "frmMain.frx":013E
         Left            =   1560
         List            =   "frmMain.frx":014B
         Style           =   2  'Dropdown List
         TabIndex        =   0
         ToolTipText     =   "Sets the appearance with which the progress bar control is drawn"
         Top             =   240
         Width           =   1632
      End
      Begin VB.CheckBox chkBorder 
         Caption         =   "Border"
         ForeColor       =   &H00000080&
         Height          =   192
         Left            =   3420
         TabIndex        =   2
         ToolTipText     =   "Sets whether or not the progress bar is drawn with a black border"
         Top             =   300
         Width           =   1152
      End
      Begin VB.CheckBox chkVertical 
         Caption         =   "Vertical"
         ForeColor       =   &H00000080&
         Height          =   192
         HelpContextID   =   26
         Left            =   3420
         TabIndex        =   3
         ToolTipText     =   "Sets the orientation of the progress bar"
         Top             =   540
         Width           =   1152
      End
      Begin VB.CheckBox chkSmooth 
         Caption         =   "Smooth"
         ForeColor       =   &H00000080&
         Height          =   192
         HelpContextID   =   23
         Left            =   3420
         TabIndex        =   4
         ToolTipText     =   "Sets whether the progress bar is drawn with segmented blocks or as a smooth block"
         Top             =   780
         Width           =   1092
      End
      Begin VB.Label lbl 
         Caption         =   "Back. Image:"
         ForeColor       =   &H00000080&
         Height          =   192
         Index           =   11
         Left            =   180
         TabIndex        =   37
         Top             =   1200
         Width           =   1332
      End
      Begin VB.Label lbl 
         Caption         =   "Fill Style:"
         ForeColor       =   &H00000080&
         Height          =   192
         Index           =   4
         Left            =   180
         TabIndex        =   34
         Top             =   900
         Width           =   1032
      End
      Begin VB.Label lbl 
         Caption         =   "Shape:"
         ForeColor       =   &H00000080&
         Height          =   192
         Index           =   5
         Left            =   180
         TabIndex        =   31
         Top             =   600
         Width           =   1032
      End
      Begin VB.Label lbl 
         Caption         =   "Appearance:"
         ForeColor       =   &H00000080&
         Height          =   192
         Index           =   1
         Left            =   180
         TabIndex        =   20
         Top             =   300
         Width           =   1032
      End
   End
   Begin CCRProgressBar.ccrpProgressBar ccrpProgressBar 
      Height          =   444
      Left            =   120
      Top             =   180
      Width           =   5376
      _ExtentX        =   9483
      _ExtentY        =   783
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   7.8
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Picture         =   "frmMain.frx":0165
      Value           =   35
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_Unload As Boolean   'Set when form unloaded to ensure
                              'that form unloaded correctly
                              'if progress bar in 'test' mode

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Sub cbo3DEffect_Click()
  ccrpProgressBar.Appearance = cbo3DEffect.ListIndex
End Sub

Private Sub cboAlignment_Click()
  ccrpProgressBar.Alignment = cboAlignment.ListIndex
End Sub

Private Sub cboAutoCaption_Click()
  ccrpProgressBar.AutoCaption = cboAutoCaption.ListIndex
  If cboAutoCaption.ListIndex = 0 Then ccrpProgressBar.Caption = txtCaption.Text
End Sub

Private Sub cboAutoToolTip_Click()
  ccrpProgressBar.AutoToolTip = cboAutoToolTip.ListIndex
End Sub

Private Sub cboFillStyle_Click()
  ccrpProgressBar.FillStyle = cboFillStyle.ListIndex
End Sub

Private Sub cboOrientation_Click()
  ccrpProgressBar.CaptionOrientation = cboOrientation.ItemData(cboOrientation.ListIndex)
End Sub

Private Sub cboShape_Click()
  ccrpProgressBar.Shape = cboShape.ListIndex
  'When the shape property of the Progress Bar is changed, the
  'appearance property is reset to 0 - Flat
  cbo3DEffect.ListIndex = 0
End Sub

Private Sub ccrpProgressBar_Click()
  AddItemToList "Click"
End Sub

Private Sub ccrpProgressBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  AddItemToList "MouseDown: Button = " & Str(Button) & "; Shift = " & Str(Shift) & "; X = " & Str(X) & "; Y = " & Str(Y)
End Sub

Private Sub ccrpProgressBar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  AddItemToList "MouseMove: Button = " & Str(Button) & "; Shift = " & Str(Shift) & "; X = " & Str(X) & "; Y = " & Str(Y)
End Sub

Private Sub ccrpProgressBar_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  AddItemToList "MouseUp: Button = " & Str(Button) & "; Shift = " & Str(Shift) & "; X = " & Str(X) & "; Y = " & Str(Y)
End Sub

Private Sub chkBorder_Click()
  ccrpProgressBar.BorderStyle = chkBorder.Value
End Sub

Private Sub chkGraphical_Click()
  ccrpProgressBar.Style = chkGraphical.Value
  txtImage.Enabled = CBool(chkGraphical.Value)
  cmdBrowse.Enabled = CBool(chkGraphical.Value)
  chkReverseFill.Enabled = CBool(chkGraphical.Value)
End Sub

Private Sub chkReverseFill_Click()
  ccrpProgressBar.ReverseFill = CBool(chkReverseFill.Value)
End Sub

Private Sub chkSmooth_Click()
  ccrpProgressBar.Smooth = CBool(chkSmooth.Value)
End Sub

Private Sub chkVertical_Click()
  If chkVertical.Value Then
    With ccrpProgressBar
      .Left = 120
      .Top = 180
      .Height = 2160
      .Width = 396
    End With
  Else
    With ccrpProgressBar
      .Left = 120
      .Top = 180
      .Height = 444
      .Width = 5376
    End With
  End If
  ccrpProgressBar.Vertical = CBool(chkVertical.Value)
  cboOrientation.Enabled = CBool(chkVertical.Value)
End Sub

Private Sub cmdBackColor_Click()
  With cmdBackColor
    .BackColor = ShowColor(hwnd, .BackColor)
    ccrpProgressBar.BackColor = .BackColor
  End With
End Sub

Private Sub cmdBrowse_Click()
  
  Dim sFileName As String
  
  sFileName = OpenFile(hwnd)
  If sFileName <> "" Then
    txtImage.Text = sFileName
    Set ccrpProgressBar.Picture = LoadPicture(sFileName)
  End If
End Sub

Private Sub cmdBrowseBackImage_Click()
  Dim sFileName As String
  
  sFileName = OpenFile(hwnd)
  If sFileName <> "" Then
    txtBackImage.Text = sFileName
    Set ccrpProgressBar.BackPicture = LoadPicture(sFileName)
  End If
End Sub

Private Sub cmdCaptionColor_Click()
  With cmdCaptionColor
    .BackColor = ShowColor(hwnd, .BackColor)
    ccrpProgressBar.ForeColor = .BackColor
  End With
End Sub

Private Sub cmdClearEvents_Click()
  lstEvents.Clear
End Sub

Private Sub cmdExit_Click()
  Unload Me
End Sub

Private Sub cmdFillColor_Click()
  With cmdFillColor
    .BackColor = ShowColor(hwnd, .BackColor)
    ccrpProgressBar.FillColor = .BackColor
  End With
End Sub

Private Sub cmdTest_Click()
  Dim Count As Long
  Dim Progress As Long
  Dim lTimer As Long
  
  'Disable Test button
  cmdTest.Enabled = False
  
  For Progress = 1 To 100
    ccrpProgressBar.Value = Progress
    lTimer = timeGetTime
    Do: Loop Until timeGetTime - lTimer > 100
    DoEvents    'Allows user to change styles etc whilst in progress
    If m_Unload Then Exit Sub
  Next Progress

  'Enable Test button again
  cmdTest.Enabled = True
  
End Sub

Private Sub Form_Load()
  
  If ccrpProgressBar.ComCtlVer > 4.7 Then
    lbl(0).Visible = True
    lbl(2).Visible = True
    cmdFillColor.Visible = True
    cmdBackColor.Visible = True
  End If
  cbo3DEffect.ListIndex = 0
  cboAlignment.ListIndex = 2
  cboAutoCaption.ListIndex = 0
  cboAutoToolTip.ListIndex = 0
  cboShape.ListIndex = 0
  cboFillStyle.ListIndex = 0
  cboOrientation.ListIndex = 0
End Sub

Private Sub AddItemToList(Item As String)
  With lstEvents
    .AddItem Item
    .ListIndex = .ListCount - 1
  End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
  m_Unload = True
End Sub

Private Sub txtCaption_Change()
  ccrpProgressBar.Caption = txtCaption.Text
End Sub