日志
如何判断 ACCESS 中的窗体，或者ACCESS主窗体的缩放状态，是否最大化是否最小化？
|
ACCESS 窗体本身没找到相关的属性，希望以后版本的ACCESS能加入该功能。
现在用 API 可以解决：
现在用 API 可以解决：
缩放状态
Declare Function IsZoomed Lib "user32" (ByVal hwnd As Long) As Long
是否最小化
Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
是否可见
Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Command0_Click()
MsgBox "ACCESS主窗体隐藏：" & 模块2.IsWindowVisible(Application.hWndAccessApp)
MsgBox "ACCESS主窗体缩放：" & IsZoomed(Application.hWndAccessApp)
MsgBox "ACCESS主窗体最小化：" & IsIconic(Application.hWndAccessApp)
End Sub
Private Sub Form_Resize()
MsgBox "最小化：" & IsIconic(Me.hwnd)
MsgBox "缩放：" & IsZoomed(Me.hwnd)
End Sub
发表评论 评论 (4 个评论)
- 回复 5988143
- Option Compare Database
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Sub Form_Load()
SetSysInit
SetAccForm
Setopt
Dim i, J As Integer
DoCmd.Echo False
DoCmd.RunCommand acCmdAppMaximize
DoCmd.Maximize
DoEvents
i = Me.WindowWidth
J = Me.WindowHeight
DoCmd.Restore
DoCmd.MoveSize 0, 0, i, J
DoCmd.Echo True
Changeproperty "Apptitle", 10, "我的系統"
Application.RefreshTitleBar
End Sub
Private Sub SetAccForm()
'建立一個功能表代替系統功能表
Dim NewMBar As CommandBar
Set NewMBar = CommandBars.Add(Name:="new menu bar", position:=msoBarTop, MenuBar:=True, temporary:=True)
With NewMBar
.Visible = True
.Protection = msoBarNoMove
End With
DoCmd.ShowToolbar "new menu bar", acToolbarNo '隱藏剛才建立的功能表,徹底消除功能表欄
' apiShowWindow hWndAccessApp, 1 '正常顯示主視窗
Dim lWnd As Long
lWnd = GetWindowLong(hWndAccessApp, (-16))
lWnd = lWnd And Not (&H20000) ' 去除 雙擊任務欄最小化功能
'lWnd = lWnd And Not (&H10000) '去除 最大化功能(即雙擊標題欄可以最大化)
lWnd = lWnd And Not (&H80000) '清除Access關閉、大小按鈕控制框
lWnd = SetWindowLong(hWndAccessApp, (-16), lWnd)
' Dim xxx1 As String
' Dim X0 As Integer, Y0 As Integer, X1 As Integer, Y1 As Integer
' Y0 = 57 '固定Access主窗口的位置
' X0 = 53
' Y1 = 670
' X1 = 774
' MoveWindow Application.hWndAccessApp, X0, Y0, X1 - X0, Y1 - Y0, True
' Access.SetOption "Show Status Bar", False
End Sub
Private Sub SetSysInit() '設置acc啟動選項
Changeproperty "AllowShortcutMenus", 1, False
Changeproperty "StartUpShowDBWindow", 1, False
Changeproperty "StartUpShowStatusBar", 1, False
Changeproperty "AllowFullMenus", 1, False
Changeproperty "AllowBuiltInToolbars", 1, False
Changeproperty "AllowToolbarChanges", 1, False
Changeproperty "AllowSpecialKeys", 1, False
Changeproperty "StartupShortcutMenuBar", 10, "(默認)" '我後來修改的
Changeproperty "Four-Digit Year Formatting", 1, True
End Sub
Private Sub Setopt() '設置acc選項
'還可以繼續進行補充，可是關於這個 SetOption 方法的更多參數我也不知道如何表述和設置值
On Error Resume Next
Application.SetOption "Show Startup Dialog Box", False ' 不顯示啟動任務視窗
Application.SetOption "Confirm Record Changes", False '確認，記錄更改
Application.SetOption "Confirm Document Deletions", False '確認，刪除文檔
Application.SetOption "Confirm Action Queries", False '確認，操作查詢
Application.SetOption "Auto Compact", True
Application.SetOption "Show Hidden Objects", False
Application.SetOption "Show Status Bar", False
End Sub
Function Changeproperty(Strpropname As String, Varproptype As Variant, Optional Varpropvalue As Variant) As Integer ' As Variant
Dim Prp As Variant
On Error GoTo Change_Err
CurrentDb.Properties(Strpropname) = Varpropvalue
Changeproperty = True
Exit Function
Change_Err:
If Err = 3270 Then ' Property not found.
Set Prp = CurrentDb.CreateProperty(Strpropname, Varproptype, Varpropvalue)
CurrentDb.Properties.Append Prp
Resume Next
Else
If Err = 448 Then
CurrentDb.Properties.Delete Strpropname
Else
' 未知錯誤。
MsgBox Err & " 屬性設置中出現錯誤：" & Err.Description
Changeproperty = False
End If
End If
End Function
Private Sub 命令1_Click()
On Error GoTo Err_命令1_Click
DoCmd.Quit
Exit_命令1_Click:
Exit Sub
Err_命令1_Click:
MsgBox Err.Description
Resume Exit_命令1_Click
End Sub
- 回复 zhengjialon
- 不错
