Vô hiệu hóa nút Close của ứng dụng Access

[bongdacc]

Có những lúc chíp muốn người sử dụng phải bấm một nút lệnh nào đó để đóng Access, vì lúc đó chíp cần code thêm vài dòng, ví dụ là trả font hệ thống cho windows.

Chứ để người dùng quen tay bấm vào cái nút [x] thì ôi thôi mất công toi của chíp. :runcamcap: Vì vậy, chíp mày mò và tìm ra một vài hàm API để thực hiện chức năng này. Hy vọng sẽ hữu ích cho những ai gặp phải tình huống giống chíp. :dangiuqua:

Chíp tạo một module mới lưu các hàm cần sử dụng.

'Chíp khai báo cáo hằng số
Private Const MF_DISABLED = &H2&
Private Const MF_ENABLED = &H0&
Private Const MF_GRAYED = &H1&


'Chíp khai báo cáo hàm API cần dùng
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long

Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long

'Chíp tạo các Sub

Public Sub DisableSysMenu(ByVal hmenuTrackPopup As Long, ByVal mPosition As Long, ByVal mstr As String)
Dim r1 As Long
r1 = ModifyMenu(hmenuTrackPopup, mPosition, MF_DISABLED Or MF_GRAYED, mPosition, mstr)
End Sub

Public Sub EnableSysMenu(ByVal hmenuTrackPopup As Long, ByVal mPosition As Long, ByVal mstr As String)
Dim r1 As Long
r1 = ModifyMenu(hmenuTrackPopup, mPosition, MF_ENABLED, mPosition, mstr)
End Sub


Public Sub NoCloseButton(ByVal mhwnd As Long)
Dim mstr As String
mstr = String$(100, " ")
r2 = GetSystemMenu(mhwnd, 0)
r3 = GetMenuString(r2, 61536, mstr, 100, 0)
mstr = Trim$(mstr)
Call DisableSysMenu(r2, 61536, mstr)
End Sub

Public Sub YesCloseButton(ByVal mhwnd As Long)
Dim mstr As String
mstr = String$(100, " ")
r2 = GetSystemMenu(mhwnd, 0)
r3 = GetMenuString(r2, 61536, mstr, 100, 0)
mstr = Trim$(mstr)
Call EnableSysMenu(r2, 61536, mstr)
End Sub


'Chíp sử dụng
Tắt hiệu ứng [x]
Call NoCloseButton(Application.hWndAccessApp)

Mở hiệu ứng [x]
Call YesCloseButton(Application.hWndAccessApp)

View more random threads:

• help code thuế thu nhập cá nhân
• xin code tạo nút save
• Cho mình hỏi về Link table qua mạng Lan với
• Các Bro giúp em sử lý hàm Dsum kết hợp hàm And với !!!!
• Help me: Lọc dữ liệu qua 2 combobox.???
• [Hỏi] Xếp hạng theo điểm bằng Update Query
• Nhập dữ liệu vào record nếu trùng thì......??
• Tạo chương trình trắc nghiệm bằng ACcess
• Các phần phụ của 1 phần mềm.
• [hỏi] cập nhập dữ liệu trên sub form

[gialinhacbd]

Ðề: Vô hiệu hóa nút Close của ứng dụng Access

