C# と VB.NET の質問掲示板

■No57375 (shu さん) に返信

線バージョン、マウスダウン→ドラッグで線を伸ばし、マウスアップで線確定

    Private m_img As Bitmap
    Private m_grp As Graphics
    Private m_blnDown As Boolean = False
    Private m_pt1 As Point
    Private m_pt2 As Point
    Private m_mouseButton As MouseButtons

    Public Sub New()
        ' この呼び出しはデザイナーで必要です。
        InitializeComponent()

        ' InitializeComponent() 呼び出しの後で初期化を追加します。
        m_img = 〜
        m_grp = Graphics.FromImage(m_img)
        PictureBox1.Image = m_img
    End Sub

    Private Sub Form1_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed
        m_grp.Dispose()
    End Sub

    Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
        If m_blnDown Then Exit Sub
        m_blnDown = True   '<--- MouseDownで描画開始
        m_pt1 = New Point(e.X, e.Y)
        m_mouseButton = e.Button
    End Sub

    Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
        If m_blnDown Then
            m_mouseButton = e.Button
            m_pt2 = New Point(e.X, e.Y)
            PictureBox1.Refresh()
        End If
    End Sub

    Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
        If Control.MouseButtons <> Windows.Forms.MouseButtons.None Then Exit Sub
        m_pt2 = New Point(e.X, e.Y)
        DrawLine(m_grp, True)
        m_blnDown = False   '<--- MouseUpで描画終了
        PictureBox1.Refresh()
    End Sub

    Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
        If Not m_blnDown Then Exit Sub
        Dim grp = e.Graphics
        DrawLine(grp, False)
    End Sub

    '--- DrawBackImage がTrueのときロードしたイメージに描画、FalseのときPictureBoxに描画
    Private Sub DrawLine(ByVal grp As Graphics, ByVal DrawBackImage As Boolean)
        Dim xDiff As Integer
        Dim yDiff As Integer
        Dim x1 As Integer
        Dim y1 As Integer
        Dim x2 As Integer
        Dim y2 As Integer
        Dim pen As Pen
        Dim sngPenWidth As Single

        If DrawBackImage Then
            xDiff = CInt((PictureBox1.Width - (m_img.Width * PictureBox1.Height / m_img.Height)) / 2)
            yDiff = CInt((PictureBox1.Height - (m_img.Height * PictureBox1.Width / m_img.Width)) / 2)

            If xDiff > 0 Then
                x1 = CInt((m_pt1.X - xDiff) * m_img.Height / PictureBox1.Height)
                y1 = CInt(m_pt1.Y * m_img.Height / PictureBox1.Height)
                x2 = CInt((m_pt2.X - xDiff) * m_img.Height / PictureBox1.Height)
                y2 = CInt(m_pt2.Y * m_img.Height / PictureBox1.Height)
                sngPenWidth = 5.0! * m_img.Height / PictureBox1.Height
            Else
                x1 = CInt(m_pt1.X * m_img.Width / PictureBox1.Width)
                y1 = CInt((m_pt1.Y - yDiff) * m_img.Width / PictureBox1.Width)
                x2 = CInt(m_pt2.X * m_img.Width / PictureBox1.Width)
                y2 = CInt((m_pt2.Y - yDiff) * m_img.Width / PictureBox1.Width)
                sngPenWidth = 5.0! * m_img.Width / PictureBox1.Width
            End If
        Else
            '--- PictureBox描画時は座標変換不要
            x1 = m_pt1.X
            y1 = m_pt1.Y
            x2 = m_pt2.X
            y2 = m_pt2.Y
            sngPenWidth = 5.0!
        End If

        '--- 線の太さを変更するためPenを作成。太さを変えない場合はPens.Redなどでよい
        If m_mouseButton = MouseButtons.Left Then
            pen = New Pen(Brushes.Red)
        ElseIf m_mouseButton = MouseButtons.Right Then
            pen = New Pen(Brushes.Blue)
        ElseIf m_mouseButton = (MouseButtons.Left Or MouseButtons.Right) Then
            pen = New Pen(Brushes.Magenta)
        Else
            Exit Sub
        End If
        '--- 線の太さ
        pen.Width = sngPenWidth
        '--- 線を引く
        grp.DrawLine(pen, x1, y1, x2, y2)
        '--- 線描画用のPenを破棄
        pen.Dispose()
    End Sub

ちなみにマウスダウン→ドラッグ中に次々と線をつなぐ場合は以下の部分を変更すれば良いです。

    Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
        If m_blnDown Then
            m_mouseButton = e.Button
            m_pt2 = New Point(e.X, e.Y)
            DrawLine(m_grp, True)       '<--- 追加
            PictureBox1.Refresh()
            m_pt1 = m_pt2　　　　　　　 '<--- 追加
        End If
    End Sub

    Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
        If Control.MouseButtons <> Windows.Forms.MouseButtons.None Then Exit Sub
        'm_pt2 = New Point(e.X, e.Y)       '<--- 削除
        'DrawLine(m_grp, True)             '<--- 削除
        m_blnDown = False   '<--- MouseUpで描画終了
        'PictureBox1.Refresh()             '<--- 削除
    End Sub

    '--- Paintイベントは削除
    'Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
    '    If Not m_blnDown Then Exit Sub
    '    Dim grp = e.Graphics
    '    DrawLine(grp, False)
    'End Sub