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

グループ化の続き

前回と前々回のを足して

グループ化したいThumbをマウスのドラッグで範囲選択してグループ化と解除

ここまでできた

 

グループ化テスト

青枠はグループの枠でただの目印

 

回転角度と拡大率指定のスライダーはまだ動かせない、これができたらテストはほぼ終了なんだけどねえ

 

デザイン画面とXAML

 

 

2019/10/30追記ここから

<Window x:Class="MainWindow"
        xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
        xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
        xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
        xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
        xmlns:local="clr-namespace:Wpf_test126_グループ化9"
        mc:Ignorable="d"
        Title="MainWindow" Height="350" Width="525">
  <Grid>
    <DockPanel>
      
      <StatusBar DockPanel.Dock="Bottom">
        <TextBlock x:Name="tbk1" Text="focusThumb = " Margin="2,0"/>
        <TextBlock x:Name="tbk2" Text="focusGroup = " Margin="2,0"/>
      </StatusBar>
      
      <StatusBar DockPanel.Dock="Top">
        <Button x:Name="bt1" Content="選択をグループ化"/>
        <Button x:Name="bt2" Content="選択グループを解除"/>
      </StatusBar>

      <StatusBar DockPanel.Dock="Top">
        <TextBlock Text="角度"/>
        <TextBlock Text="{Binding ElementName=sldAngle, Path=Value, StringFormat=00}"/>
        <Slider x:Name="sldAngle" SmallChange="10" LargeChange="10" TickFrequency="10"
                Maximum="90" Minimum="0" Width="90"
                IsSnapToTickEnabled="True"/>
        <TextBlock Text="拡大率横"/>
        <TextBlock Text="{Binding ElementName=sldX, Path=Value, StringFormat=0.0}"/>
        <Slider x:Name="sldX" SmallChange="0.1" LargeChange="0.1" TickFrequency="0.1"
                Maximum="2" Minimum="0.5" Width="100" Value="1"
                IsSnapToTickEnabled="True"/>
        <TextBlock Text="拡大率縦"/>
        <TextBlock Text="{Binding ElementName=sldY, Path=Value, StringFormat=0.0}"/>
        <Slider x:Name="sldY" SmallChange="0.1" LargeChange="0.1" TickFrequency="0.1"
                Maximum="2" Minimum="0.5" Width="100" Value="1"
                IsSnapToTickEnabled="True"/>

      </StatusBar>
      
      <Canvas x:Name="canvas1" Background="AliceBlue"/>
    </DockPanel>
  </Grid>
</Window>

追記ここまで

 

VBコード 

今回はコードの文字数がブログの上限を超えてしまったので画像だけ

コピペ用コードはいつものところで

 

2019/10/30追記ここから

Imports System.Windows.Controls.Primitives


