^^ Create a setup type schedule (VB6) ^^

zhaozj2021-02-08  206

^^ Create a setup type schedule (VB6) ^^

New project adds a Picture Box and Command Button to join the following code:

DIM TENTH AS Long

'Conditional compilation

#If Win32 Then

Private Declare Function Bitblt Lib "GDI32" _

(Byval HDestdc As Long, Byval x as long, byval y as long, _

Byval Nwidth As Long, Byval NHEIGHT AS Long, _

Byval hsrcdc as long, byval xsrc as long, Byval Ysrc As long, _

BYVAL DWROP AS long) As long

#ELSE

Private Declare Function Bitblt Lib "GDI" (Byval HDestDC AS _

INTEGER, BYVAL X as INTEGER, BYVAL Y AS INTEGER, BYVAL NWIDTH _

As integer, byval nheight as integer, byval hsrcdc as integer, _

Byval xsrc as integer, byval ysrc as integer, byval dwrop ask

Long) as integer

#End IF

Sub UpdateStatus (filebytes as long)

'------------------------------------- -------------------

Update Picture1 Status Bar

'------------------------------------- -------------------

Static Progress As Long

DIM R As Long

Const srccopy = & hcc0020

DIM TXT $

Progress = Progress Filebytes

IF Progress> Picture1.scalewidth Then

Progress = Picture1.scaleWidth

END IF

TXT $ = format $ (CLNG ((Progress / Picture1.Scalewidth * 100)) "%"

Picture1.cls

Picture1.currentx = _

(Picture1.ScaleWidth - Picture1.TextWidth (txt $)) / 2

Picture1.currenty = _

(Picture1.ScaleHeight - Picture1.Textheight (txt $)) / 2

Picture1.print txt $

Picture1.Line (0, 0) - (Progress, Picture1.scaleHeight), _

Picture1.forecolor, BF

R = Bitblt (Picture1.hdc, 0, 0, Picture1.scalewidth, _

Picture1.scaleHeight, Picture1.hdc, 0, 0, srccopy

End Sub

Private submmand1_click ()

Picture1.scaleWidth = 109

TENTH = 10

For i = 1 TO 11

Call UpdateStatus (TENTH) X = Timer

While Timer

Doevents

Wend

NEXT

End Sub

Private sub flow_load ()

Picture1.fontbold = true

Picture1.Autoredraw = TRUE

Picture1.backcolor = vbwhite

Picture1.drawmode = 10

Picture1.fillStyle = 0

Picture1.forecolor = VBBLUE

End Sub F5 is running, click Command1 to see the effect.

转载请注明原文地址:https://www.9cbs.com/read-3287.html

New Post(0)