无限时等待提示例子

咱家是猫

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

在这个例子中,主要是在实现一种无法预知一个过程需要多长时间能够执行完毕,但要告诉用户当前再在做什么,不要让用户以为是死机了.
例子中附了一个小附件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
    

复制代码

yanwei82123300

坚决支持猫老师

5988143

先加分,在學習一下~

leijiqiang

绝对好东东~

zxklzxm1983

学习

laiguiyou

在windows 7下不能正常显示

咱家是猫

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

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

koutx

先行谢过了

goto2008

谢谢分享，收藏先

asklove

谢谢分享