VB Tips Vol.01
フォームを常に手前に表示する・移動する
フォームを常に手前に表示するにはSetWindowPosを利用します。ここでは、タイトルバーの無いフォームをマウスのボタンが押されたフォーム上の座標と移動後のフォーム上の座標の差を計算してその分だけ移動するようにしています。
| Private Declare Function SetWindowPos
Lib _ "user32.dll" (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 SWP_NOMOVE = &H2 Private Const SWP_NOSIZE = &H1 Private Const HWND_TOPMOST = -1 Private Const HWND_NOTOPMOST = -2 Private Clicked As Boolean 'ボタンが押されているか Private fx As Single 'ボタンを押したときの位置 Private fy As Single 'ボタンを押したときの位置 Private Sub Command1_Click() Unload Me End Sub Private Sub Form_Load() Clicked = False '常に手前に表示します 'しない場合はHWND_TOPMOSTをHWND_NOTOPMOSTにする SetWindowPos Form1.hwnd, HWND_TOPMOST, _ 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) SetPos x, y End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) MoveWindow x, y End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Clicked = False End Sub Private Sub MoveWindow(x As Single, y As Single) If Clicked = True Then Me.Move Me.Left + (x - fx), Me.Top + (y - fy) '下の2行でも同じです 'Me.Left = Me.Left + (x - fx) 'Me.Top = Me.Top + (y - fy) End If End Sub Private Sub SetPos(x As Single, y As Single) 'クリック時のフォーム上の位置を記憶します Clicked = True fx = x fy = y End Sub |
サンプルプログラムのダウンロード(5.97KB)
※このページの内容とサンプルプログラムのコードは多少異なる場合があります。