ここから本文です
ベランダ菜園とWindows用アプリ作成とExcel用アプリ(アドイン)作成

書庫全体表示


マウスドラッグ移動で四角枠を表示して枠内のThumbを取得

イメージ 1


デザイン画面とXAML
イメージ 2
マウスの位置を取得するには背景色を指定する必要があるみたい
だけど色はいらないので透明色のTransparenを指定している

VBコード
イメージ 3

Imports System.Windows.Controls.Primitives

Class MainWindow
    Private syoki As Point '選択範囲枠の初期位置記録用
    Private IsDrag As Boolean 'canvas1上でマウスドラッグ移動判定用
    Private waku As Path '選択範囲枠
    Private tList As New List(Of Thumb) 'すべてのThumbを入れておくリスト

    '渡されたThumbを指定された位置に移動
    Private Sub SetLocate(ele As UIElement, p As Point)
        Canvas.SetLeft(ele, p.X)
        Canvas.SetTop(ele, p.Y)
    End Sub

    '渡されたThumbの位置を返す
    Private Function GetLocate(ele As UIElement) As Point
        Dim x As Double = Canvas.GetLeft(ele)
        Dim y As Double = Canvas.GetTop(ele)
        Return New Point(x, y)
    End Function

    'Thumbのドラッグ移動用
    Private Sub DragDelta(sender As Object, e As DragDeltaEventArgs)
        Dim t As Thumb = DirectCast(sender, Thumb)
        Dim p As Point = GetLocate(t)
        Dim nx As Double = e.HorizontalChange + p.X
        Dim ny As Double = e.VerticalChange + p.Y
        nx = nx - (nx Mod 20)
        ny = ny - (ny Mod 20)
        SetLocate(t, New Point(nx, ny))
    End Sub

    'Thumbを10個作成
    Private Sub AddThumb()
        Dim t As Thumb
        For i As Integer = 0 To 9
            t = New Thumb With {
                .Width = 60, .Height = 60, .Background = Brushes.Aqua}
            Canvas.SetLeft(t, i * 20) : Canvas.SetTop(t, i * 20 + 20)
            AddHandler t.DragDelta, AddressOf DragDelta
            tList.Add(t)
            canvas1.Children.Add(t)
        Next
    End Sub




    '選択範囲内のThumbの色を赤に変える
    'RectクラスのIntersectsWithメソッドを使う
    Private Sub SelectThumb()
        Dim sr As Rect = waku.Data.Bounds '枠のRect
        Dim tr As Rect
        For Each t As Thumb In tList
            tr = New Rect(GetLocate(t), t.RenderSize) 'ThumbのRect
            'ThumbのRectが枠のRectと重なっているか判定
            If tr.IntersectsWith(sr) Then
                '重なっていたら赤
                t.Background = Brushes.Red
            End If
        Next
    End Sub


    '選択範囲枠用のPathデータ作成
    Private Sub SetPathData(p As Point)
        Dim r As New Rect(syoki, p)
        Dim gp As New RectangleGeometry(r)
        waku.Data = gp
    End Sub

    'アプリ起動中
    Private Sub MainWindow_Initialized(sender As Object, e As EventArgs) Handles Me.Initialized
        Call AddThumb() 'Thumbを作成
    End Sub

    'アプリ起動完了後
    Private Sub MainWindow_ContentRendered(sender As Object, e As EventArgs) Handles Me.ContentRendered
        '範囲選択枠の設定
        waku = New Path With {.Stroke = Brushes.Red, .StrokeThickness = 1.0R}
    End Sub

    'canvas1上で左クリック時
    Private Sub canvas1_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles canvas1.MouseLeftButtonDown
        Dim c As Canvas = DirectCast(sender, Canvas)
        syoki = e.GetPosition(c)
        c.CaptureMouse()
        waku.Data = New RectangleGeometry() '枠データの初期化
        canvas1.Children.Add(waku)
        IsDrag = True
    End Sub

    'canvas1上でマウス移動時
    Private Sub canvas1_MouseMove(sender As Object, e As MouseEventArgs) Handles canvas1.MouseMove
        If IsDrag = False Then Return
        Dim imap As Point = e.GetPosition(canvas1)
        Call SetPathData(imap) '範囲選択枠データの更新
    End Sub

    'canvas1上で左クリック離した時
    Private Sub canvas1_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles canvas1.MouseLeftButtonUp
        If IsDrag = False Then Return
        Call SelectThumb() '選択範囲内のThumbを赤にする
        Dim c As Canvas = DirectCast(sender, Canvas)
        IsDrag = False
        c.ReleaseMouseCapture()
        canvas1.Children.Remove(waku) '選択範囲枠の消去
    End Sub

    'Thumbの色を初期化、アクアにする
    Private Sub bt1_Click(sender As Object, e As RoutedEventArgs) Handles bt1.Click
        For i As Integer = 0 To tList.Count - 1
            tList(i).Background = Brushes.Aqua
        Next
    End Sub