Class MainWindow
    Private tList2 As New List(Of ExThumb2) '全Thumbのリスト
    Private Const grid As Integer = 20 'グリッドの大きさ
    '選択範囲用ここから
    Private syoki As Point '選択範囲枠の初期位置記録用
    Private IsDrag As Boolean 'canvas1上でマウスドラッグ移動判定用
    Private waku As Path '選択範囲枠
    Private SelectionThumb As New List(Of ExThumb2) '選択範囲枠内のThumbを入れておく
    '選択範囲用ここまで

    '選択中のExThumb
    Private Property _ActiveThumb As ExThumb2
    Private Property ActiveThumb As ExThumb2 '選択中のThumb
        Get
            Return _ActiveThumb
        End Get
        Set(value As ExThumb2)
            '範囲選択を解除する
            Call ReleaceSelection()
            '前回のActiveThumbがあれば
            If _ActiveThumb IsNot Nothing Then
                If _ActiveThumb.GroupTop Is Nothing Then
                    '単体の時
                    Call ClealBinding(_ActiveThumb)
                Else
                    'グループに属している時
                    For Each t As ExThumb2 In _ActiveThumb.GroupTop.AllItems
                        Call ClealBinding(t)
                    Next
                End If

            End If
            '今回のが
            If value.GroupTop Is Nothing Then
                '単体
                Call ChangeBinding2(value)
            Else
                'グループに属している
                For Each t As ExThumb2 In value.GroupTop.AllItems
                    Call ChangeBinding2(t)
                Next

            End If
            _ActiveThumb = value
            ActiveGroup = value.GroupTop
            Call StatusUpdate(value)
        End Set

    End Property

    '選択Thumbが属しているグループ
    Private Property _ActiveGroup As Group2
    Private Property ActiveGroup As Group2
        Get
            Return _ActiveGroup
        End Get
        Set(value As Group2)
            If _ActiveGroup IsNot Nothing Then
                canvas1.Children.Remove(_ActiveGroup.Waku)
            End If
            _ActiveGroup = value
            If value IsNot Nothing Then
                canvas1.Children.Add(value.Waku)
            End If
        End Set
    End Property




    'ステータスバー表示更新
    Private Sub StatusUpdate(value As ExThumb2)
        tbk1.Text = "FocusThumb = " & value.Name
        If value.GroupTop IsNot Nothing Then
            tbk2.Text = "FocusGroup = " & value.GroupTop.aName
        Else
            tbk2.Text = "FocusGroup = Nothing"
        End If
    End Sub

    'ExThumbの座標セット
    Private Sub SetLocate(obj As UIElement, p As Point)
        Canvas.SetLeft(obj, p.X)
        Canvas.SetTop(obj, p.Y)
    End Sub
    'ExThumbの座標ゲット
    Private Function GetLocate(obf As UIElement) As Point
        Return New Point(Canvas.GetLeft(obf), Canvas.GetTop(obf))
    End Function
    'ExThumbのマウスドラッグイベント用
    Private Sub ThumbDragDelta(sender As Object, e As DragDeltaEventArgs)
        'グリッドスナップ移動
        Dim t As ExThumb2 = DirectCast(sender, ExThumb2)
        Dim x As Double = e.HorizontalChange
        Dim y As Double = e.VerticalChange
        x -= x Mod grid
        y -= y Mod grid

        Dim np As New Point(x, y)

        If t.GroupTop IsNot Nothing Then
            'グループ用
            'Boundの更新
            Dim r As Rect = t.GroupTop.Bound
            r.Offset(x, y)
            t.GroupTop.Bound = r
            'グループ内すべてのThumbの移動
            For Each tt As ExThumb2 In t.GroupTop.AllItems
                Call SetLocate(tt, GetLocate(tt) + np)
            Next
        Else
            '単体用
            Call SetLocate(t, GetLocate(t) + np)
        End If
    End Sub
    Private Sub ThumbDragCompleted(sender As Object, e As DragCompletedEventArgs)

    End Sub
    'ExThumbのマウスクリックイベント用
    Private Sub FocusThumb_PreviewMouseDown(sender As Object, e As MouseButtonEventArgs)
        'FocusThumbの切り替え
        Dim t As ExThumb2 = DirectCast(sender, ExThumb2)
        ActiveThumb = t
    End Sub



    '選択範囲用ここから
    '選択範囲内のThumbすべてを返す
    'RectクラスのIntersectsWithメソッドを使う
    Private Function GetSelectThumb() As List(Of ExThumb2)
        Dim sr As Rect = waku.Data.Bounds '枠のRect
        Dim tr As Rect
        Dim tl As New List(Of ExThumb2)
        For Each t As ExThumb2 In tList2
            tr = New Rect(GetLocate(t), t.tCanvas.RenderSize) 'ThumbのRect
            'ThumbのRectが枠のRectと重なっているか判定
            If tr.IntersectsWith(sr) Then
                tl.Add(t)
            End If
        Next
        '同じグループ内のThumbも全て取得
        Dim al As List(Of ExThumb2) = GetAllThumb(tl)
        Return al
    End Function
    Private Sub ChangeColor(c As Color)
        For Each t As ExThumb2 In SelectionThumb
            t.tCanvas.Background = New SolidColorBrush(c)
        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 AddExThumb2(count As Integer)
        '10個ExThumb2作成
        For i As Integer = 0 To count
            Dim t As New ExThumb2(i, New Size(grid * 4, grid * 4))

            SetLocate(t, New Point(grid * i, grid * i))
            canvas1.Children.Add(t)
            tList2.Add(t)
            AddHandler t.DragDelta, AddressOf ThumbDragDelta
            'AddHandler t.DragCompleted, AddressOf ThumbDragCompleted
            AddHandler t.PreviewMouseDown, AddressOf FocusThumb_PreviewMouseDown
            ActiveThumb = t
        Next
    End Sub
    'ExThumbリストの中のすべてのGroup取得、重複除く、Nothing除く
    Private Function GetAllGroup(tl As List(Of ExThumb2)) As List(Of Group2)
        Dim gl As New List(Of Group2)
        For Each t As ExThumb2 In tl
            If t.GroupTop IsNot Nothing Then
                gl.Add(t.GroupTop)
            End If
        Next
        gl = gl.Distinct.ToList
        Return gl

    End Function
    '渡されたThumbが属するグループに含まれるThumbすべてを返す
    Private Function GetAllThumb(tl As List(Of ExThumb2)) As List(Of ExThumb2)
        Dim gl As List(Of Group2) = GetAllGroup(tl) 'すべてのGroup取得
        'Groupに含まれるすべてのThumbを取得
        Dim nl As New List(Of ExThumb2)
        nl.AddRange(tl)
        For Each g As Group2 In gl
            nl.AddRange(g.AllItems)
        Next
        nl = nl.Distinct.ToList '重複除去
        Return nl
    End Function
    'Groupに属していないExThumb2を返す
    Private Function GetSimpleExThumb(tl As List(Of ExThumb2)) As List(Of ExThumb2)
        Dim nl As New List(Of ExThumb2)
        For Each t As ExThumb2 In tl
            If t.GroupTop Is Nothing Then
                nl.Add(t)
            End If
        Next
        Return nl
    End Function
    'グループ化のRectを返す、渡されたすべての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)

        '別計算バージョン
        Dim x As New List(Of Double)
        Dim y As New List(Of Double)
        Dim xx As New List(Of Double)
        Dim yy As New List(Of Double)
        For Each rr As Rect In rl
            x.Add(rr.X)
            y.Add(rr.Y)
            xx.Add(rr.X + rr.Width)
            yy.Add(rr.Y + rr.Height)
        Next
        Dim minX As Double = x.Min : Dim minY As Double = y.Min
        Dim maxX As Double = xx.Max : Dim maxY As Double = yy.Max
        Dim rrr As New Rect(minX, minY, maxX - minX, maxY - minY)

        Return rrr

    End Function

    Private Function GetBound(g As Group2) As Rect
        Dim rl As New List(Of Rect)
        For Each t As ExThumb2 In g.AllItems
            Dim gt As GeneralTransform = t.TransformToVisual(canvas1)
            rl.Add(gt.TransformBounds(New Rect(New Size(t.tCanvas.Width, t.tCanvas.Height))))

        Next
        Dim r As Rect = GetGroupRect(rl)

        Return r
    End Function


    ''グループ化
    'Private Sub AddGroup() '(tl As List(Of ExThumb2))
    '    '渡されたThumbをグループ化する
    '    'トップグループが1つの場合は統合
    '    '0か2以上ならグループを新規作成してそれに全部入れる
    '    If SelectionThumb.Count <= 1 Then Return
    '    Dim gl As List(Of Group2) = GetAllGroup(SelectionThumb) 'Groupのカウント用
    '    Dim st As List(Of ExThumb2) = GetSimpleExThumb(SelectionThumb) 'Groupに属していないthumb
    '    'Dim g As Group2
    '    If gl.Count = 1 Then
    '        '統合の場合
    '        Call GroupIntegrate(gl(0), st)
    '        gl(0).Bound = GetBound(gl(0)) 'Boundの更新

    '    Else
    '        '新規作成の場合
    '        Call GroupNew(gl, st)
    '    End If
    '    '枠表示更新
    '    ActiveGroup = ActiveThumb.GroupTop

    '    Call StatusUpdate(ActiveThumb)
    '    Call ChangeColor(Brushes.Cyan)
    'End Sub
    ''グループに統合する場合
    'Private Sub GroupIntegrate(g As Group2, st As List(Of ExThumb2))
    '    g.Items.AddRange(st) 'Groupに属していないtを追加
    '    g.AllItems.AddRange(st) '全部取得用リスト
    '    For Each t As ExThumb2 In st
    '        t.GroupTop = g
    '    Next
    'End Sub
    ''グループ新規作成の場合
    'Private Sub GroupNew(gl As List(Of Group2), st As List(Of ExThumb2))
    '    Dim g As New Group2
    '    g.Groups = gl
    '    g.Items.AddRange(st) 'Groupに属していないthumbを追加
    '    '全thumb取得用リスト
    '    Dim allt As New List(Of ExThumb2)
    '    allt.AddRange(st)
    '    For Each gg As Group2 In gl 'リスト作成
    '        allt.AddRange(gg.AllItems)
    '    Next
    '    allt = allt.Distinct.ToList '重複除去
    '    g.AllItems = allt
    '    For Each t As ExThumb2 In allt
    '        t.GroupStack.Push(t.GroupTop) 'グループ階層記録用
    '        t.GroupTop = g
    '    Next
    '    'Boundの更新
    '    Dim r As Rect = GetBound(g)
    '    g.Bound = r
    '    'g.Waku.Data = New RectangleGeometry(g.Bound)

    'End Sub

    'グループ化
    Private Sub AddGroup()
        If SelectionThumb.Count <= 1 Then Return
        Dim gl As List(Of Group2) = GetAllGroup(SelectionThumb)

        Dim g As New Group2
        g.Groups = gl
        Dim items As List(Of ExThumb2) = GetAllThumb(SelectionThumb)
        g.AllItems = items
        For Each t As ExThumb2 In items
            t.GroupStack.Push(t.GroupTop) 'グループ階層記録用
            t.GroupTop = g
        Next
        'Boundの更新
        Dim r As Rect = GetBound(g)
        g.Bound = r

        '枠表示更新
        ActiveGroup = ActiveThumb.GroupTop

        Call StatusUpdate(ActiveThumb)
        Call ChangeColor(Colors.Cyan)
    End Sub

    'グループ化解除
    Private Sub Ungroup(gg As Group2)
        If gg Is Nothing Then Return

        'Groupの底上げ
        For Each t As ExThumb2 In gg.AllItems
            If t.GroupStack.Count = 0 Then
                t.GroupTop = Nothing
            Else
                Dim g As Group2 = t.GroupStack.Pop '取り出し
                If g IsNot Nothing Then
                    g.Bound = GetBound(g) 'Boundの更新
                End If
                t.GroupTop = g
            End If
        Next

        '枠表示更新
        ActiveGroup = ActiveThumb.GroupTop

        Call StatusUpdate(ActiveThumb)
    End Sub

    ''' <summary>
    ''' TransformGroupの中から指定したTransformを返す
    ''' </summary>
    ''' <param name="tGroup">RenderTransformとか指定</param>
    ''' <param name="tType">取得したいTransformの指定、RotateTransformとか</param>
    ''' <returns></returns>
    Private Function GetTransform(tGroup As TransformGroup, tType As Type) As Transform
        For Each c As Transform In tGroup.Children
            If tType = c.GetType Then
                Return c
                Exit For
            End If
        Next
        Return Nothing
    End Function
    Private Sub ChangeBinding()
        'バインディングソースをスライダーにする場合
        'If FocusThumb IsNot Nothing Then
        '    '前のFocusThumbのバインディングをクリア
        '    'これを実行しないとクリックしたThumb全部がSliderとバインディングになってしまう
        '    Dim og As TransformGroup = FocusThumb.tCanvas.RenderTransform
        '    Dim oro As RotateTransform = GetTransform(og, GetType(RotateTransform))
        '    BindingOperations.ClearBinding(oro, RotateTransform.AngleProperty)
        'End If

        'Dim t As ExThumb = DirectCast(sender, ExThumb)
        'FocusThumb = t
        'Dim b As New Binding
        'b.Source = sld1
        'b.Mode = BindingMode.TwoWay
        'b.Path = New PropertyPath(Slider.ValueProperty)
        'Dim tg As TransformGroup = FocusThumb.tCanvas.RenderTransform
        'Dim ro As RotateTransform = GetTransform(tg, GetType(RotateTransform))
        'BindingOperations.SetBinding(ro, RotateTransform.AngleProperty, b)


        'バインディングソースをExThumbにする場合
        'これは失敗、ThumbのAnglePropertyが取得できればできそうなんだけど
        'できた！！BindingのSourceをTransformGroupの中のRotateにすればいい
        Dim tg As TransformGroup = ActiveThumb.tCanvas.RenderTransform
        '回転角度とsld1とのバインディング
        Dim b As New Binding
        Dim ro As RotateTransform = GetTransform(tg, GetType(RotateTransform))
        b.Source = ro
        b.Mode = BindingMode.TwoWay
        b.Path = New PropertyPath(RotateTransform.AngleProperty)
        BindingOperations.SetBinding(sldAngle, Slider.ValueProperty, b)

        '拡大率横のバインディング
        b = New Binding
        Dim sc As ScaleTransform = GetTransform(tg, GetType(ScaleTransform))
        b.Source = sc
        b.Mode = BindingMode.TwoWay
        b.Path = New PropertyPath(ScaleTransform.ScaleXProperty)
        BindingOperations.SetBinding(sldX, Slider.ValueProperty, b)
        '拡大率縦のバインディング
        Dim b2 As New Binding
        b2.Source = sc
        b2.Mode = BindingMode.TwoWay
        b2.Path = New PropertyPath(ScaleTransform.ScaleYProperty)
        BindingOperations.SetBinding(sldY, Slider.ValueProperty, b2)
    End Sub
    Private Sub ChangeBinding2(t As ExThumb2)
        Dim b As New Binding
        b.Source = sldAngle
        b.Mode = BindingMode.TwoWay
        b.Path = New PropertyPath(Slider.ValueProperty)
        Dim tg As TransformGroup = t.tCanvas.RenderTransform
        Dim ro As RotateTransform = GetTransform(tg, GetType(RotateTransform))
        BindingOperations.SetBinding(ro, RotateTransform.AngleProperty, b)

        'If t.GroupTop IsNot Nothing Then
        '    For Each tt As ExThumb2 In t.GroupTop.AllItems
        '        tg = tt.tCanvas.RenderTransform
        '        ro = GetTransform(tg, GetType(RotateTransform))
        '        BindingOperations.SetBinding(ro, RotateTransform.AngleProperty, b)

        '    Next
        'Else
        '    tg = t.tCanvas.RenderTransform
        '    ro = GetTransform(tg, GetType(RotateTransform))
        '    BindingOperations.SetBinding(ro, RotateTransform.AngleProperty, b)
        'End If

    End Sub
    Private Sub ClealBinding(t As ExThumb2)
        If t Is Nothing Then Return
        Dim tg As TransformGroup = t.tCanvas.RenderTransform
        Dim ro As RotateTransform = GetTransform(tg, GetType(RotateTransform))
        BindingOperations.ClearBinding(ro, RotateTransform.AngleProperty)
    End Sub








    'E:\オレ\エクセル\WPFでPixtack紫陽花.xlsm_配置_$Q$437
    Private Sub MainWindow_ContentRendered(sender As Object, e As EventArgs) Handles Me.ContentRendered
        Call AddExThumb2(9) 't0からt9までの10個のExThumb2を作成してリストに入れる

        '範囲選択枠の設定
        waku = New Path With {.Stroke = Brushes.Red, .StrokeThickness = 1.0R}

    End Sub
    'グループ化
    Private Sub bt1_Click(sender As Object, e As RoutedEventArgs) Handles bt1.Click
        Call AddGroup()

    End Sub

    '選択中のtを含むグループを解除
    Private Sub bt2_Click(sender As Object, e As RoutedEventArgs) Handles bt2.Click
        Call Ungroup(ActiveThumb.GroupTop)
    End Sub
    '選択Thumbを解除
    Private Sub ReleaceSelection()
        If SelectionThumb.Count > 0 Then
            Call ChangeColor(Colors.Cyan) '色をCyanに戻す
            SelectionThumb.Clear()
        End If
    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() '範囲選択枠データの初期化
        Call ReleaceSelection()
        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
        SelectionThumb = GetSelectThumb() '選択範囲内のThumbを取得
        Call ChangeColor(Colors.Red) '選択Thumbを赤にする

        Dim c As Canvas = DirectCast(sender, Canvas)
        IsDrag = False
        c.ReleaseMouseCapture()
        canvas1.Children.Remove(waku) '選択範囲枠の消去
    End Sub
