access2010 フォーム設定クラス その4

その4
フォームがたくさんになって面倒になるから、できるだけ手抜きする試み。
SharedResource　MSysResourcesに格納しているイメージをボタンに使用
イメージの差し替えとかできるし埋め込むよりいいでしょ。他加えるとしたらフォームキーボードイベントを補足して特定のショートカットキー操作を制御するとか、MsgBoxをラップするとか、フォームエラーイベントを共通化しちゃうとか。デザインビューでのみ設定できるプロパティ以外であればいいわけだ。


ClassModule:Class_FormDefault

Option Compare Database
Option Explicit

Private WithEvents Frm As Access.Form
Private WithEvents cmdClose As Access.CommandButton
Private WithEvents cmdQuit As Access.CommandButton

Private CloseCancel As Boolean

Private Sub Class_Initialize()
    Set Frm = Application.CodeContextObject
    
    FrmSettings
    BindcmdButtons
    
    CloseCancel = True
    
End Sub

Private Sub Class_Terminate()
On Error Resume Next
    Set Frm = Nothing
    Set cmdClose = Nothing
    Set cmdQuit = Nothing
End Sub

Private Sub FrmSettings()
    With Frm
        Select Case .DefaultView 'acDefView
            Case acDefViewSingle
                .NavigationButtons = False
                .RecordSelectors = False
            Case acDefViewDatasheet
                .NavigationButtons = True
                .RecordSelectors = True
            Case Else
                'Planned Site
        End Select
        
        .OnUnload = "[EVENT PROCEDURE]"
    End With
End Sub

Private Sub BindcmdButtons()
    Dim cmdbtn As Access.Control
    For Each cmdbtn In Frm.Controls
        Select Case cmdbtn.Tag
            Case "Close"
                Set cmdClose = cmdbtn
                With cmdClose
                    .OnClick = "[EVENT PROCEDURE]"
                    .OnGotFocus = "[EVENT PROCEDURE]"
                    .OnLostFocus = "[EVENT PROCEDURE]"
                    .PictureType = 2
                    .Picture = "cmdClose16"
                End With
            Case "Quit"
                Set cmdQuit = cmdbtn
                With cmdQuit
                    .OnClick = "[EVENT PROCEDURE]"
                    .OnGotFocus = "[EVENT PROCEDURE]"
                    .OnLostFocus = "[EVENT PROCEDURE]"
                    .PictureType = 2
                    .Picture = "cmdQuit16"
                End With
            Case Else
                'Planned site
        End Select
    Next
End Sub

Private Sub cmdClose_Click()
    CloseCancel = False
    DoCmd.Close acForm, Frm.Name
End Sub

Private Sub cmdClose_GotFocus()
    cmdClose.Picture = "cmdClose32"
End Sub

Private Sub cmdClose_LostFocus()
    cmdClose.Picture = "cmdClose16"
End Sub

Private Sub cmdQuit_Click()
    CloseCancel = False
    Application.CloseCurrentDatabase
End Sub

Private Sub cmdQuit_GotFocus()
    cmdQuit.Picture = "cmdQuit32"
End Sub

Private Sub cmdQuit_LostFocus()
    cmdQuit.Picture = "cmdQuit16"
End Sub

Private Sub Frm_Unload(Cancel As Integer)
    Cancel = CloseCancel
End Sub

Form:

Option Compare Database
Option Explicit

Private clsFD As Class_FormDefault

Private Sub Form_Open(Cancel As Integer)
    Set clsFD = New Class_FormDefault
End Sub

Private Sub Form_Close()
    Set clsFD = Nothing
End Sub