WPFとVB.NET、エクセルのグループ化とグループ化解除を真似したい5

グループ化テストの続き

テストのテスト

グループ化後の回転

エクセルの場合

グループの中心が回転軸になっている

これを真似したい

同じ色どうしがグループ化されていると見倣して、グループを回転させた時の動作

水色のThumbの回転軸は自身の中心

桃色のThumbの回転軸も自身の中心だけど、回転軸のセットを押すと2つのThumbの中央に切り替わる、エクセルと同じなのはこちら

デザイン画面とXAML

f:id:gogowaten:20191030123640p:plain

VBコード

f:id:gogowaten:20191030123650p:plain

Imports System.Windows.Controls.Primitives


Class MainWindow
    Private g1 As New List(Of Thumb) 'グループ1
    Private g2 As New List(Of exThumb) 'グループ2

    '中心点位置取得
    Private Function GetCenterPoint(t As Thumb) As Point
        Dim gt As GeneralTransform = t.TransformToVisual(canvas1)
        Dim cp As New Point(t.Width / 2, t.Height / 2)
        Dim np As Point = gt.Transform(cp)
        Return np
    End Function

    Private Sub SetLocate(t As Thumb, p As Point)
        Canvas.SetLeft(t, p.X)
        Canvas.SetTop(t, p.Y)
    End Sub

    'RenderTransform用のTransformGroup
    Private Function GetTransformGroup() As TransformGroup
        Dim tg As New TransformGroup
        With tg.Children
            '追加する順番大事
            .Add(New ScaleTransform(1, 1))
            .Add(New SkewTransform)
            .Add(New RotateTransform(0))
            .Add(New TranslateTransform)
        End With
        Return tg
    End Function

    'Thumbを配置
    Private Function AddThumb(p As Point) As Thumb
        Dim t As New Thumb
        With t
            .Width = 50
            .Height = 50
            .Background = Brushes.Cyan
            .RenderTransform = GetTransformGroup()
            .RenderTransformOrigin = New Point(0.5, 0.5)
        End With
        Call SetLocate(t, p)
        canvas1.Children.Add(t)
        Return t
    End Function

    'ExThumbを配置
    Private Function AddexThumb(p As Point) As exThumb
        Dim t As New exThumb
        With t
            .Width = 50
            .Height = 50
            .Background = Brushes.Pink
            .RenderTransform = GetTransformGroup()
            .RenderTransformOrigin = New Point(0.5, 0.5)
        End With
        Call SetLocate(t, p)
        canvas1.Children.Add(t)
        Return t
    End Function

    'exThumbのRect取得
    Private Function GetRect(t As exThumb) As Rect
        Dim gt As GeneralTransform = t.TransformToVisual(canvas1)
        Dim r As Rect = gt.TransformBounds(New Rect(New Size(t.Width, t.Height)))
        Return r
    End Function

    '渡されたすべてのRectが収まるRectを取得
    Private Function GetGroupRect(rl As List(Of Rect)) As Rect
        '左上と右下の座標を探す、これで位置とサイズが分かる
        Dim minX As Double = rl(0).X
        Dim minY As Double = rl(0).Y
        Dim maxX As Double = minX + rl(0).Width
        Dim maxY As Double = minY + rl(0).Height
        Dim r As Rect
        For i As Integer = 1 To rl.Count - 1
            r = rl(i)
            minX = Math.Min(minX, r.X)
            minY = Math.Min(minY, r.Y)
            maxX = Math.Max(maxX, r.X + r.Width)
            maxY = Math.Max(maxY, r.Y + r.Height)
        Next
        '座標からRect作成
        r = New Rect(minX, minY, maxX - minX, maxY - minY)
        Return r
    End Function


    Private Sub haiti()
        '各Thumbを配置
        g1.Add(AddThumb(New Point(50, 100)))
        g1.Add(AddThumb(New Point(150, 100)))

        g2.Add(AddexThumb(New Point(300, 100)))
        g2.Add(AddexThumb(New Point(400, 100)))

    End Sub


    'アプリ起動して描画完了後
    Private Sub MainWindow_ContentRendered(sender As Object, e As EventArgs) Handles Me.ContentRendered
        Call haiti()
    End Sub

    '普通に回転
    Private Sub bt1_Click(sender As Object, e As RoutedEventArgs) Handles bt1.Click
        For Each t As Thumb In g1
            Dim ro As New RotateTransform(15) '15度回転
            Dim tg As TransformGroup = t.RenderTransform
            tg.Children.Add(ro)
        Next
    End Sub

    'グループ化後の範囲を考慮して回転
    Private Sub bt2_Click(sender As Object, e As RoutedEventArgs) Handles bt2.Click
        For Each t As exThumb In g2
            '回転軸を指定して15度回転
            Dim ro As New RotateTransform(15, t.TransformAxis.X, t.TransformAxis.Y)
            Dim tg As TransformGroup = t.RenderTransform
            tg.Children.Add(ro)
        Next
    End Sub


    '回転軸のセット
    Private Sub bt3_Click(sender As Object, e As RoutedEventArgs) Handles bt3.Click
        Dim rl As New List(Of Rect)
        For Each t As exThumb In g2
            '中心点のセット
            t.CenterPoint = GetCenterPoint(t)
            rl.Add(GetRect(t))
        Next
        Dim r As Rect = GetGroupRect(rl)
        Dim x As Double = r.Width / 2 + r.Left
        Dim y As Double = r.Height / 2 + r.Top
        Dim cp As New Point(x, y) 'グループ化後の中心点
        'グループ化後の回転軸のセット
        For Each t As exThumb In g2
            t.GroupCenterPoint = cp
            Dim np As Point = t.GroupCenterPoint - t.CenterPoint
            t.TransformAxis = np '回転軸のセット
        Next
    End Sub


    Private Sub bt4_Click(sender As Object, e As RoutedEventArgs) Handles bt4.Click
        g1.Clear()
        g2.Clear()
        canvas1.Children.RemoveRange(0, 4)
        haiti()
    End Sub
End Class


Public Class exThumb
    Inherits Thumb
    Public Property CenterPoint As Point '自身の中心点
    Public Property GroupCenterPoint As Point 'グループ範囲の中心点
    'グループ化後の範囲を考慮して回転するときに使う回転軸用
    Public Property TransformAxis As Point

End Class