質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.49%
VB.NET

Microsoft Visual Basic .NETのことで、Microsoft Visual Basic(VB6)の後継。 .NET環境向けのプログラムを開発することができます。 現在のVB.NETでは、.NET Frameworkを利用して開発を行うことが可能です。

Q&A

解決済

1回答

517閲覧

.NETでpictureBoxにマウスで四角を描画するプログラムを作成しています。

oikawasouta

総合スコア6

VB.NET

Microsoft Visual Basic .NETのことで、Microsoft Visual Basic(VB6)の後継。 .NET環境向けのプログラムを開発することができます。 現在のVB.NETでは、.NET Frameworkを利用して開発を行うことが可能です。

0グッド

0クリップ

投稿2022/09/28 10:14

.NETでpictureBoxに四角を描画するプログラムを作成しています。

やりたいこと
・pictureBoxにマウスで(Btndown→drag→BtnUp)の操作で四角を描画
・もう一度描画しようとしてBtndownすると前に描画したものが消えて新しく四角を描画

以上の動作をさせたいです。しかし、現状は四角が消えずに何個も描画できてしまう状態です。
pictureBoxを背景で上書きするなどの方法があるのでしょうか、、、考えてみたのですが、わからない
ため質問いたしました。どうぞよろしくお願いいたします。

イメージ説明

Public Class Form1 Private paths As New List(Of Drawing2D.GraphicsPath) Private mouseDownPosition As Point 'ドラッグを開始したマウスの位置 Private mouseDragPosition As Point '現在ドラッグ中のマウスの位置 Private isMouseDown As Boolean 'マウスのボタンが押されているか Private selectPen As Pen 'ドラッグ中の四角形の描画 Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load 'ドラッグ中の四角形の描画に使用するペンを作成。黄色のペンにする。 selectPen = New Pen(Color.Yellow, 1) selectPen.DashStyle = Drawing2D.DashStyle.Solid End Sub Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint '追加されている図形を描画する。 For Each path In paths e.Graphics.DrawPath(Pens.Yellow, path) '黄色い枠線 Next If Control.MouseButtons <> MouseButtons.Left Then 'マウスの左ボタンが押されていない場合何もしない Return End If 'ドラッグを開始したマウスの位置(mouseDownPosition)と現在ドラッグ中のマウスの位置(mouseDragPosition) 'から、描画すべき四角形の座標を計算する。 Dim activeRect As Rectangle = CalcActiveRect(mouseDownPosition, mouseDragPosition) 'ドラッグ中の四角形を描画 e.Graphics.DrawRectangle(selectPen, activeRect) End Sub Private Function CalcActiveRect(startPosition As Point, endPosition As Point) As Rectangle Dim activeRect As New Rectangle activeRect.X = Math.Min(mouseDownPosition.X, mouseDragPosition.X) activeRect.Y = Math.Min(mouseDownPosition.Y, mouseDragPosition.Y) activeRect.Width = Math.Abs(mouseDragPosition.X - mouseDownPosition.X) activeRect.Height = Math.Abs(mouseDragPosition.Y - mouseDownPosition.Y) Return activeRect End Function Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown 'マウスのボタンが押された場合 mouseDownPosition = e.Location isMouseDown = True End Sub Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove 'マウスを移動した場合 mouseDragPosition = e.Location PictureBox1.Invalidate() 'PictureBoxを強制的に再描画する End Sub Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp 'マウスを離した場合 If isMouseDown = True Then Dim activeRect As Rectangle = Me.CalcActiveRect(mouseDownPosition, mouseDragPosition) If activeRect.Width * activeRect.Height > 0 Then '面積がある場合、この四角形を描画対象に追加する。 Dim path As New Drawing2D.GraphicsPath() path.AddRectangle(activeRect) paths.Add(path) End If isMouseDown = False End If PictureBox1.Invalidate() 'PictureBoxを強制的に再描画する End Sub End Class

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

退会済みユーザー

退会済みユーザー

2022/09/28 11:53

何を何で作っているかぐらいは書けませんか? (例: Visual Studio 2022 で Windows Forms アプリをターゲットフレームワーク .NET Framework 4.8 で作っています)
oikawasouta

2022/09/28 12:19

ご指摘ありがとうございます。 Microsoft Visual Studio Community 2022 Version 17.2.2 Windows フォームアプリを.NET Framework 4.7.2で作成しています。 よろしくお願いいたします。
退会済みユーザー

退会済みユーザー

2022/09/28 12:25

質問欄の一行目に追加情報として追記願います。
KOZ6.0

2022/09/28 17:58 編集

>現状は四角が消えずに何個も描画できてしまう状態です。 どこかのサイトのコピペですか? わざわざそうなるように作ってあるようですが、それが理解できたら修正するのは容易と思います。
guest

回答1

0

自己解決

こちら別の質問の回答にて解決しました。
https://teratail.com/questions/496qcybpc4s1s8

回答くださった皆様ありがとうございました。

投稿2023/02/15 14:18

oikawasouta

総合スコア6

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.49%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問