VB各种进度条.docx
- 文档编号:6316323
- 上传时间:2023-01-05
- 格式:DOCX
- 页数:26
- 大小:327.30KB
VB各种进度条.docx
《VB各种进度条.docx》由会员分享,可在线阅读,更多相关《VB各种进度条.docx(26页珍藏版)》请在冰豆网上搜索。
VB各种进度条
VB编写进度条已经发展很久了,也有很多好方法。
VB自带的进度条很难看,一般不用,要用的话,代码如下:
PrivateSubCommand1_Click()
DimcounterAsInteger
Dimworkarea(25000)AsString
ProgressBar1.Min=LBound(workarea)
ProgressBar1.Max=UBound(workarea)
ProgressBar1.Visible=True
ProgressBar1.Value=ProgressBar1.Min
Forcounter=LBound(workarea)ToUBound(workarea)
workarea(counter)="initialvalue"&counter
ProgressBar1.Value=counter
Nextcounter
EndSub
各位看官,直接看下面:
Text实现进度条:
OptionExplicit
DimiAsInteger
PrivateSubForm_Load()
Timer1.Enabled=True
Text2.Width=(Form1.Width/100)
EndSub
PrivateSubTimer1_Timer()
'进度条设置
Text2.Width=Text2.Width+(Form1.Width/100)
If(Text2.Width/Form1.Width)>1Then
Form2.Show'载入主画面
UnloadMe
EndIf
EndSub
Image进度条:
OptionExplicit
DimiAsInteger
PrivateSubForm_Load()
JDT.Top=Lab.Top
JDT.Width=(Lab.Width/100)
EndSub
PrivateSubTimer1_Timer()
'进度条设置
JDT.Width=JDT.Width+(Lab.Width/100)
If(JDT.Width/Lab.Width)>1Then
Form1.Show'载入主画面
UnloadMe
EndIf
EndSub
那么更换N个image就会有N个进度条演示,下面示图,大家自己试试。
有看官马上问:
那怎么显示百分比呢
这个不难,百分比代码:
'加一个timer和一个label
'From:
'Author:
Minghacker
DimbAsBoolean
DimiAsInteger
PrivateSubTimer1_Timer()
IfbTheni=i+1
IfNotbTheni=i-1
Ifi>100Theni=100:
b=False
Ifi<0Theni=0:
b=True
Label1.Caption=CStr(i)+"%"
EndSub
PrivateSubForm_Load()
b=True
i=0
EndSub
这样两个配合,进度条加进度百分比,看客们该是熟悉了吧?
具体时间和进度协调要看你的计算了。
Picture进度条:
'例子需以下控件:
'Command1、Command2、Picture1:
都采用默认属性设置
DimctEscAsBoolean
PrivateSubForm_Load()
'初始化控件
Picture1.AutoRedraw=True
Command1.Caption="滚动条例子":
Command2.Caption="取消"
EndSub
PrivateSubCommand1_Click()
DimIAsLong,SAsLong
ctEsc=False
S=1000
ForI=1ToS
Me.Cls:
Me.Print"显示:
"&I
JinDuTiaoI/S,"0.0"'显示进度条:
进度,显示格式(即小数数位)
DoEvents
IfctEscThenMe.Print"已取消":
ExitSub
Next
Me.Print"完毕"
EndSub
PrivateSubCommand2_Click()
ctEsc=True
EndSub
PrivateSubJinDuTiao(BiAsSingle,OptionalnFormtAsString="0")
DimWAsLong,HAsLong,nStrAsString
StaticUpBiAsString
nStr=Format(Bi*100,nFormt)
IfVal(nStr)>="100"ThennStr=100
IfUpBi=nStrThenExitSub
UpBi=nStr
W=Picture1.ScaleWidth:
H=Picture1.ScaleHeight
Picture1.Cls
Picture1.DrawMode=13
nStr=nStr&"%"
Picture1.CurrentX=(W-Picture1.TextWidth(nStr))*0.5
Picture1.CurrentY=(H-Picture1.TextHeight(nStr))*0.5
Picture1.PrintnStr
Picture1.DrawMode=14
Picture1.Line(0,0)-(W*Bi,H),&HFF0000,BF
Picture1.Refresh
EndSub
shape进度条:
'例子需以下控件:
'Command1、Command2、Label1、Label2、Shape1:
都采用默认属性设置
DimctEscAsBoolean
PrivateSubForm_Load()
'初始化控件
Command1.Caption="滚动条例子":
Command2.Caption="取消"
Label1.BorderStyle=1:
Label1.Caption="0%"
Label1.Alignment=2:
Label1.Height=Me.TextHeight("A")*1.5
Shape1.FillStyle=0:
Shape1.FillColor=&HFF0000:
Shape1.DrawMode=14
Shape1.MoveLabel1.Left,Label1.Top,30,Label1.Height-Screen.TwipsPerPixelY*2
Shape1.ZOrder
EndSub
PrivateSubCommand1_Click()
DimIAsLong,SAsLong
ctEsc=False
S=1000
ForI=1ToS
Me.Cls:
Me.Print"显示:
"&I
JinDuTiaoI/S,"0.0"'显示进度条:
进度,显示格式(即小数数位)
DoEvents
IfctEscThenMe.Print"已取消":
ExitSub
Next
Me.Print"完毕"
EndSub
PrivateSubCommand2_Click()
ctEsc=True
EndSub
PrivateSubJinDuTiao(BiAsSingle,OptionalnFormtAsString="0")
Label1.Caption=Int(Bi*100)&"%"
Shape1.Width=Bi*Label1.Width
EndSub
简单的就介绍至此,更简单的提示下,用控件,呵呵,这个最爽,可以做出各种效果。
彩色到炫死
VB的第三方控件ccrpProgressBar是一个进度条的控件 是貌似不错,不过网上已经找不到了。
可以自己写过控件。
有个drowfiled不错,代码如下:
'+++++++++++++++++++++++++++
DimcbAsBoolean
Dimi AsInteger
Dimplus1AsBoolean
Dimplus2AsBoolean
Dimplus3AsBoolean
Dimm_beginColor AsOLE_COLOR
Dimm_endColor AsOLE_COLOR
Dimm_Value AsByte
Dimm_boxCount AsByte
Dimm_boxSpace AsByte
Constm_def_Value=0
Constm_def_beginColor=&HFF
Constm_def_endColor=&HFF00
Constm_def_boxCount=30
Constm_def_boxSpace=2
PublicPropertyGetboxCount()AsByte
boxCount=m_boxCount
EndProperty
PublicPropertyLetboxCount(ByValNew_boxCountAsByte)
m_boxCount=New_boxCount
IfNew_boxCount<3ThenMsgBox"3-100":
m_boxCount=3
IfNew_boxCount>100ThenMsgBox"3-100":
m_boxCount=100
PropertyChanged"boxCount"
EndProperty
PublicPropertyGetboxSpace()AsByte
boxSpace=m_boxSpace
EndProperty
PublicPropertyLetboxSpace(ByValNew_boxSpaceAsByte)
m_boxSpace=New_boxSpace
IfNew_boxSpace>5ThenMsgBox"1-5":
m_boxSpace=5
PropertyChanged"boxSpace"
EndProperty
PublicPropertyGetValue()AsByte
Value=m_Value
EndProperty
PublicPropertyLetValue(ByValNew_ValueAsByte)
m_Value=New_Value
IfNew_Value>100ThenMsgBox"1-100":
m_Value=100
PropertyChanged"Value"
ncolor1=Right$("000000"&Hex$(m_beginColor),6)
ncolor2=Right$("000000"&Hex$(m_endColor),6)
Calldraw(ncolor1,ncolor2,m_boxCount,m_boxSpace)
EndProperty
PublicPropertyGetbeginColor()AsOLE_COLOR
beginColor=m_beginColor
EndProperty
PublicPropertyLetbeginColor(ByValNew_beginColorAsOLE_COLOR)
m_beginColor=New_beginColor
PropertyChanged"beginColor"
EndProperty
PublicPropertyGetendColor()AsOLE_COLOR
endColor=m_endColor
EndProperty
PublicPropertyLetendColor(ByValNew_endColorAsOLE_COLOR)
m_endColor=New_endColor
PropertyChanged"endColor"
EndProperty
PrivateSubUserControl_InitProperties()
i=0:
i2=0
m_beginColor=m_def_beginColor
m_endColor=m_def_endColor
m_Value=m_def_Value
m_boxCount=m_def_boxCount
m_boxSpace=m_def_boxSpace
EndSub
PublicSubDraw3DButton()'pic,hdcAsLong,X1AsLong,Y1AsLong,ByValX2AsLong,ByValY2AsLong,mbAsBoolean)
OnErrorResumeNext
'UserControl,UserControl.Extender.hdc,0,0,UserControl.Width/Screen.TwipsPerPixelX+1,UserControl.Height/Screen.TwipsPerPixelY+1,1)
x1=0
y1=0
x2=UserControl.Width/Screen.TwipsPerPixelX+1
y2=UserControl.Height/Screen.TwipsPerPixelY+1
shsh=UserControl.Height/Screen.TwipsPerPixelY+1
Ifshsh>1Then
DimiAsInteger
Constk=50
dx=y2-y1
cdx=k/dx
IfNotmbThen
j=0
Fori=y1Toy2/2
j=j+cdx
ccc=Int(255-j)+1
UserControl.Line(x1,i)-(x2,i),RGB(ccc,ccc,ccc),B
Nexti
Fori=y2/2Toy2
j=j-cdx
ccc=Int(255-j)+1
UserControl.Line(x1,i)-(x2,i),RGB(ccc,ccc,ccc),B
Nexti
Else
j=k
Fori=y1Toy2
j=j-cdx
ccc=255-Int(j)+1
UserControl.Line(x1,i)-(x2,i),RGB(ccc,ccc,ccc),BF
Nexti
EndIf
EndIf
EndSub
PrivateSubUserControl_ReadProperties(PropBagAsPropertyBag)
m_beginColor=PropBag.ReadProperty("beginColor",m_def_beginColor)
m_endColor=PropBag.ReadProperty("endColor",m_def_endColor)
m_Value=PropBag.ReadProperty("Value",m_def_Value)
m_boxCount=PropBag.ReadProperty("boxCount",m_def_boxCount)
m_boxSpace=PropBag.ReadProperty("boxSpace",m_def_boxSpace)
EndSub
PrivateSubUserControl_Resize()
IfWidth<1000ThenWidth=1000
IfHeight<50ThenHeight=50
CallDraw3DButton
StaticIsRAsBoolean
IfIsRThenExitSub
IsR=True
If(Notm_boxCount=0AndNotm_boxSpace=0)Then
dw=ScaleWidth
DimawAsByte
cnt=m_boxCount
spa=m_boxSpace
aw=((dw-spa)/cnt)
nw=(aw*cnt+5)
Width=nw*Screen.TwipsPerPixelX
EndIf
IsR=False
EndSub
PublicSubdraw(cl1,cl2,cnt,space)
Dimcolor1AsString
Dimcolor2AsString
color1=CStr(cl1)
color2=CStr(cl2)
DimawAsByte
dw=ScaleWidth:
aw=((dw-space)/cnt)
s=(dw/100*Value)/aw:
i=s:
j=i-1
Ifi>cnt+1ThenExitSub
Forj=0Toi
x1=space+j*aw
x2=x1+(aw-space)
y1=space-1
y2=(ScaleHeight-space)
c11=Val("&h"+Mid$(color1,1,2))
c12=Val("&h"+Mid$(color1,3,2))
c13=Val("&h"+Mid$(color1,5,2))
c21=Val("&h"+Mid$(color2,1,2))
c22=Val("&h"+Mid$(color2,3,2))
c23=Val("&h"+Mid$(color2,5,2))
absC11C21_peraw=Int(Abs(c11-c21)/cnt)
absC12C22_peraw=Int(Abs(c12-c22)/cnt)
absC13C23_peraw=Int(Abs(c13-c23)/cnt)
Ifc11>c21Thenplus1=TrueElseplus1=False
Ifc12>c22Thenplus2=TrueElseplus2=False
Ifc13>c23Thenplus3=TrueElseplus3=False
Ifplus1Thenc31=c11-i*absC11C21_peraw
Ifplus2Thenc32=c12-i*absC12C22_peraw
Ifplus3Thenc33=c13-i*absC13C23_peraw
IfNotplus1Thenc31=c11+i*absC11C21_peraw
IfNotplus2Thenc32=c12+i*absC12C22_peraw
IfNotplus3Thenc33=c13+i*absC13C23_peraw
Ifc31<=0Thenc31=0
Ifc32<=0Thenc32=0
Ifc33<=0Thenc33=0
Ifc31>=255Thenc31=255
Ifc32>=255Thenc32=255
Ifc33>=255Thenc33=255
Line(x1,y1)-(x2,y2),RGB(c33,c32,c31),BF
Nextj
Forj=i+1Tocnt
x1=space+j*aw
x2=x1+(aw-space)
y1=space-1
y2=(ScaleHeight-space)
Line(x1,y1)-(x2,y2),RGB(255,255,255),BF
Nextj
EndSub
PrivateSubUserControl_WriteProperties(PropBagAsPropertyBag)
CallPropBag.WriteProperty("beginColor",m_beginColor,m_def_beginColor)
CallPropBag.WriteProperty("endColor",m_endColor,m_def_en
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VB 各种 进度条