frmPBExample.frm

 VERSION 5.00
Object = "{DCE051F5-B912-4306-872B-211DBC5E4C1D}#1.0#0"; "MKCPRO~1.OCX"
Begin VB.Form frmPBExample
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   4320
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3675
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4320
   ScaleWidth      =   3675
   StartUpPosition =   3  'Windows Default
   Begin mkcProgressBar_Control.mkcProgressBar mkcProgressBar1
      Height          =   375
      Left            =   240
      TabIndex        =   11
      Top             =   120
      Width           =   3255
      _ExtentX        =   5741
      _ExtentY        =   661
      BorderStyle     =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   16777215
   End
   Begin VB.CommandButton cmdExit
      Caption         =   "E&xit"
      Height          =   375
      Left            =   2280
      TabIndex        =   7
      Top             =   3720
      Width           =   1215
   End
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   100
      Left            =   3120
      Top             =   840
   End
   Begin VB.Frame fraDisplay
      Caption         =   "Control Settings"
      Height          =   2295
      Left            =   240
      TabIndex        =   1
      Top             =   720
      Width           =   3255
      Begin VB.CommandButton cmdColor
         Caption         =   "C&olors"
         Height          =   375
         Left            =   1800
         TabIndex        =   10
         Top             =   1560
         Width           =   1215
      End
      Begin VB.CheckBox chkAppearance
         Caption         =   "Appearance"
         Height          =   375
         Left            =   1800
         TabIndex        =   6
         Top             =   960
         Value           =   1  'Checked
         Width           =   1215
      End
      Begin VB.CheckBox chkBorder
         Caption         =   "3D Border"
         Height          =   375
         Left            =   1800
         TabIndex        =   5
         Top             =   600
         Value           =   1  'Checked
         Width           =   1215
      End
      Begin VB.ComboBox cmbBarPercent
         Height          =   315
         ItemData        =   "frmPBExample.frx":0000
         Left            =   240
         List            =   "frmPBExample.frx":002B
         TabIndex        =   4
         Text            =   "PercentBar"
         Top             =   1560
         Width           =   1215
      End
      Begin VB.ComboBox cmbDisplay
         Height          =   315
         ItemData        =   "frmPBExample.frx":005A
         Left            =   240
         List            =   "frmPBExample.frx":0067
         TabIndex        =   2
         Text            =   "DisplayStyles"
         Top             =   720
         Width           =   1215
      End
      Begin VB.Label Label1
         Alignment       =   2  'Center
         Caption         =   "Bar Percent"
         Height          =   255
         Left            =   240
         TabIndex        =   9
         Top             =   1200
         Width           =   1215
      End
      Begin VB.Label lblDisplay
         Alignment       =   2  'Center
         Caption         =   "Display Styles"
         Height          =   255
         Left            =   240
         TabIndex        =   8
         Top             =   360
         Width           =   1215
      End
   End
   Begin VB.CommandButton cmdStart
      Caption         =   "&Start"
      Height          =   375
      Left            =   2280
      TabIndex        =   0
      Top             =   3240
      Width           =   1215
   End
   Begin VB.Label lblInfo
      Alignment       =   2  'Center
      Height          =   435
      Left            =   240
      TabIndex        =   3
      Top             =   3240
      Width           =   795
   End
End
Attribute VB_Name = "frmPBExample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'============================================================================================
' mkcProgressBar Example
'============================================================================================
' Created By: Marc Cramer
' Published Date: 01/01/2001
' WebSite: MKC Computers at http://www.mkccomputers.com
'============================================================================================
' Additional Reference: vbAccelerator Multi-Threading In-Progress Control (vbalIPrg.dll)
' WebSite Downloaded From: VBAccelerator at http://www.vbaccelerator.com
'============================================================================================
Option Explicit
'==================================================================================
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(7) As Byte
End Type
Public Enum PropertyPickerPages
  ppickColor = 1
  ppickPicture = 2
  ppickColorPicture = 3
  ppickPictureColor = 4
