４．マウスのドラッグで範囲選択枠をトップレベルで表示(37_Mos_04)　(旧、SampleNo.000)

１．はじめに ２．マウスのドラッグで範囲選択枠をトップレベルで表示 ３． ４． ５． ６．

下記プログラムコードに関する補足・注意事項　 動作確認：Windows 8.1 (Windows 7) / VB2013 (VB2010) / Framework 4.5.1 / 対象の CPU：x86 Option　：[Compare Text] [Explicit On] [Infer On] [Strict On] Imports ：追加なし 参照設定：追加なし 使用コン：Form1 / Form2 / PictureBox1 / PictureBox1 上にコントロールを配置(下図参照) トロール： このサンプル等の内容を無断で転載、掲載、配布する事はお断りします。(私の修正・改訂・削除等が及ばなくなるので) 必要ならリンクをはるようにして下さい。(引用の場合は引用元のリンクを明記して下さい)

１．はじめに

マウスのドラックで範囲を選択 - 貴将 15/03/26-10:10No.11372 上記、掲示板の質問に答えて試しに作って見たもので、当サイトに記載のマウスのドラッグで範囲を選択し画像を取得して他のピクチャーボックスに表示 や microsoft のサイトに記載の透過に対応したユーザーコントロールを作成する方法 では、下記のようにコントロール類が背面に隠れてしまったり、コントロール上には描画できなかったりしますのでそれではまずいということで、いろいろ試した結果下記のような方法が一番簡単ではないかと思い作ったサンプルです。 　図１．上記 MS のサンプルでのテスト結果

２．マウスのドラッグで範囲選択枠をトップレベルで表示

下記コードは、当サイトに掲載中のサンプルをつなぎ合わせたものです。 ---------- Form1 上のコード ---------- Public Class Form1 Private f2 As Form2 '下記、ドラッグ中の赤枠の表示のコードは、マウスのドラッグで範囲を選択し画像を取得して他のピクチャーボックスに表示(31_Gra_03)を利用 ' http://hanatyan.sakura.ne.jp/vb2005/vb2013graphics03.htm Private sPos As MouseEventArgs  'マウスのドラッグの開始点 Private ePos As MouseEventArgs  'マウスのドラッグの終了点 Private oPos As MouseEventArgs  '前回のマウス位置 Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown     If e.Button = System.Windows.Forms.MouseButtons.Left Then         If Not (f2 Is Nothing) Then             f2.Close()         End If         '開始点の取得         sPos = e         ePos = e         oPos = e     End If End Sub Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove     'マウスのドラッグで線を引く     If e.Button = System.Windows.Forms.MouseButtons.Left Then         Using g As Graphics = PictureBox1.CreateGraphics()             Using BPen As New Pen(Color.Red, 1)                 BPen.DashStyle = Drawing2D.DashStyle.Solid                 If (oPos.X <> e.X) Or (oPos.Y <> e.Y) Then                     Dim nLoca As New Point                     Dim nSize As New Size                     'Location Point を変換(どの方向から描画しても表示できるように)                     If sPos.X <= e.X Then                         nLoca.X = sPos.X                     Else                         nLoca.X = e.X                     End If                     If sPos.Y <= e.Y Then                         nLoca.Y = sPos.Y                     Else                         nLoca.Y = e.Y                     End If                     nSize = New Size(Math.Abs(e.X - sPos.X), Math.Abs(e.Y - sPos.Y))                    '-------- 赤枠を描画する替わりに Form2 を表示する --------                     'PictureBox1 のスクリーン座標を求める                     Dim Cpos As Point = PictureBox1.ClientRectangle.Location                     Dim SCpos As Point = PictureBox1.PointToScreen(Cpos)                     'f2 が複数起動されないように設定                     If f2 Is Nothing OrElse f2.IsDisposed Then                         'f2 = New myShape1                         f2 = New Form2                     End If                     f2.FormBorderStyle = Windows.Forms.FormBorderStyle.None                     f2.ShowInTaskbar = False                     f2.Show()                     'f2 を表示してから位置とサイズを指定の事                     f2.Location = New Point(SCpos.X + nLoca.X, SCpos.Y + nLoca.Y)                     f2.Size = nSize                     '------------------------------------------------------------                     ePos = e                     oPos = e                 End If             End Using         End Using     End If End Sub Private Sub Form1_Move(sender As Object, e As EventArgs) Handles Me.Move 'Form1 が移動された場合、f2 を閉じる     If Not (f2 Is Nothing) Then         f2.Close()     End If End Sub End Class ---------- Form2 上のコード ---------- Public Class Form2 Private Sub Form2_Resize(sender As Object, e As EventArgs) Handles Me.Resize     If Me.Width > 2 And Me.Height > 2 Then         '四角形と円形を描画のコードを流用         'http://www.hanatyan.sakura.ne.jp/vb2005/vb2013graphics01.htm#no3         Dim meRect As Rectangle = New Rectangle(New Point(2, 2), New Size(Me.Width - 4, Me.Height - 4))         Dim bmp As Bitmap = New Bitmap(Me.Width, Me.Height)         Using g As Graphics = Graphics.FromImage(bmp)             'Form の外形に赤枠(四角形)を表示             g.DrawRectangle(New Pen(Color.Red, 3), meRect)         End Using         Me.BackgroundImage = bmp         'Form の背景色を透明に設定(コントロールの背景を透明にする(14_Ctr_03)のコードを流用)         'http://www.hanatyan.sakura.ne.jp/vb2005/vb2013controlcommon03.htm         Me.TransparencyKey = ColorTranslator.FromWin32(Microsoft.VisualBasic.RGB(254, 254, 254))         Me.BackColor = ColorTranslator.FromWin32(Microsoft.VisualBasic.RGB(254, 254, 254))         Me.TopMost = True     End If End Sub '複数フォームの上下(Zオーダー)を保つ方法(VB.NET)を流用 'http://hanatyan.sakura.ne.jp/patio/read.cgi?mode=view2&f=290&no=0 Private Declare Function GetForegroundWindow Lib "user32" () As IntPtr Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)    Select Case m.Msg       Case &H6, &H1C          Dim hActv As IntPtr = GetForegroundWindow()          If hActv = Form1.Handle Or hActv = Me.Handle Then             Me.TopMost = True          Else             Me.TopMost = False          End If       Case Else    End Select    MyBase.WndProc(m) End Sub End Class 　図２．上記実行結果 　 尚、別途、境界線のないフォームでサイズ変更及び移動可能に設定(34_Frm_11) (旧、SampleNo.296) のコードを追加使用すると枠を描画後、サイズ変更及び枠のドラッグでの移動もできます。(37_Mos_09 の実サンプルではそのように設定しております。)

３．

４．

５．

６．

検索キーワード及びサンプルコードの別名(機能名)