有名すぎるネタかな。この機能は自作のメモ帳に組み込みたい。メモ帳を常に手前表示にするととっても便利〜、ホントに。
Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOP = 0 '手前にセット Private Const HWND_BOTTOM = 1 '後ろにセット Private Const HWND_TOPMOST = -1 '常に手前にセット Private Const HWND_NOTOPMOST = -2 '常に手前、解除 Private Const SWP_SHOWWINDOW = &H40 '表示する '--------------------------------------------------------------------------- ' 関数名: SetAlwaysTop ' 機能 : ウィンドウを常に手前に表示する ' 引数 : (in) hWnd … 常に手前表示したいウィンドウのハンドル ' (in) IsTopMost … True:常に手前表示 False:常に手前表示解除 ' 戻り値: 正常:0以外、 エラー:0 '--------------------------------------------------------------------------- Public Function SetAlwaysTop(ByVal hWnd As Long, _ Optional ByVal IsTopMost As Boolean = True) As Long Dim udtRect As RECT 'ウインドウの座標を取得する Call GetWindowRect(hWnd, udtRect) '常に手前に表示する SetAlwaysTop = SetWindowPos(hWnd, _ IIf(IsTopMost, HWND_TOPMOST, HWND_NOTOPMOST), _ udtRect.Left, _ udtRect.Top, _ udtRect.Right - udtRect.Left, _ udtRect.Bottom - udtRect.Top, _ SWP_SHOWWINDOW) End Function
ついでに常に後ろに表示するサンプル。たちまちウィンドウが奥床しくなる。
Private Type WINDOWPOS hWnd As Long hWndInsertAfter As Long x As Long y As Long cx As Long cy As Long flags As Long End Type
'デフォルトのウィンドウ・プロシージャを呼ぶ
'ウィンドウの属性を設定する
'メモリコピー
Private Const HWND_BOTTOM As Long = 1 Public OldWindowhWnd As Long
'----------------------------------------------------------------------- ' 関数名 : SubClass ' 機能 : サブクラス化を開始する ' 引数 : (in) hWnd … コールバック対象となるウインドウのハンドル ' 戻り値 : なし '----------------------------------------------------------------------- Public Function SubClass(ByVal hWnd As Long) As Long OldWindowhWnd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc) SubClass = OldWindowhWnd End Function '----------------------------------------------------------------------- ' 関数名 : UnSubClass ' 機能 : サブクラス化を終了する ' 引数 : (in) hWnd … コールバック対象となるウインドウのハンドル ' 戻り値 : なし '----------------------------------------------------------------------- Public Sub UnSubClass(ByVal hWnd As Long) Dim FuncRet As Long If OldWindowhWnd <> 0 Then '元のプロシージャアドレスに設定する FuncRet = SetWindowLong(hWnd, GWL_WNDPROC, OldWindowhWnd) OldWindowhWnd = 0 End If End Sub '----------------------------------------------------------------------- ' 関数名:WindowProc ' 機 能:いわずとしれたウインドウプロシージャ '----------------------------------------------------------------------- Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Dim udtWinPos As WINDOWPOS Select Case uMsg Case WM_WINDOWPOSCHANGING Call CopyMemory(udtWinPos, ByVal lParam, Len(udtWinPos)) udtWinPos.hWndInsertAfter = HWND_BOTTOM Call CopyMemory(ByVal lParam, udtWinPos, Len(udtWinPos)) WindowProc = 0& Exit Function End Select WindowProc = CallWindowProc(OldWindowhWnd, hWnd, uMsg, wParam, lParam) End Function あとは例によって以下の実装。
Private Sub Form_Load() 'サブクラス化開始 Call SubClass(Me.hWnd) End Sub Private Sub Form_Unload(Cancel As Integer) 'サブクラス化終了 Call UnSubClass(Me.hWnd) End Sub |