vbAccelerator - Contents of code file: frmMediaProgressDemo.frmVERSION 5.00
Begin VB.Form frmMediaProgressDemo
BackColor = &H00000000&
Caption = "Media Player Style Progress Animation"
ClientHeight = 4035
ClientLeft = 3510
ClientTop = 2490
ClientWidth = 5265
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMediaProgressDemo.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4035
ScaleWidth = 5265
Begin VB.CommandButton cmdPick
BackColor = &H00000000&
Caption = "&Pick..."
Height = 375
Left = 3720
TabIndex = 3
Top = 2040
Width = 1455
End
Begin VB.PictureBox picBarColour
BorderStyle = 0 'None
Height = 315
Left = 3720
ScaleHeight = 315
ScaleWidth = 1455
TabIndex = 1
Top = 1620
Width = 1455
End
Begin VB.Timer tmrAnimate
Enabled = 0 'False
Interval = 50
Left = 3720
Top = 780
End
Begin VB.CommandButton cmdStart
BackColor = &H00000000&
Caption = "&Start"
Height = 435
Left = 3720
TabIndex = 0
Top = 120
Width = 1455
End
Begin VB.Label lblBarColour
BackStyle = 0 'Transparent
Caption = "&Colour:"
ForeColor = &H00FFFFFF&
Height = 255
Left = 3720
TabIndex = 2
Top = 1380
Width = 1455
End
End
Attribute VB_Name = "frmMediaProgressDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_c() As cMediaProgress
Private m_iCount As Long
Private m_iCurrent As Long
Private Sub cmdPick_Click()
Dim i As Long
Dim lC As Long
Dim c As New GCommonDialog
lC = picBarColour.BackColor
If (c.VBChooseColor(lC, , True, , Me.hwnd)) Then
picBarColour.BackColor = lC
For i = 1 To m_iCount
m_c(i).BarColor = lC
Next i
Me.Refresh
End If
End Sub
Private Sub cmdStart_Click()
Dim i As Long
If (cmdStart.Caption = "&Stop") Then
cmdStart.Caption = "&Start"
tmrAnimate.Enabled = False
Else
If (m_c(m_iCount).Value = 100) Or (m_iCurrent = 0) Then
For i = 1 To m_iCount
m_c(i).Value = 0
m_c(i).Text = "Queued"
Next i
Me.Refresh
m_iCurrent = 1
m_c(m_iCurrent).Text = "Converting"
m_c(m_iCurrent).ShowPercentage = True
End If
tmrAnimate.Enabled = True
cmdStart.Caption = "&Stop"
End If
End Sub
Private Sub Form_Load()
Dim i As Long
' Note that you don't really need an
' array of classes to do this.
' You can use a single class to draw
' many bars, provided you can store the
' other properties elsewhere and call the
' .Refresh method prior to calling .Draw
'
' Using multiple classes can lead to inefficient
' GDI use, since each class has its own
' offscreen DIB buffer, but it will be quicker
' for refreshes when nothing has changed.
m_iCount = 10
ReDim Preserve m_c(1 To m_iCount) As cMediaProgress
For i = 1 To m_iCount
Set m_c(i) = New cMediaProgress
With m_c(i)
.AutoSize = True
.ShowPercentage = False
.Text = "Queued"
.Min = 0
.Max = 100
End With
Next i
picBarColour.BackColor = m_c(1).BarColor
End Sub
Private Sub Form_Paint()
Dim i As Long
For i = 1 To 10
m_c(i).Draw Me.hdc, _
16, _
16 + ((i - 1) * (m_c(1).Height + 4))
Next i
End Sub
Private Sub tmrAnimate_Timer()
Dim i As Long
If (m_c(m_iCurrent).Value < 100) Then
m_c(m_iCurrent).Value = m_c(m_iCurrent).Value + 2
Else
m_c(m_iCurrent).ShowPercentage = False
m_c(m_iCurrent).Text = "Complete"
m_c(m_iCurrent).Draw Me.hdc, 16, 16 + ((m_iCurrent - 1) * (m_c(1).Height
+ 4))
m_iCurrent = m_iCurrent + 1
If (m_iCurrent > m_iCount) Then
tmrAnimate.Enabled = False
cmdStart.Caption = "&Start"
Exit Sub
Else
m_c(m_iCurrent).Text = "Converting"
m_c(m_iCurrent).ShowPercentage = True
End If
End If
m_c(m_iCurrent).Draw Me.hdc, _
16, _
16 + ((m_iCurrent - 1) * (m_c(1).Height + 4))
If (m_c(m_iCurrent).Width > m_c(m_iCurrent).MinWidth) Then
For i = 1 To 10
m_c(i).MinWidth = m_c(m_iCurrent).Width
Next i
Me.Refresh
End If
End Sub
|
|