Microsoft Access 掲示板

最初、拡張ズームボックス関数 - hatena chipsを参考に、API の SetWindowLong で何とかしようと苦戦しましたが、うまくいきませんでした。

ふと、下記を思い出して、
タイトルバー以外をドラッグしてフォームを移動させる - hatena chips
これを参考にSendMessageで右下枠をクリックしたことにすればうまくいきました。

フォームの右下にラベルを配置して、下記のように設定します。

名前　lblResize
水平アンカー　右
垂直アンカー　下

フォームのモジュールを下記のように記述します。

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, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32.dll" ()

Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Const HTBOTTOMRIGHT = 17

Private Sub lblResize_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And acLeftButton Then
        ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0&)
    End If
End Sub

以上です。ラベルを使用しましたが、四角形コントロールやイメージコントロールでもOKです。

右下以外でもサイズ変更したい場合は、下記を参考にConst宣言してください。

HTLEFT            10        可変枠の左辺境界線
HTRIGHT           11        可変枠の右辺境界線
HTTOP             12        可変枠の上辺境界線
HTTOPLEFT         13        可変枠の左上隅
HTTOPRIGHT        14        可変枠の右上隅
HTBOTTOM          15        可変枠の下辺境界線
HTBOTTOMLEFT      16        可変枠の左下隅
HTBOTTOMRIGHT     17        可変枠の右下隅

ちなみに、下記を追加すると詳細セクションのドラッグでフォームを移動できます。

Private Sub 詳細_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And acLeftButton Then
        ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

なるほど! SendMessageにこんな使い道があったとは! コードがすごくシンプルに実装できますね。
あと実装して分かったことですが、サブフォームやListBoxの範囲内でドラッグを開放した場合ラベルやイメージのコントロールが背面に隠れてしまい再度ドラッグすることが不可能になってしまいました。
対策としては、初期の画面サイズ(InsideWidth or InsideHeight)を記憶してそれ以下に縮小しないように規制するコードを試行錯誤してみようと思います。
なにはともあれ、短時間でこのようなアイデアを教授頂き大変有り難うございます。