无限时等待提示例子

咱家是猫

很久以前发过一次很基础的思路性例子,但当时很粗糙,现在有空,刚好有人问起这个问题,就做成一个相对适用型的例子,发出来大家共享之.

在这个例子中,主要是在实现一种无法预知一个过程需要多长时间能够执行完毕,但要告诉用户当前再在做什么,不要让用户以为是死机了.
例子中附了一个小附件Wait.ocx,其实就是另一个MDB(人为改了后辍名而已),因为如果想实现动画效果,在单一一个例程里是无法实现的,这是Access的限制.
在本库中也有一个等待提示框窗体(frmWaitBox),这个其实是一个预备提示框,这个提示框是无动画效果的.建它的用意是因为前者是另附的,有可能会被用户挪来挪去挪丢了,不能因为没有它而耽误正常的代码执行而预备的.也就是说,所以在当前库的路径中没有找到Wait.ocx,那么程序会自动启用本身自带的这个无动画效果的临时替代提示.
--------------本段论述在例子里有附

1. 
   
2. 
   
3. Option Compare Database
   
4. 
   
5. Private WaitApp As New Access.Application
   
6. 
   
7. Public Property Let WaitTitle(Waitstr As String)
   
8. 
   
9. On Error Resume Next
   
10. 
    
11. Dim WaitFile As String
    
12. DoCmd.Hourglass True
    
13. WaitFile = CurrentProject.Path & "\Wait.ocx"
    
14. If Dir(WaitFile) = "" Then
    
15. DoCmd.OpenForm "frmWaitBox"
    
16. Forms("frmWaitBox").TitleLabel.Caption = Waitstr
    
17. Forms("frmWaitBox").Repaint
    
18. Else
    
19. DoEvents
    
20. WaitApp.OpenCurrentDatabase WaitFile
    
21. WaitApp.DoCmd.OpenForm "frmWaitBox"
    
22. With WaitApp.Forms("frmWaitBox")
    
23. !TitleLabel.Caption = Waitstr
    
24. End With
    
25. End If
    
26. 
    
27. End Property
    
28. 
    
29. Private Sub Class_Terminate()
    
30. 
    
31. On Error Resume Next
    
32. 
    
33. DoCmd.Close acForm, "frmWaitBox"
    
34. WaitApp.CloseCurrentDatabase
    
35. Set WaitApp = Nothing
    
36. DoCmd.Hourglass False
    
37. 
    
38. End Sub
    

复制代码

niculas

努力回复挣小钱钱呀

heqing3000

太棒了，收藏了，谢谢楼主。

laiguiyou

非常好的东西，以前那个我也一直在用。现在换windows 7了，只是点了后那个进度条出不来。

asklove

谢谢分享

goto2008

谢谢分享，收藏先

koutx

先行谢过了

咱家是猫

在windows 7下不能正常显示
laiguiyou 发表于 2010-4-9 17:07

是的,主要是用户控制要关掉,在Windows7下就是这点烦人.

laiguiyou

在windows 7下不能正常显示

zxklzxm1983

学习