Accessクライアント領域の背景色変更

今回は実用的なことは何もないですがお遊びということで気楽に書かせていただきます。データベースソフトMS-AccessはMDIアプリケーションなので下図の赤枠ようにクライアント領域があります。この背景色は普通変えられないですがグレーで味気ないので変更できるようにしてみます。

環境はWindows 2000, Windows XP & MS-Access 2000です。

流れとしてはフォームを用意してそこに背景色を変更するロジックを実装して、非表示のスタートアップフォームとします。背景色を変えたい場合は別ロジックでこのフォームで実装したメソッドを呼び出します。
肝心の色を変更するロジックですが、WinAPIのSetClassLongを使います。

空のmdbファイルを作成します。
データベースウィンドウから新規のフォームを作りBkColor という名前で保存します。
BkColorフォームのプロパティシートから読込み時、 閉じる時イベントプロパティで [イベントプロシージャ]を選択してください。
BkColorフォームは非表示でMDIクライアント領域の背景色を変えるためにあるので、デザインビューは何もしません。デザインビューからツールバーの表示(V)→コード(C) でVBエディタを起動してください。（既にフォームモジュールが表示されています。)

BkColorフォームモジュールに以下を記述してください。

Option Compare Database
Option Explicit

Private vmlHOriginalBrush As Long '元のブラシのハンドル

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, _
     ByVal hWnd2 As Long, _
     ByVal lpsz1 As String, _
     ByVal lpsz2 As String) As Long 'MDIクライアント領域のハンドル取得用

Private Const GCL_HBRBACKGROUND = (-10) 'SetClassLongで使用する定数

Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" _ 
    (ByVal hwnd As Long, _
     ByVal nIndex As Long) As Long '背景色のブラシへのハンドル取得用

Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" _
    (ByVal hwnd As Long, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) As Long '背景色変更

Private Declare Function CreateSolidBrush Lib "gdi32" _
    (ByVal crColor As Long) As Long  '変更するブラシ作成

Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) As Long  'GDIオブジェクト削除

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function InvalidateRect Lib "user32" _
    (ByVal hwnd As Long, _
     lpRect As RECT, _
     ByVal bErase As Long) As Long '領域無効化

Private Declare Function GetClientRect Lib "user32" _
    (ByVal hwnd As Long, _
     lpRect As RECT) As Long       '領域取得

'フォームロード時-------------------------------------------------------------
Private Sub Form_Load()
    Dim vlHwnd As Long

    vlHwnd = FindWindowEx(Application.hWndAccessApp, 0&, "MDIClient", vbNullString)
    If vlHwnd = 0 Then Exit Sub

    vmlHOriginalBrush = GetClassLong(vlHwnd, GCL_HBRBACKGROUND)
End Sub

'MDIクライアント背景色変更----------------------------------------------------
Public Function SetBkColor(arglRGB As Long) As Boolean
    Dim vlHwnd      As Long
    Dim vlHBrush    As Long
    Dim vlHOldBrush As Long
    Dim vtRect      As RECT

    SetBkColor = False

    vlHwnd = FindWindowEx(Application.hWndAccessApp, 0&, "MDIClient", vbNullString)
    If vlHwnd = 0 Then Exit Function

    vlHOldBrush = GetClassLong(vlHwnd, GCL_HBRBACKGROUND)
    If vlHOldBrush = 0 Then Exit Function

    vlHBrush = CreateSolidBrush(arglRGB)
    If vlHBrush = 0 Then Exit Function

    If SetClassLong(vlHwnd, GCL_HBRBACKGROUND, vlHBrush) = 0 Then
        DeleteObject vlHBrush
        Exit Function
    End If

    GetClientRect vlHwnd, vtRect
    InvalidateRect vlHwnd, vtRect, True

    If vlHOldBrush <> vmlHOriginalBrush Then
        DeleteObject vlHOldBrush
    End If

    SetBkColor = True
End Function

'MDIクライアント背景色を元に戻す-----------------------------------------------
Public Sub Reset()
    Dim vlHwnd      As Long
    Dim vlHOldBrush As Long
    Dim vtRect      As RECT

    vlHwnd = FindWindowEx(Application.hWndAccessApp, 0&, "MDIClient", vbNullString)
    If vlHwnd = 0 Then Exit Sub

    vlHOldBrush = GetClassLong(vlHwnd, GCL_HBRBACKGROUND)
    If vlHOldBrush = 0 Then Exit Sub

    If vlHOldBrush <> vmlHOriginalBrush Then
        If SetClassLong(vlHwnd, GCL_HBRBACKGROUND, vmlHOriginalBrush) = 0 Then
            Exit Sub
        End If

        GetClientRect vlHwnd, vtRect
        InvalidateRect vlHwnd, vtRect, True

        DeleteObject vlHOldBrush
    End If
End Sub

'フォームクローズ----------------------------------------------------
Private Sub Form_Close()
    Me.Reset
End Sub

上記で実装ができたので、このフォームを非表示のスタートアップフォームにします。スタートアップはAutoExecマクロを使います。
データベースウィンドウで新規のマクロを作り以下のようにデザインしてください。

デザインが出来たらAutoExecという名前で保存してください。

以上で準備が出来たので背景色を変更するインターフェイスを用意します。データベースウィンドウから新規のフォームを作成して以下のようにデザインしてください。

コントロール種類	名前	プロパティ名	設定値
テキストボックス①	txtR	入力規則プロパティ	>=0 And <= 255 Or Is Null
テキストボックス②	txtG	同上
テキストボックス③	txtB	同上
コマンドボタン④	cmd0	クリック時イベントプロパティ	[イベントプロシージャ]
コマンドボタン⑤	cmd1	同上

各コントロールの名前とテキストボックス・コマンドボタンに関して入力規則プロパティ・イベントプロパティを設定したらツールバーの表示(V)からVBエディタを起動してこのフォームモジュールを表示して以下のコードを記述してください。

Option Compare Database
Option Explicit

Private Sub cmd0_Click()
    Dim vlR As Byte
    Dim vlG As Byte
    Dim vlB As Byte

    vlR = IIf(IsNull(Me!txtR.Value), 0, Me!txtR.Value)
    vlG = IIf(IsNull(Me!txtG.Value), 0, Me!txtG.Value)
    vlB = IIf(IsNull(Me!txtB.Value), 0, Me!txtB.Value)

    If Not Forms!BkColor.SetBkColor(RGB(vlR, vlG, vlB)) Then
        MsgBox "Fail Change BackGroundColor"
    End If
End Sub

Private Sub cmd1_Click()
    Forms!BkColor.Reset
End Sub

できたら任意のフォーム名を設定して保存してフォームビューを表示してください。３つの各テキストボックスに０～２５５までの数値をいれて実行ボタンをクリックしてください。以下のようにクライアント領域の色が変わるはずです。

今回はAccessでやりましたがExcelでもWordでも同様のことはできると思います。 (５．のコードの修正は必要）Databaseとは程遠い話題でしたが今回は気晴らししてみました。