Có đoạn code này cũng rất hay. chip tham khảo nhé. (đoạn này bỏ luôn cả minimize và maximize buttons

Option Compare Database

Private Const GWL_EXSTYLE = (-20)
Private Const GWL_STYLE = (-16)

Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_SYSMENU = &H80000

Private Const HWND_TOP = 0
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED

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 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 Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long 'd?nh nghia h?ng c?n dùng
Const SW_SHOWNORMAL = 1
Sub HideCloseButton()

Dim lngStyle As Long

lngStyle = GetWindowLong(hWndAccessApp, GWL_STYLE)
lngStyle = lngStyle And Not WS_SYSMENU
Call SetWindowLong(hWndAccessApp, GWL_STYLE, lngStyle)
Call SetWindowPos(hWndAccessApp, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_DRAWFRAME)

End Sub

-----------------------------------------------------------------------------------------

ví dụ là trả font hệ thống cho windows.

Chip cho xin đoạn code thay đổi và trả về font hệ thống của Windows nhé. Thanks.

[danga]

Ðề: Vô hiệu hóa nút Close của ứng dụng Access

Chip cho xin đoạn code thay đổi và trả về font hệ thống của Windows nhé. Thanks.

Ne`````````` :xinloinhe:

Option Compare Database
'Khai bao cac hang
Const SPI_GETNONCLIENTMETRICS = 41
Const SPI_SETNONCLIENTMETRICS = 42
Const SPI_GETICONTITLELOGFONT = 31
Const SPI_SETICONTITLELOGFONT = 34
Const LF_FACESIZE = 32
'Khai bao cac kieu
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Private Type NONCLIENTMETRICS
cbSize As Long
iBorderWidth As Long
iScrollWidth As Long
iScrollHeight As Long
iCaptionWidth As Long
iCaptionHeight As Long
lfCaptionFont As LOGFONT
iSMCaptionWidth As Long
iSMCaptionHeight As Long
lfSMCaptionFont As LOGFONT
iMenuWidth As Long
iMenuHeight As Long
lfMenuFont As LOGFONT
lfStatusFont As LOGFONT
lfMessageFont As LOGFONT
End Type
'Khai bao cac bieb thuoc kieu tren
Dim m_nonClientMetrics As NONCLIENTMETRICS
Dim m_logFont As LOGFONT
'Khai bao cac bien chua so do font
Dim m_fontCaption As String * 32
Dim m_fontSmCaption As String * 32
Dim m_fontMenu As String * 32
Dim m_fontMessage As String * 32
Dim m_fontStatus As String * 32
Dim m_fontIcon As String * 32
Dim m_fontHeight As Long, m_fontWeight As Long
'Khai bao ham API can dung
Private 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
'Thu tuc thiet lap so do font he thong
Public Function setSysFont(fontName As String)
Dim result As Long

'*****************************
'Truy xuat so do font hien tai
m_nonClientMetrics.cbSize = Len(m_nonClientMetrics)
result = SystemParametersInfo(SPI_GETNONCLIENTMETRICS, _
Len(m_nonClientMetrics), _
m_nonClientMetrics, 0)
result = SystemParametersInfo(SPI_GETICONTITLELOGFONT, _
Len(m_logFont), _
m_logFont, 0)

'**********************************
'Luu lai cac font he thong hien tai
'Luu lai font hien thi Caption
m_fontCaption = m_nonClientMetrics.lfCaptionFont.lfFaceName
m_fontHeight = m_nonClientMetrics.lfCaptionFont.lfHeight
m_fontWeight = m_nonClientMetrics.lfCaptionFont.lfWeight
'Luu lai font hien thi Caption nho
m_fontSmCaption = m_nonClientMetrics.lfSMCaptionFont.lfFaceName
'Luu lai font hien thi hop thoai thong bao
m_fontMessage = m_nonClientMetrics.lfMessageFont.lfFaceName
'Luu lai font Menu
m_fontMenu = m_nonClientMetrics.lfMenuFont.lfFaceName
'************************************
'Thay doi font
'font hien thi Caption
m_nonClientMetrics.lfCaptionFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfCaptionFont.lfWeight = 700
m_nonClientMetrics.lfCaptionFont.lfHeight = -12
'font hien thi Caption nho
m_nonClientMetrics.lfSMCaptionFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfSMCaptionFont.lfHeight = -12
'font hien thi hop thoai thong bao
m_nonClientMetrics.lfMessageFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfMessageFont.lfHeight = -12
'font hien thi menu
m_nonClientMetrics.lfMenuFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfMenuFont.lfHeight = -12
'thuc hien thay doi
result = SystemParametersInfo(SPI_SETNONCLIENTMETRICS, _
Len(m_nonClientMetrics), _
m_nonClientMetrics, 0)
result = SystemParametersInfo(SPI_SETICONTITLELOGFONT, _
Len(m_logFont), _
m_logFont, 0)
End Function
'Thu tuc thiet lap lai so do font cu
Public Sub restoreSysFont()
'font hien thi Caption
m_nonClientMetrics.lfCaptionFont.lfFaceName = m_fontCaption
m_nonClientMetrics.lfCaptionFont.lfHeight = m_fontHeight
m_nonClientMetrics.lfCaptionFont.lfWeight = m_fontWeight
'font hien thi Caption nho
m_nonClientMetrics.lfSMCaptionFont.lfFaceName = m_fontSmCaption
m_nonClientMetrics.lfSMCaptionFont.lfHeight = m_fontHeight
'font hien thi hop thoai thong bao
m_nonClientMetrics.lfMessageFont.lfFaceName = m_fontMessage
m_nonClientMetrics.lfMessageFont.lfHeight = m_fontHeight
'font hien thi menu
m_nonClientMetrics.lfMenuFont.lfFaceName = m_fontMenu
m_nonClientMetrics.lfMenuFont.lfHeight = m_fontHeight
'thuc hien thay doi
result = SystemParametersInfo(SPI_SETNONCLIENTMETRICS, _
Len(m_nonClientMetrics), _
m_nonClientMetrics, 0)
result = SystemParametersInfo(SPI_SETICONTITLELOGFONT, _
Len(m_logFont), _
m_logFont, 0)
End Sub

[cameraquansat]

Ðề: Vô hiệu hóa nút Close của ứng dụng Access

Nghe thằng đánh giày đồn là trong thuộc tính của form có cái thuộc tính Close Button là Yes/No mà ta?

Vậy có cần phải làm một khúc lệnh dài thoòng như vậy chỉ để không có ép phê khi nhấn nút Close đó đi?

Dấu nó đi là xong phải không nhỉ?

P/S:
Lưu ý là khi đó người sử dụng vẫn nhấn CTRL-F4 để đóng form như thường nghen.

Do vậy, nên dự phòng cái này nữa:

Thuộc tính KeyPreview: Yes

Thêm cái thủ tục sự kiện:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF4 And (Shift And acCtrlMask <> 0) Then
KeyCode = 0
End If
End Sub

[honghoa]

Ðề: Vô hiệu hóa nút Close của ứng dụng Access

Nghe thằng đánh giày đồn là trong thuộc tính của form có cái thuộc tính Close Button là Yes/No mà ta?

Vậy có cần phải làm một khúc lệnh dài thoòng như vậy chỉ để không có ép phê khi nhấn nút Close đó đi?

Dấu nó đi là xong phải không nhỉ?

P/S:
Lưu ý là khi đó người sử dụng vẫn nhấn CTRL-F4 để đóng form như thường nghen.

Do vậy, nên dự phòng cái này nữa:

Thuộc tính KeyPreview: Yes

Thêm cái thủ tục sự kiện:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF4 And (Shift And acCtrlMask <> 0) Then
KeyCode = 0
End If
End Sub

Em không nói cái Form của VBA mà cái form của Access Application đó bác. Khi thực hiện gọi hàm tắt cái nút Close đó thì muốn đóng access application phải dùng 2 cách:

- Call Application.Quit
- Nhấn tổ hợp Ctrl + Alt + Del, End Process.

[bluephuongtran]

Ðề: Vô hiệu hóa nút Close của ứng dụng Access

Hình như còn cách thứ 3 nhấn Alt + F4
-----------------------------------------------------------------------------------------

P/S:
Lưu ý là khi đó người sử dụng vẫn nhấn CTRL-F4 để đóng form như thường nghen.

Do vậy, nên dự phòng cái này nữa:

Thuộc tính KeyPreview: Yes

Thêm cái thủ tục sự kiện:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF4 And (Shift And acCtrlMask <> 0) Then
KeyCode = 0
End If
End Sub

Bác ơi cho em hỏi chút, cái acCtrlMask <> 0 của bác có tác dụng gì thế , vì nếu em cho Shift = 4 thì vẫn được mà không cần dùng cái đó.
Thanks bác .

[remcuahg]

Ðề: Vô hiệu hóa nút Close của ứng dụng Access

Ne`````````` :xinloinhe:

Option Compare Database
'Khai bao cac hang
Const SPI_GETNONCLIENTMETRICS = 41
Const SPI_SETNONCLIENTMETRICS = 42
Const SPI_GETICONTITLELOGFONT = 31
Const SPI_SETICONTITLELOGFONT = 34
Const LF_FACESIZE = 32
'Khai bao cac kieu
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Private Type NONCLIENTMETRICS
cbSize As Long
iBorderWidth As Long
iScrollWidth As Long
iScrollHeight As Long
iCaptionWidth As Long
iCaptionHeight As Long
lfCaptionFont As LOGFONT
iSMCaptionWidth As Long
iSMCaptionHeight As Long
lfSMCaptionFont As LOGFONT
iMenuWidth As Long
iMenuHeight As Long
lfMenuFont As LOGFONT
lfStatusFont As LOGFONT
lfMessageFont As LOGFONT
End Type
'Khai bao cac bieb thuoc kieu tren
Dim m_nonClientMetrics As NONCLIENTMETRICS
Dim m_logFont As LOGFONT
'Khai bao cac bien chua so do font
Dim m_fontCaption As String * 32
Dim m_fontSmCaption As String * 32
Dim m_fontMenu As String * 32
Dim m_fontMessage As String * 32
Dim m_fontStatus As String * 32
Dim m_fontIcon As String * 32
Dim m_fontHeight As Long, m_fontWeight As Long
'Khai bao ham API can dung
Private 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
'Thu tuc thiet lap so do font he thong
Public Function setSysFont(fontName As String)
Dim result As Long

'*****************************
'Truy xuat so do font hien tai
m_nonClientMetrics.cbSize = Len(m_nonClientMetrics)
result = SystemParametersInfo(SPI_GETNONCLIENTMETRICS, _
Len(m_nonClientMetrics), _
m_nonClientMetrics, 0)
result = SystemParametersInfo(SPI_GETICONTITLELOGFONT, _
Len(m_logFont), _
m_logFont, 0)

'**********************************
'Luu lai cac font he thong hien tai
'Luu lai font hien thi Caption
m_fontCaption = m_nonClientMetrics.lfCaptionFont.lfFaceName
m_fontHeight = m_nonClientMetrics.lfCaptionFont.lfHeight
m_fontWeight = m_nonClientMetrics.lfCaptionFont.lfWeight
'Luu lai font hien thi Caption nho
m_fontSmCaption = m_nonClientMetrics.lfSMCaptionFont.lfFaceName
'Luu lai font hien thi hop thoai thong bao
m_fontMessage = m_nonClientMetrics.lfMessageFont.lfFaceName
'Luu lai font Menu
m_fontMenu = m_nonClientMetrics.lfMenuFont.lfFaceName
'************************************
'Thay doi font
'font hien thi Caption
m_nonClientMetrics.lfCaptionFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfCaptionFont.lfWeight = 700
m_nonClientMetrics.lfCaptionFont.lfHeight = -12
'font hien thi Caption nho
m_nonClientMetrics.lfSMCaptionFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfSMCaptionFont.lfHeight = -12
'font hien thi hop thoai thong bao
m_nonClientMetrics.lfMessageFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfMessageFont.lfHeight = -12
'font hien thi menu
m_nonClientMetrics.lfMenuFont.lfFaceName = fontName & vbNullChar
m_nonClientMetrics.lfMenuFont.lfHeight = -12
'thuc hien thay doi
result = SystemParametersInfo(SPI_SETNONCLIENTMETRICS, _
Len(m_nonClientMetrics), _
m_nonClientMetrics, 0)
result = SystemParametersInfo(SPI_SETICONTITLELOGFONT, _
Len(m_logFont), _
m_logFont, 0)
End Function
'Thu tuc thiet lap lai so do font cu
Public Sub restoreSysFont()
'font hien thi Caption
m_nonClientMetrics.lfCaptionFont.lfFaceName = m_fontCaption
m_nonClientMetrics.lfCaptionFont.lfHeight = m_fontHeight
m_nonClientMetrics.lfCaptionFont.lfWeight = m_fontWeight
'font hien thi Caption nho
m_nonClientMetrics.lfSMCaptionFont.lfFaceName = m_fontSmCaption
m_nonClientMetrics.lfSMCaptionFont.lfHeight = m_fontHeight
'font hien thi hop thoai thong bao
m_nonClientMetrics.lfMessageFont.lfFaceName = m_fontMessage
m_nonClientMetrics.lfMessageFont.lfHeight = m_fontHeight
'font hien thi menu
m_nonClientMetrics.lfMenuFont.lfFaceName = m_fontMenu
m_nonClientMetrics.lfMenuFont.lfHeight = m_fontHeight
'thuc hien thay doi
result = SystemParametersInfo(SPI_SETNONCLIENTMETRICS, _
Len(m_nonClientMetrics), _
m_nonClientMetrics, 0)
result = SystemParametersInfo(SPI_SETICONTITLELOGFONT, _
Len(m_logFont), _
m_logFont, 0)
End Sub

Tôi sử dụng hàm này để thay đổi font hệ thống, nhưng không thay được hết a.
Chỉ thay được nội dung msgbox thôi. Tiêu đề msgbox không thay được, tiêu đề form cũng không thay được, Menu cũng không thay được fonts. Không hiểu tại sao. Nhờ các pác chỉ giúp.

[xuxulinh0993]

Ðề: Vô hiệu hóa nút Close của ứng dụng Access

Đừng cố hiểu tại sao bạn à.
Vì đơn giản câu lệnh trên chỉ thay Font hiển thị trong msgbox thôi.

[new led]

Ðề: Vô hiệu hóa nút Close của ứng dụng Access

Đừng cố hiểu tại sao bạn à.
Vì đơn giản câu lệnh trên chỉ thay Font hiển thị trong msgbox thôi.

Thay được hết tất cả. Nhưng với ứng dụng đang chạy thì không thay được (chỉ được nội dung msgbox).
- Sau Set font, tôi mở một ứng dụng access khác thì thấy thay đổi toàn bộ.
- Vào Display ---> Appearance---->Advanced: thấy thay được hết.
Thế mới lạ chứ. Các PRO kiểm tra lại xem.

[huongnguyen123]

Ðề: Vô hiệu hóa nút Close của ứng dụng Access

Vậy à, mình dùng trên Win 7 chỉ thay được có font msgbox và menu ngữ cảnh thôi.