こんな
Option Strict On
Public Class Form1
Private _bmpUpper As Bitmap
Private _PointMouseDown As Point
Private _PointMouseUp As Point
Private _DrawFlg As Boolean
Private WithEvents pbxBase As PictureBox
Private WithEvents pbxUpper As PictureBox
Sub New()
' この呼び出しはデザイナーで必要です。
InitializeComponent()
' InitializeComponent() 呼び出しの後で初期化を追加します。
Me.Controls.Clear()
pbxBase = New PictureBox() With {.SizeMode = PictureBoxSizeMode.StretchImage, .Left = 10, .Top = 10, .Width = Me.ClientSize.Width - 20, .Height = Me.ClientSize.Height - 20}
pbxUpper = New PictureBox()
Me.Controls.Add(pbxBase)
Me.Controls.Add(pbxUpper)
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'背景画像表示
Dim bmpBase As Bitmap = New Bitmap("ppp.jpg")
'下層のPictureBox 画像表示
Me.pbxBase.Image = bmpBase
'上層のPictureBox 親コントロール指定
Me.pbxUpper.Parent = Me.pbxBase
'サイズ、位置設定
Me.pbxUpper.Size = Me.pbxBase.Size
Me.pbxUpper.Location = New Point(0, 0)
'描画用イメージオブジェクト作成
Me._bmpUpper = New Bitmap(Me.pbxBase.Width, Me.pbxBase.Height)
'透過色指定
Me._bmpUpper.MakeTransparent(Color.White)
'背景透過
Me.pbxUpper.BackColor = Color.Transparent
End Sub
''' <summary>
''' 上層PictureBox マウスダウン時イベント
''' </summary>
Private Sub pbxUpper_MouseDown(sender As Object, e As MouseEventArgs) Handles pbxUpper.MouseDown
Me._DrawFlg = True
Me._PointMouseDown.X = e.X
Me._PointMouseDown.Y = e.Y
Me._PointMouseUp.X = e.X
Me._PointMouseUp.Y = e.Y
End Sub
''' <summary>
''' 上層PictureBox マウスアップ時イベント
''' </summary>
Private Sub pbxUpper_MouseUp(sender As Object, e As MouseEventArgs) Handles pbxUpper.MouseUp
Draw(CType(sender, PictureBox), e)
Me._DrawFlg = False
End Sub
''' <summary>
''' 上層PictureBox マウス移動時イベント
''' </summary>
Private Sub pbxUpper_MouseMove(sender As Object, e As MouseEventArgs) Handles pbxUpper.MouseMove
If Me._DrawFlg = False Then
Return
End If
Draw(CType(sender, PictureBox), e)
End Sub
Private Sub Draw(ByVal pb As PictureBox, ByVal e As MouseEventArgs)
Dim penCurrent As Point = New Point()
Dim pointStart As Point = New Point()
Dim pointEnd As Point = New Point()
penCurrent.X = e.X
penCurrent.Y = e.Y
Me.GetRegion(Me._PointMouseDown, penCurrent, pointStart, pointEnd)
Me.DrawRegion(Me._bmpUpper, pointStart, pointEnd, Color.DarkCyan, Drawing2D.DashStyle.Solid)
pb.Image = Me._bmpUpper
End Sub
Private Sub GetRegion(ByVal pdown As Point, ByVal pup As Point, ByRef pstart As Point, ByRef pend As Point)
pstart = New Point(Math.Min(pdown.X, pup.X), Math.Min(pdown.Y, pup.Y))
pend = New Point(Math.Max(pdown.X, pup.X), Math.Max(pdown.Y, pup.Y))
End Sub
Private Sub DrawRegion(ByVal bmp As Bitmap, ByVal pstart As Point, ByVal pend As Point, ByVal c As Color, ByVal dash As Drawing2D.DashStyle)
Using g As Graphics = Graphics.FromImage(bmp)
g.FillRectangle(Brushes.White, 0, 0, bmp.Width, bmp.Height)
Dim pen As New Pen(New SolidBrush(c), 2)
pen.DashStyle = dash
Dim rectangle As Rectangle = New Rectangle(pstart.X, pstart.Y, pend.X - pstart.X, pend.Y - pstart.Y)
g.DrawRectangle(pen, rectangle)
End Using
bmp.MakeTransparent(Color.White) 'これを忘れてる？
End Sub
End Clas
個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)