End Class


Public Class ExThumb2
    Inherits Thumb
    Public Property GroupTop As Group2 '全体
    'グループ化するときに元のグループをスタックしていって
    'グループ化解除するときに取り出してGroupTopに据えるGroupStack
    Public Property GroupStack As New Stack(Of Group2)
    Public Property tCanvas As Canvas '表示しているCanvas、サイズとか知りたい時用
    Public Sub New(i As Integer, s As Size)
        Me.Name = "t_" & i
        Me.Template = GetTemplate() 'Template指定
        Me.ApplyTemplate() 'Template再構築実行

        Dim b As New Border
        With b
            .BorderBrush = Brushes.Black
            .BorderThickness = New Thickness(1)
            .Width = s.Width
            .Height = s.Height
        End With

        Dim tb As New TextBlock With {.Text = "t" & i}
        Canvas.SetLeft(tb, 10)


        Dim c As Canvas = DirectCast(Me.Template.FindName("cc", Me), Canvas)
        tCanvas = c
        With c
            .Background = Brushes.Cyan
            .Width = b.Width
            .Height = b.Height
            .Children.Add(b)
            .Children.Add(tb)
        End With
        SetRenderTransform(c)

    End Sub

    'Template作成
    'WPFとVB.NET、ControlTemplateをコードで作成 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
    'http://blogs.yahoo.co.jp/gogowaten/14156250.html
    Private Function GetTemplate() As ControlTemplate
        Dim ct As New ControlTemplate
        ct.VisualTree = New FrameworkElementFactory(GetType(Canvas), "cc")
        Return ct
    End Function

    Private Sub SetRenderTransform(c As Canvas)
        Dim tg As New TransformGroup
        With tg.Children '順番が大切
            .Add(New ScaleTransform)
            .Add(New SkewTransform)
            .Add(New RotateTransform)
            .Add(New TranslateTransform)
        End With
        c.RenderTransform = tg
        c.RenderTransformOrigin = New Point(0.5, 0.5)
    End Sub