End Enum
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Private Declare Function OleCreatePropertyFrame Lib "oleaut32.dll" (ByVal hwndOwner As Long, ByVal x As Long, ByVal y As Long, ByVal lpszCaption As Long, ByVal cObjects As Long, ByRef ppUnk As Long, ByVal cPages As Long, ByRef pPageClsID As GUID, ByVal lcid As Long, ByVal dwReserved As Long, ByVal pvReserved As Long) As Long
'==================================================================================
Public Sub ShowPicker(ByVal hwndOwner As Long, ByVal Caption As String, ByVal PropObject As Object, ByVal Pages As PropertyPickerPages)
' show the color picker page
  Dim rclsid(1) As GUID
  Dim lObjects(0) As Long
  Dim clsidColor As GUID
  Dim clsidPicture As GUID
  Dim lPageCount As Long
  Dim lRet As Long
 
  If Not PropObject Is Nothing Then
    lObjects(0) = ObjPtr(PropObject)
   
    'Guid of CStockColorPage
    '0x7ebdaae1, 0x8120, 0x11cf, 0x89, 0x9f, 0x0, 0xaa, 0x0, 0x68, 0x8b, 0x10
    With clsidColor
      .Data1 = &H7EBDAAE1
      .Data2 = &H8120
      .Data3 = &H11CF
      .Data4(0) = &H89
      .Data4(1) = &H9F
      .Data4(2) = &H0
      .Data4(3) = &HAA
      .Data4(4) = &H0
      .Data4(5) = &H68
      .Data4(6) = &H8B
      .Data4(7) = &H10
    End With
   
    'Guid of CStockPicturePage
    '0x7ebdaae2, 0x8120, 0x11cf, 0x89, 0x9f, 0x0, 0xaa, 0x0, 0x68, 0x8b, 0x10
    With clsidPicture
      .Data1 = &H7EBDAAE2
      .Data2 = &H8120
      .Data3 = &H11CF
      .Data4(0) = &H89
      .Data4(1) = &H9F
      .Data4(2) = &H0
      .Data4(3) = &HAA
      .Data4(4) = &H0
      .Data4(5) = &H68
      .Data4(6) = &H8B
      .Data4(7) = &H10
    End With
   
    Select Case Pages
      Case ppickColor
        rclsid(0) = clsidColor
        lPageCount = 1
      Case ppickColorPicture
        rclsid(0) = clsidColor
        rclsid(1) = clsidPicture
        lPageCount = 2
      Case ppickPicture
        rclsid(0) = clsidPicture
        lPageCount = 1
      Case ppickPictureColor
        rclsid(0) = clsidPicture
        rclsid(1) = clsidColor
        lPageCount = 2
    End Select
   
    lRet = OleCreatePropertyFrame(hwndOwner, 0, 0, StrPtr(Caption), 1, lObjects(0), lPageCount, rclsid(0), GetSystemDefaultLCID, 0&, 0&)
    If lRet <> 0 Then Err.Raise lRet
  End If
End Sub 'ShowPicker(ByVal hwndOwner As Long, ByVal Caption As String, ByVal PropObject As Object, ByVal Pages As PropertyPickerPages)
'==================================================================================
Private Sub cmdColor_Click()
' show color property page and set control values based on user input
  Dim cP As New cPropPick
    cP.ForeColor = mkcProgressBar1.ForeColor
    cP.BackColor = mkcProgressBar1.BackColor
    cP.ProgressColor = mkcProgressBar1.ProgressColor
    ShowPicker Me.hWnd, "Progress Bar Colors", cP, ppickColor
    mkcProgressBar1.BackColor = cP.BackColor
    mkcProgressBar1.ForeColor = cP.ForeColor
    mkcProgressBar1.ProgressColor = cP.ProgressColor
End Sub 'cmdColor_Click()
'==================================================================================
Private Sub chkAppearance_Click()
' change control appearance
  mkcProgressBar1.Appearance = chkAppearance.Value
End Sub 'chkAppearance_Click()
'==================================================================================
Private Sub chkBorder_Click()
' change control border
  mkcProgressBar1.BorderStyle = chkBorder.Value
End Sub 'chkBorder_Click()
'==================================================================================
Private Sub cmdExit_Click()
' quitting time
  Unload Me
  End
End Sub 'cmdExit_Click()
'==================================================================================
Private Sub cmdStart_Click()
  ' do something to show progress bar use
  mkcProgressBar1.Value = 0
  mkcProgressBar1.BarPercentage = CInt(cmbBarPercent.List(cmbBarPercent.ListIndex))
  mkcProgressBar1.DisplayStyle = CStr(cmbDisplay.ListIndex)
  cmdStart.Enabled = False
  Timer1.Enabled = True
End Sub 'cmdStart_Click()
'==================================================================================
Private Sub Form_Initialize()
' set initial values
  cmbBarPercent.ListIndex = 4
  cmbDisplay.ListIndex = 0
End Sub 'Form_Initialize()
'==================================================================================
Private Sub Timer1_Timer()
' timer fired so do something
  If mkcProgressBar1.Value < mkcProgressBar1.Max Then
    mkcProgressBar1.Value = mkcProgressBar1.Value + 1
    lblInfo.Caption = "Value: " & mkcProgressBar1.Value
  Else
    Timer1.Enabled = False
    cmdStart.Enabled = True
    mkcProgressBar1.Reset
    lblInfo.Caption = ""
  End If
End Sub 'Timer1_Timer()
'==================================================================================

Project Homepage: