Office中国论坛/Access中国论坛

标题: 无限时等待提示例子 [打印本页]

作者: 咱家是猫 时间: 2010-4-9 11:59
标题: 无限时等待提示例子
本帖最后由咱家是猫于 2011-8-11 17:00 编辑

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

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

Option Compare Database
Private WaitApp As New Access.Application
Public Property Let WaitTitle(Waitstr As String)
On Error Resume Next
Dim WaitFile As String
DoCmd.Hourglass True
WaitFile = CurrentProject.Path & "\Wait.ocx"
If Dir(WaitFile) = "" Then
DoCmd.OpenForm "frmWaitBox"
Forms("frmWaitBox").TitleLabel.Caption = Waitstr
Forms("frmWaitBox").Repaint
Else
DoEvents
WaitApp.OpenCurrentDatabase WaitFile
WaitApp.DoCmd.OpenForm "frmWaitBox"
With WaitApp.Forms("frmWaitBox")
!TitleLabel.Caption = Waitstr
End With
End If
End Property
Private Sub Class_Terminate()
On Error Resume Next
DoCmd.Close acForm, "frmWaitBox"
WaitApp.CloseCurrentDatabase
Set WaitApp = Nothing
DoCmd.Hourglass False
End Sub

复制代码

作者: yanwei82123300 时间: 2010-4-9 12:36

坚决支持猫老师

作者: 5988143 时间: 2010-4-9 13:24
先加分,在學習一下~

作者: leijiqiang 时间: 2010-4-9 14:56
绝对好东东~

作者: zxklzxm1983 时间: 2010-4-9 15:14

学习

作者: laiguiyou 时间: 2010-4-9 17:07
在windows 7下不能正常显示

作者: 咱家是猫 时间: 2010-4-9 17:45

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

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

作者: koutx 时间: 2010-4-9 21:21
先行谢过了

作者: goto2008 时间: 2010-4-9 21:54
谢谢分享，收藏先

作者: asklove 时间: 2010-4-10 09:57
谢谢分享

作者: laiguiyou 时间: 2010-4-10 11:58
非常好的东西，以前那个我也一直在用。现在换windows 7了，只是点了后那个进度条出不来。

作者: heqing3000 时间: 2010-4-21 21:52
太棒了，收藏了，谢谢楼主。

作者: niculas 时间: 2024-8-6 15:49
努力回复挣小钱钱呀

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)