1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
|
Option Compare Database
Option Explicit
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex 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
' GetWindowLong Constant
Private Const GWL_STYLE = -16
Private Const WS_SYSMENU = &H80000
Private Const WM_NCPAINT = &H85
Public Sub ShowSystemMenu(frm As Form, ShowIt As Boolean)
On Error GoTo HandleErrors
Dim lngOldStyle As Long
Dim lngNewStyle As Long
' Get the current window style of the form.
lngOldStyle = GetWindowLong(frm.hwnd, GWL_STYLE)
If ShowIt Then
' Turn on the bit that enables system menu.
lngNewStyle = lngOldStyle Or WS_SYSMENU
Else
' Turn off the bit the shows the system menu.
lngNewStyle = lngOldStyle And Not WS_SYSMENU
End If
' Set the new window style.
Call SetWindowLong(frm.hwnd, GWL_STYLE, lngNewStyle)
' The 1 as the third parameter tells
' the window to repaint its entire border.
Call SendMessage(frm.hwnd, WM_NCPAINT, 1, 0)
ExitHere:
Exit Sub
HandleErrors:
Resume ExitHere
End Sub |
Partager