End Class

Public Class Group2
    Public Shared number As Integer 'カウント用、目印用

    'Public Property Items As New List(Of ExThumb2) 'グループ直下のThumb用
    Public Property AllItems As New List(Of ExThumb2) 'すべてを取得する時用
    Public Property Groups As List(Of Group2) '入れ子、nest用
    Public Property Waku As New Path 'グループの枠表示用
    <System.ComponentModel.Category("name")>
    Public Property aName As String '名前、目印用

    'グループの枠表用四角形
    Private Property _Bound As Rect
    Public Property Bound As Rect
        Get
            Return _Bound
        End Get
        Set(value As Rect)
            _Bound = value
            Waku.Data = New RectangleGeometry(value)
        End Set
    End Property

    Public Sub New()
        '連番の名前
        number += 1
        aName = "G_" & number
        'グループの枠初期設定
        Waku = New Path With {.Stroke = Brushes.Blue, .StrokeThickness = 1.0R}
        Waku.Data = New RectangleGeometry(Bound)
    End Sub
End Class


#Region "Group3(未使用)"
Public Class Group3
    Inherits List(Of ExThumb2)
    Public Property Groups As List(Of Group3)
    <System.ComponentModel.Category("name")>
    Public Property aName As String
    Public Sub New(i As Integer)
        aName = "G_" & i
    End Sub
