---------------------------------------------------------------------------------- CtrlWindow Access本体のウィンドウのコントロールボックスを制御 ---------------------------------------------------------------------------------- Option Compare Database Option Explicit 'スタイルを取得する定数 Public Const GWL_WNDPROC = -4& 'ウィンドウプロシージャのアドレス､またはそれを示すハンドルを取得する Public Const GWL_HINSTANCE = -6& 'アプリケーションのインスタンスハンドルを取得する Public Const GWL_HWNDPARENT = -8& '親アプリケーションのインスタンスハンドルを取得する Public Const GWL_ID = -12& 'ウィンドウのIDを取得する Public Const GWL_STYLE = -16& 'ウィンドウスタイルを取得する Public Const GWL_EXSTYLE = -20& '拡張ウィンドウスタイルを取得する Public Const GWL_USERDATA = -21& 'ウィンドウに関連付けられたアプリケーション定義の32ビット値を取得する 'ウィンドウスタイル Public Const WS_OVERLAPPED = &H0& 'スタイルを持つオーバラップウィンドウ Public Const WS_POPUP = &H80000000 'ポップアップウィンドウ Public Const WS_CHILD = &H40000000 '子ウィンドウ Public Const WS_MINIMIZE = &H20000000 '最小化されたウィンドウ Public Const WS_VISIBLE = &H10000000 '可視のウィンドウ Public Const WS_DISABLED = &H8000000 '使用禁止のウィンドウ Public Const WS_CLIPSIBLINGS = &H4000000 '互いに関連する兄弟ウィンドウをクリップ Public Const WS_CLIPCHILDREN = &H2000000 '子ウィンドウが占める領域を除外 Public Const WS_MAXIMIZE = &H1000000 '最大表示されたウィンドウ Public Const WS_CAPTION = &HC00000 'タイトルバーを持つウィンドウ Public Const WS_BORDER = &H800000 '境界を持つウィンドウ Public Const WS_DLGFRAME = &H400000 '二重境界を持ちタイトルを持たないウィンドウ Public Const WS_VSCROLL = &H200000 '垂直スクロールバーを持つウィンドウ Public Const WS_HSCROLL = &H100000 '水平スクロールバーを持つウィンドウ Public Const WS_SYSMENU = &H80000 'タイトルバーにコントロールメニューボックスを持つウィンドウ Public Const WS_THICKFRAME = &H40000 'ウィンドウのサイズ変更に使える太い枠を持つウィンドウ Public Const WS_GROUP = &H20000 '方向キーで次のコントロールに移動できるコントロールグループの最初のコントロール Public Const WS_TABSTOP = &H10000 'Tabキーを使って移動できるコントロール Public Const WS_MINIMIZEBOX = &H20000 '最小化ボタンを持つウィンドウ Public Const WS_MAXIMIZEBOX = &H10000 '最大表示ボタンを持つウィンドウ Public Const WS_TILED = WS_OVERLAPPED Public Const WS_ICONIC = WS_MINIMIZE Public Const WS_SIZEBOX = WS_THICKFRAME Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX) Public Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW ' Public Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU) Public Const WS_CHILDWINDOW = (WS_CHILD) '拡張ウィンドウスタイル Public Const WS_EX_DLGMODALFRAME = &H1& 'タイトルバーを持ち(オプション)二重境界を持つウィンドウ Public Const WS_EX_NOPARENTNOTIFY = &H4& '子ウィンドウが作成または破棄されたときに、親ウィンドウにWM_PARENTNOTIFYメッセージを送らない Public Const WS_EX_TOPMOST = &H8& 'すべてのトップレベルでないウィンドウの上に配置 Public Const WS_EX_ACCEPTFILES = &H10& 'ドラッグ＆ドロップされたファイルを受け入れる Public Const WS_EX_TRANSPARENT = &H20& '透過状態になる '---------------------------------------------------------------------- 'クラス名またはキャプションタイトルを与えてウィンドウハンドルを取得する関数 ' '戻り値 成功 = 指定したクラスとウィンドウ名を持つウィンドウのハンドル ' 失敗 = NULL '---------------------------------------------------------------------- Declare Function FindWindow Lib "user32" _ Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long '---------------------------------------------- 'ウィンドウに関する情報を取得する関数 ' '戻り値 成功 = 要求したデータ(32ビット値) ' 失敗 = 0 '---------------------------------------------- Declare Function GetWindowLong Lib "user32" _ Alias "GetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long) As Long '---------------------------------------------- 'ウィンドウの属性を変更する関数 ' '戻り値 成功 = 変更前の値 ' 失敗 = 0 '---------------------------------------------- Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long '---------------------------------------------- 'ウィンドウのメニューバーを再描画する関数 ' '戻り値 成功 = 0以外 ' 失敗 = 0 '---------------------------------------------- Declare Function DrawMenuBar Lib "user32" _ (ByVal hwnd As Long) As Long '-------------------------------------------------------------------------- 'ウィンドウメニュー(システムメニューまたはコントロールメニューとも呼ばれる)のハンドルを取得する関数 ' '戻り値 bRevert パラメータが FALSE = ウィンドウメニューのコピーのハンドル ' bRevert パラメータが TRUE = NULL '-------------------------------------------------------------------------- Declare Function GetSystemMenu Lib "user32" _ (ByVal hwnd As Long, _ ByVal bRevert As Long) As Long '-------------------------------------------------------------------------- 'メニューからメニュー項目を削除する関数 ' '戻り値 成功 = 0以外 ' 失敗 = 0 '-------------------------------------------------------------------------- Declare Function DeleteMenu Lib "user32" _ (ByVal hMenu As Long, _ ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Public Const MF_BYCOMMAND = &H0& Public Const MF_BYPOSITION = &H400& 'System Menu Command Values Public Const SC_SIZE = &HF000& Public Const SC_MOVE = &HF010& Public Const SC_MINIMIZE = &HF020& Public Const SC_MAXIMIZE = &HF030& Public Const SC_NEXTWINDOW = &HF040& Public Const SC_PREVWINDOW = &HF050& Public Const SC_CLOSE = &HF060& Public Const SC_VSCROLL = &HF070& Public Const SC_HSCROLL = &HF080& Public Const SC_MOUSEMENU = &HF090& Public Const SC_KEYMENU = &HF100& Public Const SC_ARRANGE = &HF110& Public Const SC_RESTORE = &HF120& Public Const SC_TASKLIST = &HF130& Public Const SC_SCREENSAVE = &HF140& Public Const SC_HOTKEY = &HF150& 'Obsolete names Public Const SC_ICON = SC_MINIMIZE Public Const SC_ZOOM = SC_MAXIMIZE 'コントロールメニューを有効/無効 Sub LsSetWindowLong(strCaption As String, flg As String) Dim hwnd As Long Dim lngGetWindowLong As Long Dim lngRtn As Long 'ウィンドウのハンドルを取得 hwnd = FindWindow(vbNullString, strCaption) 'ウィンドウに関する情報を取得 lngGetWindowLong = GetWindowLong(hwnd, GWL_STYLE) If flg = "無効" Then lngGetWindowLong = lngGetWindowLong And (Not WS_SYSMENU) Else lngGetWindowLong = lngGetWindowLong Or WS_SYSMENU End If 'ウィンドウの属性を変更 lngRtn = SetWindowLong(hwnd, GWL_STYLE, lngGetWindowLong) 'ウィンドウのメニューバーを再描画 lngRtn = DrawMenuBar(hwnd) End Sub 'コントロールメニュー［×］ボタンを有効/無効 Sub LsDeleteMenu(strCaption As String, flg As String) Dim hwnd As Long Dim hMenu As Long Dim lngRtn As Long hwnd = FindWindow(vbNullString, strCaption) If flg = "無効" Then 'ウィンドウに関する情報を取得 hMenu = GetSystemMenu(hwnd, 0&) '［閉じる］ボタンを無効にする lngRtn = DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND) Else 'ウィンドウメニューをリセットする hMenu = GetSystemMenu(hwnd, 1&) End If 'ウィンドウのメニューバーを再描画 lngRtn = DrawMenuBar(hwnd) End Sub ---------------------------------------------------------------------------------- DrawAnimatedRects フォームを左上隅よりロードし、左上隅にアンロードします。 ---------------------------------------------------------------------------------- Option Compare Database Option Explicit Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type ' ウィンドウの矩形寸法を取得するAPI Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long ' 矩形のアニメーションを実行するAPI Private Declare Function DrawAnimatedRects Lib "user32" (ByVal hwnd As Long, ByVal idAni As Long, lprcStart As RECT, lprcEnd As RECT) As Long ' アニメーションモード Private Const IDANI_OPEN = &H1 ' クローズ状態からオープン状態へのアニメーション Private Const IDANI_CLOSE = &H2 ' オープン状態からクロース状態へのアニメーション Private Const IDANI_CAPTION = &H3 ' アニメーション矩形にタイトルバーを含める Sub mdlFormLoad(fm As Form) 'フォームを左上隅よりロード Dim rcStart As RECT Dim rcEnd As RECT 'フォームを画面中央に設定　（VBでは次の2行を生かしてください） 'fm.Top = (Screen.Height - fm.Height) / 2 'fm.Left = (Screen.Width - fm.Width) / 2 rcStart.Top = 0 rcStart.Bottom = 0 rcStart.Left = 0 rcStart.Right = 0 Call GetWindowRect(fm.hwnd, rcEnd) Call DrawAnimatedRects(fm.hwnd, IDANI_OPEN Or IDANI_CAPTION, rcStart, rcEnd) End Sub Sub mdlFormUnload(fm As Form) 'フォームを左上隅にアンロード Dim rcStart As RECT Dim rcEnd As RECT rcEnd.Top = 0 rcEnd.Bottom = 0 rcEnd.Left = 0 rcEnd.Right = 0 Call GetWindowRect(fm.hwnd, rcStart) Call DrawAnimatedRects(fm.hwnd, IDANI_CLOSE Or IDANI_CAPTION, rcStart, rcEnd) End Sub