进度条和文件复制问题?

发布于 2024-08-02 11:23:51 字数 884 浏览 3 评论 0原文

使用 VB 6

在我的项目中,当我将文件从一个文件夹复制到另一个文件夹时,当时我想显示进度条,如复制….,一旦文件被复制,进度条就会显示 100% 已完成。

代码。

'文件复制

Private Sub Copy_Click()
Timer1.Enabled = True
Dim abc As Integer
Dim line As String
abc = FreeFile
Open App.Path & "\DatabasePath.TXT" For Input As #abc
Input #abc, line
databasetext = line
Dim fs As New FileSystemObject, f As File
Set f = fs.GetFile(databasetext)
f.Copy App.Path & "\"
Set fs = Nothing
Close #abc
End Sub

Private Sub Timer1_Timer()
ProgressBar1.Min = 0
ProgressBar1.Max = 100
ProgressBar1.Value = ProgressBar1.Value + 1
If ProgressBar1.Value = ProgressBar1.Max Then
Timer1.Enabled = False
End If
End Sub

上述代码正在工作,但是当我单击复制按钮时,一旦文件被复制到另一个文件夹,Progressbar1 就不会显示。那么只有progressbar1 正在说明。

两者不会同时工作。

而且一旦文件被复制,进度条应该显示 100%。现在显示不正确,文件仍在复制,进度条显示 100 %

任何人都可以帮助解决问题。

需要 VB 6 代码帮助。

Using VB 6

In my Project, when I copy the file from one folder to another folder, at the time I want to show the progress bar like copying…., Once the file was copied the Progress bar show’s 100 % Completed.

Code.

'File Copying

Private Sub Copy_Click()
Timer1.Enabled = True
Dim abc As Integer
Dim line As String
abc = FreeFile
Open App.Path & "\DatabasePath.TXT" For Input As #abc
Input #abc, line
databasetext = line
Dim fs As New FileSystemObject, f As File
Set f = fs.GetFile(databasetext)
f.Copy App.Path & "\"
Set fs = Nothing
Close #abc
End Sub

Private Sub Timer1_Timer()
ProgressBar1.Min = 0
ProgressBar1.Max = 100
ProgressBar1.Value = ProgressBar1.Value + 1
If ProgressBar1.Value = ProgressBar1.Max Then
Timer1.Enabled = False
End If
End Sub

Above code Is working, But when I click copy button, Progressbar1 is not displaying, once the file was copied to another folder. Then only progressbar1 is stating.

Both will not working simultaneously.

And Also Once the file was copied, then progress bar should display 100 %. Now it is not displaying correctly, Still the file is copying, Progress bar is showing 100 %

Can any one help to solve the problem.

Need VB 6 Code Help.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(3

半仙 2024-08-09 11:23:51

如果标准复制功能阻止计时器触发,那么您能做的最好的事情就是编写自己的副本,一次读取源文件几千字节并将其写入目标文件。

在每次读写操作之间,您需要更新进度条并(可能)调用 DoEvents 以确保它重绘。

另外你的计时器代码没有意义。如果每次触发,它只是任意增加进度,而不考虑实际取得了多少进度。您最好将进度条传递给复制功能,以便它可以随时更新。

像这样的事情会做到这一点:

Private Sub Copy_Click()
  Dim abc As Integer
  Dim line As String
  abc = FreeFile
  Open App.Path & "\DatabasePath.TXT" For Input As #abc
  Input #abc, line
  copyFile line, App.Path & "\" & line, ProgressBar1
  Close #abc
End Sub



Sub copyFile(inFile As String, outFile As String, ByRef pg As ProgressBar)

  Close

  Const chunkSize = 1024
  Dim b() As Byte

  fhIn = FreeFile

  Open inFile For Binary Access Read As #fhIn

  fhOut = FreeFile

  Open outFile For Binary Access Write As #fhOut

  toCopy = LOF(fhIn) 'gets the size of the file
  fileSize = toCopy

  pb.Min = 0
  pb.Max = toCopy




  While toCopy > 0
      If toCopy > chunkSize Then
          ReDim b(1 To chunkSize)
          toCopy = toCopy - chunkSize
      Else
          ReDim b(1 To toCopy)
          toCopy = 0
      End If

      Get #fhIn, , b
      Put #fhOut, , b

      pg.Value = fileSize - toCopy
      DoEvents
  Wend
  Close #fhIn
  Close #fhOut
End Sub

If the standard copy function is blocking the timer from firing then the best thing you can do is write your own copy which reads the source file a few thousand bytes at a time and writes it to the destination file.

Between each read and write operation you need to update your progress bar and (possibly) call DoEvents to make sure it redraws.

Also your timer code makes no sense. It just arbitrarily increases progress every time if fires without reference to how much progress has actually been made. You would be better off passing the progress bar to your copy function so that it can updated as you go.

Something like this would do it:

Private Sub Copy_Click()
  Dim abc As Integer
  Dim line As String
  abc = FreeFile
  Open App.Path & "\DatabasePath.TXT" For Input As #abc
  Input #abc, line
  copyFile line, App.Path & "\" & line, ProgressBar1
  Close #abc
End Sub



Sub copyFile(inFile As String, outFile As String, ByRef pg As ProgressBar)

  Close

  Const chunkSize = 1024
  Dim b() As Byte

  fhIn = FreeFile

  Open inFile For Binary Access Read As #fhIn

  fhOut = FreeFile

  Open outFile For Binary Access Write As #fhOut

  toCopy = LOF(fhIn) 'gets the size of the file
  fileSize = toCopy

  pb.Min = 0
  pb.Max = toCopy




  While toCopy > 0
      If toCopy > chunkSize Then
          ReDim b(1 To chunkSize)
          toCopy = toCopy - chunkSize
      Else
          ReDim b(1 To toCopy)
          toCopy = 0
      End If

      Get #fhIn, , b
      Put #fhOut, , b

      pg.Value = fileSize - toCopy
      DoEvents
  Wend
  Close #fhIn
  Close #fhOut
End Sub
审判长 2024-08-09 11:23:51

为了使进度条发挥作用,它要么必须通过定期循环内联更新,要么在单独的线程中运行。

For a progress bar to function, it either has to be updated inline with a periodic loop, or run in a separate thread.

倚栏听风 2024-08-09 11:23:51

老派 VB6 中的副本是阻塞命令。因此,即使 DoEvents 也会给出相同的结果(文件将复制,然后进度条将显示)。如果您正在通过慢速介质复制大文件并且需要能够显示进度,那么您应该创建目标文件并在循环中以块的形式移动字节,在该循环中您可以更新进度栏。遗憾的是,对于OP中给出的示例,您将无法得到您正在寻找的内容,因为每个操作都是同步的。

编辑:被我上面的人殴打:)

The copy in old school VB6 is a blocking command. So even DoEvents will give the same result (the file will copy, then the progress bar will show up). If you are copying large files over a slow medium and you need to be able to show progress, then you should create the target file and move over bytes in chunks in a loop, in that loop you could update your progress bar. Sadly for the example given in the OP you won't get what you are looking for since every operation is synchronous.

EDIT: Beaten by the guy above me :)

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文