End Class
#End Region

追記ここまで

 

グループ化の方法を少し変更した

前回は既存のグループと単体のThumbをグループ化するときは、既存のグループにThumbを足す形にしていたけど、別グループを新規作成してそこに既存のグループとThumbを入れるようにした

グループ1(t1, t2) + t3, t4のとき

前回 グループ1(t1, t2, t3, t4)

今回 グループ2(グループ1(t1, t2), t3, t4)

グループ化解除した時は今回のほうが自然な感じなんだけど、前回は気づかなくて余計なことをしていたｗ

 

 

グループの枠表示

グループに属しているThumbをクリックした時に、そのグループが収まる青枠を表示するようにした、目印用

枠の表示にPathクラスとRectangleGeometryを使うのは前回の範囲選択の赤枠の表示と同じ方法、このPathはWakuって名前にした、586行目

枠の位置や大きさになるRectはBoundって名前にした、このBoundの値を変更するときに同時にWakuのDataも更新するようにした、598行目

この2つをGroup2に持たせた。

さっきのグループ化の方法変更でグループ直下のThumbリストは意味がなくなったので廃止、583行目

 

グループの枠の表示の切り替えタイミングは

選択Thumbを切り替えた時

グループ化した時

グループ化解除した時

この3つ

選択グループが変わった時ってことで

ActiveGroupって名前のGroup2のプロパティを用意して(55行目)

この値を変更(Set)した時に枠の表示も切り替えることにした(60行目から)

今思った

枠を表示するときはCanvas.Children.Add

非表示にするときはCanvas.Children.Remove

っていう追加と削除で行っているけど

表示 value.Waku.Visibility = Visibility.Visible

非表示 value.Waku.Visibility = Visibility.Collapsed

文字通りこっちのほうがいいかも？

 

 

今回のコード全部は

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

 

関連記事、古い順

前々回は6日前

gogowaten.hatenablog.com

5日前

gogowaten.hatenablog.com

3日後

gogowaten.hatenablog.com

9日後

gogowaten.hatenablog.com

WPFとVB.NET、エクセルのグループ化とグループ化解除を真似したい3 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14187560.html前回
WPFとVB.NET、マウスドラッグ移動で範囲選択、枠表示して枠内のものを取得 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14190065.html次
WPFとVB.NET、エクセルのグループ化とグループ化解除を真似したい5 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14209863.html

WPFとVB.NET、FillContainsWithDetailとGeometryを使って面と面の重なりを判定 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14225368.html