End Class



イメージ 4
syoki
枠の位置と大きさはマウスドラッグ移動開始位置と今の位置で決めるので
開始位置(初期位置)を記録しておく必要がある
IsDrag
マウスドラッグ移動中かどうかの判定用
waku
赤枠はPathで描く、マウスドラッグ移動による大きさ変更はPath.Dataの変更で行う
表示非表示の切り替えはChildren.Add(waku)とChildren.Remove(waku)で行う
tList
すべてのThumbの入れ物

渡されたUIElementの位置(Point)を返す
GetLocate
イメージ 10
ただ単にCanvas.GetLeftとCanvas.GetTopで取得した値を
Pointにして返しているだけ
今思ったけど3行も書かなくても
Return New Point(Canvas.GetLeft, Canvas.GetTop)
こう書けば1行で済むじゃん
1行で済むならわざわざメソッドにしなくても良さそうなんだけど
GetLeftもGetTopもタイプしづらい、GetLocateはタイプしやすい

Path.Dataの変更をする
SetPathDataメソッド
イメージ 7
渡された位置(p)と初期位置(syoki)を使って
サイズと位置を指定した四角形(Rect)を作成
四角形を使ってPathの四角形データになるRectangleGeometryを作成
waku(Path).Dataに四角形データを指定する


赤枠に少しでも触れているThumbすべてを取得して赤色に変える
SelectThumb
イメージ 9
48行目、Path.Data.Boundsで赤枠のRect(位置とサイズ)が取得できる
For Eachを使ってすべてのThumbと重なっている(触れている)かどうか判定
Thumbの位置はGetLocateで取得
サイズはRenderSizeプロパティから取得して
これを使ってRectを作成、51行目
枠のRectとThumbのRectを比較しているのが53行目で
RectクラスのIntersectsWithっていうメソッドを使っている
これが便利なもので渡した2つのRectが少しでも重なるようならTrueを返して
そうでなければFalseを返してくれる
55行目で赤色に変える



canvas1上で左クリック時(マウスドラッグ移動開始時)
イメージ 5
GetPositionメソッドでクリック位置の記録、78行目
81行目でcanvas1に枠表示されるけど80行目でデータが0になっているので実質的に非表示のはず
82行目はマウスドラッグ移動中ですよフラグ

マウス移動中
イメージ 6
マウスドラッグ移動中ではない状態ならなにもしないで終了
マウスドラッグ移動中なら
今のマウスの位置をGetPositionメソッドで取得して
SetPathDataへ渡してPath.Dataの変更(枠の大きさ変更)

canvas1上で左クリック離した時(マウスドラッグ移動終了時)
イメージ 8
左クリックを離したら赤枠に重なっているThumbを赤色にするために
SelectThumbメソッドを実行、93行目
赤枠の消去が97行目




グループ化するときにはどれをグループ化するのか複数の対象を選択する必要があるので作ってみた
マウスドラッグ移動で選択する他によくあるのはctrlキーを押しながらクリックとかあるけど難しそうなので見送ったw


今回のコード全部

関連記事、古い順
前回
WPFとVB.NET、エクセルのグループ化とグループ化解除を真似したい3 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14187560.html

平成28年6月8日追記
次回
WPFとVB.NET、エクセルのグループ化とグループ化解除を真似したい4 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14203583.html





この記事に

顔アイコン

顔アイコン・表示画像の選択

絵文字
×
  • オリジナル
  • SoftBank1
  • SoftBank2
  • SoftBank3
  • SoftBank4
  • docomo1
  • docomo2
  • au1
  • au2
  • au3
  • au4
  • 名前
  • パスワード
  • ブログ

開くトラックバック(0)

本文はここまでですこのページの先頭へ
みんなの更新記事