WPFとVB.NET、エクセルのグループ化を真似したいからまずはグループ化のRectを取得

Imports System.Windows.Controls.Primitives


Class MainWindow
    Private thumbList As New List(Of Thumb)
    Private waku As Path '枠

    'Thumbをcanvas1に追加表示
    Private Sub AddThumb(p As Point, s As Size, angle As Double)
        Dim t As New Thumb
        With t
            .Width = s.Width
            .Height = s.Height
            .RenderTransform = New RotateTransform(angle)
        End With
        Call SetLocate(t, p)
        thumbList.Add(t)
        canvas1.Children.Add(t)
        AddHandler t.DragDelta, AddressOf ThumbDragDelta

    End Sub

    'Thumbの座標セット
    Private Sub SetLocate(t As Thumb, p As Point)
        Canvas.SetLeft(t, p.X)
        Canvas.SetTop(t, p.Y)
    End Sub

    'Thumbの座標ゲット
    Private Function GetLocate(t As Thumb) As Point
        Return New Point(Canvas.GetLeft(t), Canvas.GetTop(t))
    End Function

    'Thumbのマウスドラッグイベント用
    Private Sub ThumbDragDelta(sender As Object, e As DragDeltaEventArgs)
        Dim t As Thumb = DirectCast(sender, Thumb)
        Dim np As New Point(e.HorizontalChange, e.VerticalChange)
        np = np + GetLocate(t)
        Call SetLocate(t, np)
    End Sub

    '渡されたThumbがぴったり収まるRectを返す
    Private Function GetRect(t As Thumb) As Rect
        Dim gt As GeneralTransform = t.TransformToVisual(canvas1)
        Dim r As Rect = gt.TransformBounds(
            New Rect(New Point(0, 0), New Size(t.Width, t.Height)))
        Return r
    End Function

    '渡されたThumbすべてがぴったり収まるRectを返す
    'RectのUnionメソッドを使う
    Private Function GetUnionRect(thumbList As List(Of Thumb)) As Rect
        Dim r As New Rect
        Dim ur As New Rect 'すべてのRectがぴったり収まるRect用
        Dim rl As New List(Of Rect) '左上座標取得用
        For Each t As Thumb In thumbList
            r = GetRect(t)
            rl.Add(r)
            ur.Union(r)
        Next
        Dim p As Point = GetLeftTop(rl) '左上座標取得
        ur.Location = ur.Location + p '座標変更
        'サイズ変更
        ur.Size = New Size(ur.Width - p.X, ur.Height - p.Y)
        Return ur

    End Function

    '複数Rectの一番左上取得
    Private Function GetLeftTop(rectList As List(Of Rect)) As Point
        Dim x As Double = rectList(0).X
        Dim y As Double = rectList(0).Y
        For i As Integer = 1 To rectList.Count - 1
            x = Math.Min(x, rectList(i).X)
            y = Math.Min(y, rectList(i).Y)
        Next
        Return New Point(x, y)
    End Function

    '赤枠描画
    Private Sub DrawRectPath(r As Rect)
        '前回の枠があったら消す
        If waku IsNot Nothing Then
            canvas1.Children.Remove(waku)
        End If
        '新しい赤枠描画
        Dim p As New Path With {.Stroke = Brushes.Red, .StrokeThickness = 1}
        Dim g As New RectangleGeometry(r)
        p.Data = g
        canvas1.Children.Add(p)
        waku = p
    End Sub

    'アプリ起動直後、Thumbを表示する
    Private Sub MainWindow_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
        Call AddThumb(New Point(80, 10), New Size(100, 100), 10)
        Call AddThumb(New Point(180, 50), New Size(50, 100), 30)
        Call AddThumb(New Point(200, 100), New Size(120, 100), 20)
    End Sub

    'グループ化した場合のRect表示
    Private Sub bt1_Click(sender As Object, e As RoutedEventArgs) Handles bt1.Click
        Dim ur As Rect = GetUnionRect(thumbList)
        Call DrawRectPath(ur)
    End Sub

End Class

Wpf_test118_グループ化3 - Visual Studio Team Services
https://gogowaten.visualstudio.com/WPF/_git/WPF_test7?path=%2FWpf_test118_%E3%82%B0%E3%83%AB%E3%83%BC%E3%83%97%E5%8C%963&version=GBmaster&_a=contents