点線矩形の描き方
|
標準のコマンドボタンにフォーカスがあるときボタンの周りに点線矩形があるのを見たことがあるでしょう。 Ｗｉｎｄｏｗｓではフォーカス移動によってアクティブになるコントロールに DrawFocusRect() API で矩形を描いています。 この DrawFocusRect() API は一回の発行で点線を描きますが、同じ矩形領域にもう一度発行することによって 点線矩形を消去します。（恐らく Xor Pen を使っているのでしょう） フォームの MouseMove イベントでフォームを移動するときのフォームの周囲にこの API で矩形を描いてみます。 フォームモジュールに貼り付けて実行して見てください。 *----*----*----*----*----*----*----*----*----*----*----*----*----* Option Explicit Private Const 線の幅 As Long = 5 'この値を変えると線幅が変更されます Private Type POINTAPI x As Long y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long Private bMouse As Boolean Private ptMouse As POINTAPI Private rcForm As RECT Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If (Button And vbLeftButton) <> vbLeftButton Then Exit Sub 'スクリーン座標でのマウス位置を取得します GetCursorPos ptMouse 'フォームの大きさを取得します GetWindowRect Me.hWnd, rcForm bMouse = False End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) If (Button And vbLeftButton) <> vbLeftButton Then Exit Sub Dim i&, dc&, pt As POINTAPI, rc As RECT If bMouse Then 'ここでの DrawFocusRect() は前に行った点線矩形を消します dc = GetDC(0) LSet rc = rcForm For i = 0 To 線の幅 - 1 DrawFocusRect dc, rc InflateRect rc, -1, -1 Next ReleaseDC 0, dc End If '移動されたマウス位置を取得します GetCursorPos pt rcForm.Left = rcForm.Left + pt.x - ptMouse.x rcForm.Top = rcForm.Top + pt.y - ptMouse.y rcForm.Right = rcForm.Right + pt.x - ptMouse.x rcForm.Bottom = rcForm.Bottom + pt.y - ptMouse.y 'デスクトップの hdc を取得します dc = GetDC(0) 'フォームの周りに点線矩形を描画します LSet rc = rcForm For i = 0 To 線の幅 - 1 DrawFocusRect dc, rc InflateRect rc, -1, -1 Next '使い終わった dc は元に戻します ReleaseDC 0, dc LSet ptMouse = pt bMouse = True End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If (Button And vbLeftButton) = vbLeftButton Then If bMouse Then Dim i&, dc&, rc As RECT 'ここでの DrawFocusRect() は前に行った点線矩形を消します dc = GetDC(0) LSet rc = rcForm For i = 0 To 線の幅 - 1 DrawFocusRect dc, rc InflateRect rc, -1, -1 Next ReleaseDC 0, dc '確定した位置(マウスが離された位置)にフォームを移動します Me.Move rcForm.Left * Screen.TwipsPerPixelX, rcForm.Top * Screen.TwipsPerPixelY End If End If If (Button And vbRightButton) = vbRightButton Then Unload Me End If End Sub Private Sub Form_Paint() Me.CurrentX = Me.TextWidth("W") * 2 Me.CurrentY = Me.TextWidth("W") * 1 Me.Print "・フォームを移動中にフォームの周囲に点線を描画します。" Me.CurrentX = Me.TextWidth("W") * 2 Me.CurrentY = Me.TextWidth("W") * 3 Me.Print "・マウスの左ボタンをドラッグしフォームを移動してみて下さい。" Me.CurrentX = Me.TextWidth("W") * 2 Me.CurrentY = Me.TextWidth("W") * 5 Me.Print "・マウスの右ボタンをクリックすると終了します。" End Sub |
動作確認
Windows95 + Visual Basic 5このサンプルを使用しての感想や、質問は 掲示板や、 らくがき帳に書きとめて頂けるとうれしいです。