午後わてんのブログ

ベランダ菜園とWindows用アプリ作成(WPFとC#)

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

 
グループ化続き
イメージ 1
ここまではできた
2016年6月2日追記
この方法はちょっと違うかもと別の方法にしてみた
追記ここまで
 
デザイン画面とXAML

f:id:gogowaten:20191030115353p:plain

VBコード

f:id:gogowaten:20191030115409p:plain

赤いところは意味ない
Imports System.Windows.Controls.Primitives

Class MainWindow
    Private thumbList As New List(Of Thumb)
    Private thumbGroup As Thumb 'Thumbをそのままグループ化したもの用
    Private thumbGroup2 As Thumb 'Thumbの中のImageを取り出してグループ化したもの用

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

    'Thumbの座標ゲット
    Private Function GetLocate(obf As FrameworkElement) As Point
        Return New Point(Canvas.GetLeft(obf), Canvas.GetTop(obf))
    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


    'Canvasを入れたTemplate付きのThumbを作成
    Private Function GetThumb() As Thumb
        Dim ct As New ControlTemplate
        ct.VisualTree = New FrameworkElementFactory(GetType(Canvas), "cc")

        Dim t As New Thumb
        t.Template = ct
        t.ApplyTemplate() 'Template再構成

        'Dim c As Canvas = t.Template.FindName("cc", t)
        'c.Background = Brushes.Transparent 'これをつけると透明部分でもドラッグ移動できる

        Return t

    End Function

    'ファイルパスから取得した画像をSourceにしたImageを返す
    Private Function GetImage(uri As String) As Image
        Dim b As New BitmapImage(New Uri(uri))
        Dim img As New Image
        With img
            .Width = b.PixelWidth
            .Height = b.PixelHeight
            .Source = b
        End With
        Return img
    End Function

    '回転角度と拡大率を指定したTransformGroupを返す
    Private Function GetTransformGroup(angle As Double, scale As Double) As TransformGroup
        Dim tg As New TransformGroup
        tg.Children.Add(New RotateTransform(angle))
        tg.Children.Add(New ScaleTransform(scale, scale))
        Return tg
    End Function

    'Thumbをcanvas1に追加表示
    Private Sub AddThumb(p As Point, tg As TransformGroup, img As Image)

        Dim b As BitmapSource = img.Source
        'Thumb作成
        Dim t As Thumb = GetThumb()
        With t
            .Width = b.PixelWidth
            .Height = b.PixelHeight
            'Thumbを回転させるのはドラッグ移動で動きがおかしくなるので中止
            'かわりに中のCanvasを回転させるのでこれは中止
            '.RenderTransform = tg 
        End With
        Call SetLocate(t, p)
        thumbList.Add(t)
        canvas1.Children.Add(t)
        AddHandler t.DragDelta, AddressOf ThumbDragDelta

        'Thumbの中のCanvasを回転させる
        Dim c As Canvas = t.Template.FindName("cc", t)
        With c
            .Width = b.PixelWidth
            .Height = b.PixelHeight
            .RenderTransform = tg '回転拡大表示
            .RenderTransformOrigin = New Point(0.5, 0.5)
        End With
        c.Children.Add(img)

    End Sub


    '渡されたコントロール(エレメント?)がぴったり収まるRectを返す
    Private Function GetRect(e As FrameworkElement) As Rect
        Dim gt As GeneralTransform = e.TransformToVisual(canvas1)
        Dim r As Rect = gt.TransformBounds(
            New Rect(New Point(0, 0), New Size(e.Width, e.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

    'グループ化の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


    'グループ化パターン1、Thumbの中にThumbのままグループ化
    Private Sub AddGroup(tList As List(Of Thumb))
        Dim rl As New List(Of Rect)
        'canvas1から削除、ドラッグ移動のイベントも解除
        Dim cc As Canvas
        For Each tt As Thumb In tList
            cc = tt.Template.FindName("cc", tt)
            rl.Add(GetRect(cc))
            canvas1.Children.Remove(tt)
            RemoveHandler tt.DragDelta, AddressOf ThumbDragDelta
        Next
        'グループ化した時用のRect取得して新規作成Thumbに指定
        Dim r As Rect = GetGroupRect(rl)
        Dim t As Thumb = GetThumb()
        With t
            .Width = r.Width
            .Height = r.Height
        End With
        Call SetLocate(t, r.Location)
        '新規作成Thumbをcanvas1に追加
        canvas1.Children.Add(t)
        AddHandler t.DragDelta, AddressOf ThumbDragDelta
        thumbGroup = t

        'Thumbの中のCanvasに各Thumbを追加
        Dim c As Canvas = t.Template.FindName("cc", t)
        c.Background = Brushes.LightCyan
        For Each ttc As Thumb In tList
            c.Children.Add(ttc)
            SetLocate(ttc, GetLocate(ttc) - r.Location)
        Next
    End Sub

    'グループ化解除
    Private Sub UnGroup(g As Thumb)
        canvas1.Children.Remove(g)
        thumbGroup = Nothing

        'Thumbの中のThumbを取り出して再配置
        Dim c As Canvas = g.Template.FindName("cc", g)
        For Each t As Thumb In thumbList
            c.Children.Remove(t)
            canvas1.Children.Add(t)
            AddHandler t.DragDelta, AddressOf ThumbDragDelta
            SetLocate(t, GetLocate(t) + GetLocate(g))
        Next
    End Sub


    'グループ化パターン2、中のImageを取り出してグループ化
    '(これは失敗?めんどくさい)
    Private Sub AddGroup2(tList As List(Of Thumb))

        'canvas1から削除、ドラッグ移動のイベントも解除
        Dim rl As New List(Of Rect)
        For Each t As Thumb In tList
            rl.Add(GetRect(t))
            canvas1.Children.Remove(t)
            RemoveHandler t.DragDelta, AddressOf ThumbDragDelta
        Next
        'グループ化した時用のRect取得して新規作成Thumbに指定
        Dim r As Rect = GetGroupRect(rl)
        Dim nt As Thumb = GetThumb()
        With nt
            .Width = r.Width
            .Height = r.Height
        End With
        Call SetLocate(nt, r.Location)
        '新規作成Thumbをcanvas1に追加
        canvas1.Children.Add(nt)
        AddHandler nt.DragDelta, AddressOf ThumbDragDelta
        thumbGroup2 = nt

        'Thumbから取り出したImageを新規作成ThumbのCanvasに追加
        Dim c As Canvas = nt.Template.FindName("cc", nt)
        c.Background = Brushes.Honeydew
        Dim ic As Canvas
        Dim img As Image
        Dim p As Point
        For Each tt As Thumb In tList
            ic = tt.Template.FindName("cc", tt)
            img = ic.Children.Item(0)
            img.RenderTransform = tt.RenderTransform
            ic.Children.Remove(img)
            p = GetLocate(tt)
            c.Children.Add(img)
            SetLocate(img, p - r.Location)
        Next
    End Sub

    'グループ化解除2、失敗
    Private Sub UnGroup2(g As Thumb)
        Dim gp As Point = GetLocate(g)
        canvas1.Children.Remove(g)
        thumbGroup2 = Nothing

        Dim c As Canvas = g.Template.FindName("cc", g)
        Dim imgList As New List(Of Image)
        For i As Integer = 0 To c.Children.Count - 1
            imgList.Add(c.Children.Item(i))
        Next

        Dim p As Point
        Dim img As Image
        For i As Integer = 0 To imgList.Count - 1

            img = imgList(i)
            p = GetLocate(img)
            c.Children.Remove(img)
            AddThumb(p, New TransformGroup, imgList(i))
            'AddThumb(p, img.RenderTransform, imgList(i))
        Next

    End Sub


    'アプリ起動直後、Thumbを表示
    Private Sub MainWindow_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
        Call AddThumb(New Point(70, 60),
                      GetTransformGroup(20.0R, 1.5R),
                      GetImage("D:\ブログ用\テスト用画像\hueRect000.png"))
        Call AddThumb(New Point(170, 50),
                      GetTransformGroup(355.0R, 1.0R),
                      GetImage("D:\ブログ用\テスト用画像\hueRect030.png"))
        Call AddThumb(New Point(150, 120),
                      GetTransformGroup(45.0R, 1.0R),
                      GetImage("D:\ブログ用\テスト用画像\hueRect060.png"))

    End Sub


    Private Sub bt1_Click(sender As Object, e As RoutedEventArgs) Handles bt1.Click

    End Sub

    'グループ化1
    Private Sub bt2_Click(sender As Object, e As RoutedEventArgs) Handles bt2.Click
        If thumbGroup IsNot Nothing Then Return
        Call AddGroup(thumbList)

    End Sub

    'グループ化1解除
    Private Sub bt3_Click(sender As Object, e As RoutedEventArgs) Handles bt3.Click
        If thumbGroup Is Nothing Then Return
        Call UnGroup(thumbGroup)
    End Sub

    'グループ化2(失敗)
    Private Sub bt4_Click(sender As Object, e As RoutedEventArgs) Handles bt4.Click
        If thumbGroup2 IsNot Nothing Then Return
        Call AddGroup2(thumbList)
    End Sub

    'グループ化2解除(失敗)
    Private Sub bt5_Click(sender As Object, e As RoutedEventArgs) Handles bt5.Click
        If thumbGroup2 Is Nothing Then Return
        Call UnGroup2(thumbGroup2)
    End Sub
End Class
 
 
 
 
イメージ 4
        Thumb
	┗Canvas
		┗Image
↑これ3つをグループ化して
↓こうした
Thumb
	┗Canvas
		┣Thumb
		┃	┗Canvas
		┃		┗Image
		┣Thumb
		┃	┗Canvas
		┃		┗Image
		┗Thumb
			┗Canvas
				┗Image
これは
Thumb
	┗Canvas
		┣Image
		┣Image
		┗Image
こうしたほうがすっきりするけどグループ化解除の時にそれぞれのThumbを作成する必要があってめんどくさい
それを試して途中で諦めたのがグループ化解除2ってなっている赤い部分のコード
 
WPFVB.NET、ControlTemplateを使ったThumbを回転表示する時に回転させるのはどれがいいのか ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14157487.html
これからThumbのTemplateの中のCanvasを回転させるようにしたのと同時に拡大表示もしている
イメージ 5
Thumb自体は元の大きさで回転もしていない
 
イメージ 6
中のCanvasを回転拡大表示している
 
 
ここまではできた、ここまではいいんだけど次
グループ化したものを拡大や回転させた後にグループ化解除したときに
拡大や回転を引き継ぐのが難しい
 
回転表示するときの回転軸は画像の中心にしているんだけど
グループ化した後の回転軸はグループ化全体の中心になるから
イメージ 7
グループ化後の回転軸は個別の画像の中心とはズレることになるので
回転した後にグループ化解除した時もこの表示を維持するのが難しい
 
イメージ 8
左が期待するグループ化解除
右は回転角度だけ引き継いだだけなので回転角度は同じだけど表示位置がずれている
このズレの分の距離がわかればいいんだけどねえ
 
回転軸の位置は指定できる
RenderTransformOriginプロパティにPoint(0.5, 0.5)
これで中心が回転軸になる
RenderTransformOriginプロパティにPoint(0.0, 0.0)
これだと左上が回転軸になる
なので
    '新しい座標の求め方
    'グループ化前のThumbとCanvasの左上座標の差を持たせておく(差A)
    'グループ化後のCanvasの中心点を求める
    'その中心点は自身の左上座標からどの位置にあるのか求める
    'この数値は自身の(表示?)サイズに対する指数?
    'これを自身のCanvasのRenderTransformOriginに指定する
    '実際に回転表示してThumbとCanvasの左上座標の差を求める(差B)
    '差B - 差A = 差C
    '差C + 自身の座標 = 新しい座標
ってのを思いついたけどめんどくさいというか難しい、迂遠っていうのかしら
もっと楽な方法がありそう
 
今回のコード
 
 
関連記事、古い順
4日前
WPFVB.NET、エクセルのグループ化を真似したいからまずはグループ化のRectを取得 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14151447.html

WPFVB.NET、ControlTemplateをコードで作成 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14156250.html

WPFVB.NET、ControlTemplateを使ったThumbを回転表示する時に回転させるのはどれがいいのか ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14157487.html
2016年6月2日追記
続きにあたる記事は10日後
WPFVB.NET、エクセルのグループ化とグループ化解除を真似したい3 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14187560.html