ControlTemplateを指定したThumbを回転表示させたものをドラッグ移動したら
動きがおかしくてマウスとは違う方向に動いていく
これは
この時に書いたのをすっかり忘れていたからなんだけど
この時とは別の方法でできたのでメモ
その方法は
Thumbを回転させるのではなくてTemplateに指定した
Canvasを回転させる
これだけ
試しにThumbのTemplateプロパティに
Canvasを入れたControlTemplateを指定して
その
Canvasの中にRectangleとtextBlockを入れたものを表示
Thumb
┣Rectangle
┗textBlock
これを
それぞれの方法で60度回転表示させたものをマウスドラッグ移動しているのが
↓
右 Thumbの中のRectangleとtextBlockを回転表示
左のThumbを回転表示したものだけ動きがおかしいw
中と右は動きがまともなのでこのどちらかを使うことになりそう
'ThumbのTemplateを指定した時どれを回転させればドラッグ移動がうまくいくのか
'結果はThumb以外のどれかが良さそう
'Template中の
Canvasか
Canvasの中に入れたものになるけど
'
Canvasがいいかなあってところ
Imports System.Windows.Controls.Primitives
Class MainWindow
Private Sub SetLocate(obj As Object, p As Point)
Canvas.SetLeft(obj, p.X)
Canvas.SetTop(obj, p.Y)
End Sub
Private Function GetLocate(obf As Object) 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 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 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 Sub AddThumbRotateThumb()
Dim t As Thumb = GetThumb()
Dim c As Canvas = t.Template.FindName("cc", t)
Dim r As New Border With {
.Background = Brushes.Cyan, .Width = 100, .Height = 100}
Dim tb As New TextBlock With {.Text = "Thumbを60度回転"}
t.Width = r.Width
t.Height = r.Height
c.Children.Add(r)
c.Children.Add(tb)
canvas1.Children.Add(t)
SetLocate(t, New Point(50, 100))
t.RenderTransform = GetTransformGroup(60, 1)
t.RenderTransformOrigin = New Point(0.5, 0.5)
AddHandler t.DragDelta, AddressOf ThumbDragDelta
End Sub
Private Sub AddThumbRotateCanvas()
Dim t As Thumb = GetThumb()
Dim c As Canvas = t.Template.FindName("cc", t)
Dim r As New Border With {
.Background = Brushes.Cyan, .Width = 100, .Height = 100}
Dim tb As New TextBlock With {
.Text = "Thumbの中のCanvasを60度回転",
.TextWrapping = TextWrapping.Wrap,
.Width = r.Width}
t.Width = r.Width
t.Height = r.Height
c.Children.Add(r)
c.Children.Add(tb)
canvas1.Children.Add(t)
SetLocate(t, New Point(200, 100))
Dim cc As Canvas = t.Template.FindName("cc", t)
cc.RenderTransform = GetTransformGroup(60, 1)
cc.RenderTransformOrigin = New Point(0.5, 0.5)
AddHandler t.DragDelta, AddressOf ThumbDragDelta
End Sub
Private Sub AddThumbRotateRect()
Dim t As Thumb = GetThumb()
Dim c As Canvas = t.Template.FindName("cc", t)
Dim r As New Border With {
.Background = Brushes.Cyan, .Width = 100, .Height = 100}
Dim tb As New TextBlock With {
.Text = "Thumbの中のCanvasの中のRectとtextBlockを60度回転",
.TextWrapping = TextWrapping.Wrap,
.Width = r.Width}
t.Width = r.Width
t.Height = r.Height
c.Children.Add(r)
c.Children.Add(tb)
canvas1.Children.Add(t)
SetLocate(t, New Point(350, 100))
r.RenderTransform = GetTransformGroup(60, 1)
r.RenderTransformOrigin = New Point(0.5, 0.5)
tb.RenderTransform = GetTransformGroup(60, 1)
tb.RenderTransformOrigin = New Point(0.5, 0.5)
AddHandler t.DragDelta, AddressOf ThumbDragDelta
End Sub
Private Sub MainWindow_ContentRendered(sender As Object, e As EventArgs) Handles Me.ContentRendered
End Sub
Private Sub MainWindow_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
Call AddThumbRotateThumb()
Call AddThumbRotateCanvas()
Call AddThumbRotateRect()
End Sub
End Class
中の様子を見てみる
今回のコード
7年後、これならもっと楽にできそう?