VB各种进度条.docx

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