Question

制作带百分数的进度条控件的方法

我想做一个带百分数显示的进度条，百分数在进度条中央，百分数与进度条重叠的部分自动变色。
要怎么实现？
给网站地址5分，给完整代码和步骤的给30分。

Answer 1

给你一个实现的思路，新建一个工程，放二个picturebox，二个label控件，添加代码：
Option Explicit

Private Sub TGauge(ByVal MaxValue As Long, Optional MinValue As Long)

Dim i As Long
Dim X As Single

'通过调整Picture2的width来模拟进度
With Picture2
X = .Width / MaxValue
.Width = MinValue
.Visible = True
End With

For i = MinValue To MaxValue
DoEvents
Picture2.Width = i * X
Label1.Caption = Format(i / MaxValue, "0%")
Label2.Caption = Label1.Caption
Next

End Sub

'单击窗体
Private Sub Form_Click()
TGauge 100000
End Sub

Private Sub Form_Load()
Me.Width = 6000
Me.Height = 2000

'Picture1是主容器
With Picture1
'白色背景
.BackColor = &HFFFFFF
'字体设置关系到label的定位,必须
.FontName = "System"
.FontSize = 10
.FontBold = True
'位置
.Move Me.Width * 0.05, (Me.Height - .Height) / 4, Me.Width * 0.9, 350
End With

With Picture2 '用其宽度模拟进度
Set .Container = Picture1 '装载在picture1中
.Move -30, 0, Picture1.Width, Picture1.Height
'平面无外观
.Appearance = 0
.BorderStyle = 0
.FillStyle = 0
.BackColor = &H8000& '绿色底
.Visible = False '不可见
End With

With Label1
Set .Container = Picture1 'Picture1中的标签
.Alignment = 0
.Appearance = 0
.Alignment = 2 '文字居中对齐
.BackStyle = 0
.Caption = Format(0, "0%")
.Height = Picture1.TextHeight(.Caption)
.Width = Picture1.Width
.Top = (Picture1.ScaleHeight - .Height) / 2
.Left = (Picture1.ScaleWidth - .Width) / 2
.FontName = "System"
.FontSize = 10
.FontBold = True
'字体默认黑色
End With

With Label2
Set .Container = Picture2 'Picture2中的标签
.Alignment = 0
.Appearance = 0
.Alignment = 2
.BackStyle = 0
.Caption = Format(0, "0%")
'定位与label1一至
.Height = Label1.Height
.Width = Label1.Width
.Top = Label1.Top
.Left = Label1.Left
.FontName = "System"
.FontSize = 10
.FontBold = True
.ForeColor = &HFFFFFF '字体白色
End With
End Sub

这是我以前的一个代码，没时间给你实现控件了，自己研究，分无所谓...

Answer 2

百分数在一侧显示就比较好办了，在中间显示，麻烦，我还是给你一个在进度条右侧显示的好了，再加一个label1控件

Public Sub readfile(ByVal FileLocation As String)
With ProgressBar1
.Max = FileLen(FileLocation)
.Min = 0
.Value = 0
End With
Dim InputStr As String, WholeFile As String
Open FileLocation For Input As #1
Do While Not EOF(1)
Line Input #1, InputStr
DoEvents
WholeFile = WholeFile & InputStr & vbCrLf
ProgressBar1.Value = LenB(StrConv(WholeFile, vbFromUnicode))
rem 以下这一块是为百分数专门写的
With ProgressBar1
Label1.Caption = Round((.Value - .Min) / (.Max - .Min) * 100, 0) & "%"
Label1.AutoSize = True
Label1.Move .Left + .Width, .Top + (.Height - Label1.Height) / 2, Label1.Width, .Height
End With

Loop
Close #1
Text1 = WholeFile
End Sub

Answer 3

自已画一个吧，30分我不太想写。
2个label ,一个定位打进度，一个改变大小和颜色。