'|-----------------------------------------------
'|-Cách này dài hơi nhưng có tác dụng của dài hơi
'|-Tạo function chuyển đổi thuộc tính
'|----------------------------------------------
Function ChangeProperty(strPropName, varPropType, varPropValue)
Dim dbs As Database, prp As Property
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_XuLyLoi
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_KetThuc:
Exit Function
Change_XuLyLoi:
If Err = conPropNotFoundError Then
Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
ChangeProperty = False
Resume Change_KetThuc
End If
End Function
'|--------------------------------
'|-Tạo nút khóa các thuộc tính
'|--------------------------------
Private Sub cmdLock_Click()
ChangeProperty "StartupForm", dbText, "Frm_main" 'Load form chính
ChangeProperty "StartupShowDBWindow", dbBoolean, False
ChangeProperty "StartupShowStatusBar", dbBoolean, False
ChangeProperty "AllowBuiltinToolbars", dbBoolean, False
ChangeProperty "AllowFullMenus", dbBoolean, False
ChangeProperty "AllowBreakIntoCode", dbBoolean, False
ChangeProperty "AllowSpecialKeys", dbBoolean, False
ChangeProperty "AllowBypassKey", dbBoolean, False 'khóa phía SHIFT
MsgBox "Your database locked! Close your database and reopen to effect", vbOKOnly, "KEG COMPANY"
End Sub
'|--------------------------------
'|-Tạo nút kích hoạt các thuộc tính
'|--------------------------------
Private Sub cmdUnlock_Click()
ChangeProperty "StartupForm", dbText, ""
'ChangeProperty "StartupShowDBWindow", dbBoolean, True
'ChangeProperty "StartupShowStatusBar", dbBoolean, True
'ChangeProperty "AllowBuiltinToolbars", dbBoolean, True
'ChangeProperty "AllowFullMenus", dbBoolean, True
'ChangeProperty "AllowBreakIntoCode", dbBoolean, True
'ChangeProperty "AllowSpecialKeys", dbBoolean, True
ChangeProperty "AllowBypassKey", dbBoolean, True
MsgBox "Your database Unlocked! Please Close It and reopen to effect", vbOKOnly, "KEG COMPANY"
End Sub