日志
如何判斷 ACCESS 中的窗體，或者ACCESS主窗體的縮放狀態(tài)，是否最大化是否最小化？
|
ACCESS 窗體本身沒找到相關(guān)的屬性，希望以后版本的ACCESS能加入該功能。
現(xiàn)在用 API 可以解決：
現(xiàn)在用 API 可以解決：
縮放狀態(tài)
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
發(fā)表評論 評論 (4 個評論)
- 回復(fù) 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, "我的系統(tǒng)"
Application.RefreshTitleBar
End Sub
Private Sub SetAccForm()
'建立一個功能表代替系統(tǒng)功能表
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) ' 去除 雙擊任務(wù)欄最小化功能
'lWnd = lWnd And Not (&H10000) '去除 最大化功能(即雙擊標(biāo)題欄可以最大化)
lWnd = lWnd And Not (&H80000) '清除Access關(guān)閉、大小按鈕控制框
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() '設(shè)置acc啟動選項(xiàng)
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, "(默認(rèn))" '我後來修改的
Changeproperty "Four-Digit Year Formatting", 1, True
End Sub
Private Sub Setopt() '設(shè)置acc選項(xiàng)
'還可以繼續(xù)進(jìn)行補(bǔ)充，可是關(guān)於這個 SetOption 方法的更多參數(shù)我也不知道如何表述和設(shè)置值
On Error Resume Next
Application.SetOption "Show Startup Dialog Box", False ' 不顯示啟動任務(wù)視窗
Application.SetOption "Confirm Record Changes", False '確認(rèn)，記錄更改
Application.SetOption "Confirm Document Deletions", False '確認(rèn)，刪除文檔
Application.SetOption "Confirm Action Queries", False '確認(rèn)，操作查詢
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 & " 屬性設(shè)置中出現(xiàn)錯誤：" & 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
