Imports System.Windows.Controls.Primitives
Class MainWindow
Private thumbList As New List(Of Thumb)
Private thumbGroup As Thumb
Private thumbGroup2 As Thumb
Private Sub SetLocate(obj As FrameworkElement, p As Point)
Canvas.SetLeft(obj, p.X)
Canvas.SetTop(obj, p.Y)
End Sub
Private Function GetLocate(obf As FrameworkElement) As Point
Return New Point(Canvas.GetLeft(obf), Canvas.GetTop(obf))
End Function
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
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()
Return t
End Function
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
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
Private Sub AddThumb(p As Point, tg As TransformGroup, img As Image)
Dim b As BitmapSource = img.Source
Dim t As Thumb = GetThumb()
With t
.Width = b.PixelWidth
.Height = b.PixelHeight
End With
Call SetLocate(t, p)
thumbList.Add(t)
canvas1.Children.Add(t)
AddHandler t.DragDelta, AddressOf ThumbDragDelta
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
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
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
r = New Rect(minX, minY, maxX - minX, maxY - minY)
Return r
End Function
Private Sub AddGroup(tList As List(Of Thumb))
Dim rl As New List(Of Rect)
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
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)
canvas1.Children.Add(t)
AddHandler t.DragDelta, AddressOf ThumbDragDelta
thumbGroup = t
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
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
Private Sub AddGroup2(tList As List(Of Thumb))
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
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)
canvas1.Children.Add(nt)
AddHandler nt.DragDelta, AddressOf ThumbDragDelta
thumbGroup2 = nt
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
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))
Next
End Sub
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
Private Sub bt2_Click(sender As Object, e As RoutedEventArgs) Handles bt2.Click
If thumbGroup IsNot Nothing Then Return
Call AddGroup(thumbList)
End Sub
Private Sub bt3_Click(sender As Object, e As RoutedEventArgs) Handles bt3.Click
If thumbGroup Is Nothing Then Return
Call UnGroup(thumbGroup)
End Sub
Private Sub bt4_Click(sender As Object, e As RoutedEventArgs) Handles bt4.Click
If thumbGroup2 IsNot Nothing Then Return
Call AddGroup2(thumbList)
End Sub
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
