如何设置进度条使得文件拷贝和进度条进度一致

caonimabi 2004-12-28 11:15:02
如何设置进度条使得文件拷贝和进度条进度一致
...全文
152 4 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
caonimabi1 2005-04-22
  • 打赏
  • 举报
回复
ding
wyl_82 2004-12-29
  • 打赏
  • 举报
回复
你试试下面的控件:在“工程”选择添家控件,选择“Microsoft Common Dialog Control6.0(SP3)”,在加入“Microsoft Windows Common Control6.0(SP4)”
你在用“ProgressBar”控件。
creazyfish 2004-12-29
  • 打赏
  • 举报
回复
Public sub CopyFile(Src As String, Dst As String) As Single
Dim BTest!, FSize!
Dim F1%, F2%
Dim sArray() As Byte
Dim buff As Integer

Const BUFSIZE = 1024

buff = 1024

F1 = FreeFile
Open Src For Binary As F1
F2 = FreeFile
Open Dst For Binary As F2

FSize = LOF(F1)
BTest = FSize - LOF(F2)
ReDim sArray(BUFSIZE) As Byte

Do
If BTest < BUFSIZE Then
buff = BTest
ReDim sArray(buff) As Byte
End If

Get F1, , sArray
Put F2, , sArray

BTest = FSize - LOF(F2)
If BTest < 0 Then
ProgressBar.Value = 100
Else
ProgressBar.Value = (100 - Int(100 * BTest / FSize))
End If
Loop Until BTest <= 0

Close F1
Close F2
CopyFile = FSize

End sub
junki 2004-12-29
  • 打赏
  • 举报
回复
自画

代码如下:

'缺省属性值:
Const m_def_ShowLabel = True
Const m_def_Max = 100
Const m_def_Min = 0
Const m_def_Value = 0
'属性变量:
Dim m_Font As Font
Dim m_ShowLabel As Boolean
Dim m_Max As Long
Dim m_Min As Long
Dim m_Value As Long
'事件声明:
Event Click()
Event DblClick()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)



'注意!不要删除或修改下列被注释的行!
'MappingInfo=Picture2,Picture2,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
BackColor = Picture2.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
Picture2.BackColor() = New_BackColor
PropertyChanged "BackColor"
End Property

'注意!不要删除或修改下列被注释的行!
'MemberInfo=8,0,0,100
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"
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

'注意!不要删除或修改下列被注释的行!
'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)
If New_Value >= m_Max Then
New_Value = m_Max
End If
Dim charLength As Integer
Dim PrintString As String

m_Value = New_Value
PropertyChanged "Value"

Picture2.Width = (m_Value) / m_Max * Picture1.Width

PrintString = CStr(Int(m_Value * 100 / m_Max)) & "%"

charLength = Len(PrintString)
If charLength = 2 Then
PrintString = " " & PrintString
ElseIf charLength = 3 Then
PrintString = " " & PrintString
End If
Picture1.Cls
Picture2.Cls


Picture1.CurrentX = (Picture1.ScaleWidth - m_Font.Size * 3 * 20) / 2
Picture1.CurrentY = (Picture1.ScaleHeight - m_Font.Size * 20) / 2
Picture2.CurrentX = (Picture1.ScaleWidth - m_Font.Size * 3 * 20) / 2
Picture2.CurrentY = (Picture1.ScaleHeight - m_Font.Size * 20) / 2
Picture1.ForeColor = Picture2.BackColor
Picture2.ForeColor = Picture1.BackColor
If m_ShowLabel = True Then
Picture1.Print PrintString
Picture2.Print PrintString
End If

End Property

Private Sub UserControl_Initialize()
Picture2.Width = 0

End Sub

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
m_Max = m_def_Max
m_Min = m_def_Min
m_Value = m_def_Value
Set m_Font = Ambient.Font
m_ShowLabel = m_def_ShowLabel
End Sub

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

Picture2.BackColor = PropBag.ReadProperty("BackColor", &H80000001)
m_Max = PropBag.ReadProperty("Max", m_def_Max)
m_Min = PropBag.ReadProperty("Min", m_def_Min)
m_Value = PropBag.ReadProperty("Value", m_def_Value)
Set m_Font = PropBag.ReadProperty("Font", Ambient.Font)
m_ShowLabel = PropBag.ReadProperty("ShowLabel", m_def_ShowLabel)
Picture1.Appearance = PropBag.ReadProperty("Appearance", 1)
End Sub

Private Sub UserControl_Resize()
On Error Resume Next
Picture1.Left = 0
Picture1.Width = UserControl.ScaleWidth
Picture1.Top = 0
Picture1.Height = UserControl.ScaleHeight

With Picture2
.Left = Picture1.ScaleLeft
.Width = m_Value / m_Max * Picture1.ScaleWidth
.Top = Picture1.ScaleTop
.Height = Picture1.ScaleHeight
End With

End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

Call PropBag.WriteProperty("BackColor", Picture2.BackColor, &H80000001)
Call PropBag.WriteProperty("Max", m_Max, m_def_Max)
Call PropBag.WriteProperty("Min", m_Min, m_def_Min)
Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
Call PropBag.WriteProperty("Font", m_Font, Ambient.Font)
Call PropBag.WriteProperty("ShowLabel", m_ShowLabel, m_def_ShowLabel)
Call PropBag.WriteProperty("Appearance", Picture1.Appearance, 1)
End Sub


'注意!不要删除或修改下列被注释的行!
'MemberInfo=6,0,0,
Public Property Get Font() As Font
Set Font = m_Font
End Property

Public Property Set Font(ByVal New_Font As Font)
Set m_Font = New_Font
PropertyChanged "Font"
End Property

'注意!不要删除或修改下列被注释的行!
'MemberInfo=0,0,0,True
Public Property Get ShowLabel() As Boolean
ShowLabel = m_ShowLabel
End Property

Public Property Let ShowLabel(ByVal New_ShowLabel As Boolean)
m_ShowLabel = New_ShowLabel
PropertyChanged "ShowLabel"
End Property

'注意!不要删除或修改下列被注释的行!
'MappingInfo=Picture1,Picture1,-1,Appearance
Public Property Get Appearance() As Integer
Appearance = Picture1.Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As Integer)
Picture1.Appearance() = New_Appearance
PropertyChanged "Appearance"
End Property

1,453

社区成员

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