office交流网--QQ交流群号

Access培训群:792054000         Excel免费交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

access在系统右下角任务栏弹出消息提示窗体

2019-02-20 10:39:00
dffew
原创
4814

在日常工作中,我们希望程序有提示功能。在某个时间点或者预设值提示信息

在Windows操作系统中,我们常常可以看到某软件会在右下角自动弹出消息供参考阅读


在access中,我们也可以通过API函数来判断系统状态栏的位置,让窗体在右下角任务栏向上滑动弹出



API函数:

Option Compare Database
'调用API取得除任务栏外的屏幕高度
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Const SPI_GETWORKAREA = 48
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'调用API得到整个屏幕高度
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Public Function GetSystemHeight() As Integer '取得屏幕高度
    GetSystemHeight = GetSystemMetrics(SM_CYSCREEN)
End Function

Public Function GetTaskbarHeight() As Integer '取得任务栏高度
    Dim lRes As Long
    Dim rectVal As RECT
    lRes = SystemParametersInfo(SPI_GETWORKAREA, 0, rectVal, 0)
    GetTaskbarHeight = GetSystemMetrics(SM_CYSCREEN) - rectVal.Bottom
End Function


窗体中代码:

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Dim mywidth As Long, myheight As Long
'设置窗口总在最前
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const HWND_TOP = 0
Const HWND_NOTOPMOST = -2
Const HWND_BOTTOM = 1
Const HWND_TOPMOST = -1
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long



Private Sub Form_Load()
'在任务栏中不显示

    hdc = GetDC(0)
    mywidth = GetDeviceCaps(hdc, 8)
    myheight = GetDeviceCaps(hdc, 10)
    DoCmd.MoveSize (mywidth * 15 - Me.WindowWidth),GetSystemHeight * 15



    '窗口总在最前
    SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
    Me.TimerInterval = 200
End Sub

Private Sub Form_Timer()
    Dim I As Integer
    For I = GetSystemHeight * 15 To (myheight * 15 - Me.WindowHeight) - GetTaskbarHeight * 15 Step -1
        DoCmd.MoveSize (mywidth * 15 - Me.WindowWidth), I
    Next I
    Me.TimerInterval = 0
End Sub


滑出过程:


    分享