WPFとVBでアプリ作る準備その8の記事のコード全文

Imports System.Windows.Controls.Primitives
Imports System.Windows.Controls.Canvas

Public Class ExImage
    Inherits Image
    Private syoki As Point
    Public Event ExDragDelta(sender As Object, e As DragDeltaEventArgs)
    Private Main As MainWindow

    Public Sub New(o As MainWindow)
        Main = o
    End Sub
    Protected Overrides Sub OnMouseLeftButtonDown(e As MouseButtonEventArgs)
        MyBase.OnMouseLeftButtonDown(e)
        syoki = e.GetPosition(Me)
        Me.CaptureMouse()
    End Sub
    Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
        MyBase.OnMouseMove(e)
        If e.LeftButton = MouseButtonState.Pressed Then
            Dim p As Point = Point.Subtract(e.GetPosition(Me), syoki)
            RaiseEvent ExDragDelta(Me, New DragDeltaEventArgs(p.X, p.Y))
        End If
    End Sub
    Protected Overrides Sub OnMouseUp(e As MouseButtonEventArgs)
        MyBase.OnMouseUp(e)
        Me.ReleaseMouseCapture()
    End Sub
    Protected Overrides Sub OnPreviewMouseLeftButtonUp(e As MouseButtonEventArgs)
        MyBase.OnPreviewMouseLeftButtonUp(e)
        Main.AjustLocation()
    End Sub

End Class


'汎用ジェネリックコレクション その2 ObservableCollection/ReadOnlyObservableCollection (System.Collections.ObjectModel) - Programming/.NET Framework/コレクション - 総武ソフトウェア推進所
'http://smdn.jp/programming/netfx/collections/3_objectmodel_2_observablecollection/
'ObservableCollectionはItemの移動ができる、追加、削除、移動した時のメソッドをOverridesできる
Public Class ObservableCollectionExImage
    Inherits ObjectModel.ObservableCollection(Of ExImage)

    'Item移動の時
    Protected Overrides Sub MoveItem(oldIndex As Integer, newIndex As Integer)
        '移動先のIndexが全画像数より大きいか0未満ならなにもしないで終了
        If newIndex >= Count OrElse newIndex < 0 Then Return
        MyBase.MoveItem(oldIndex, newIndex)
        SetZIndex(Item(oldIndex), oldIndex)
        SetZIndex(Item(newIndex), newIndex)
    End Sub

End Class

Imports System.IO
Imports System.Windows.Controls.Primitives
Imports System.Windows.Controls.Panel
Imports System.Windows.Controls.Canvas


Class MainWindow
    'すべてのExImageを入れておくリストコレクション
    Private CollectionExImage As New ObservableCollectionExImage

    'Locate表示のtextBlockの更新
    Private Sub DisplayUpdateLocate(ex As ExImage)
        If ex Is Nothing Then
            tbLocate.Text = "Locate = "
        Else
            tbLocate.Text = "Locate = " & GetLeft(ex) & "," & GetTop(ex)
        End If
    End Sub

    '    VB プロパティの作成
    'http://homepage1.nifty.com/rucio/main/dotnet/shokyu/standard47.htm


    '選択中の画像(ExImage)を記録しておくプロパティ
    '選択画像が変わった時に見本画像更新したくて作った
    Private _FocusExImage As ExImage
    Private Property FocusExImage As ExImage
        Get
            Return _FocusExImage
        End Get
        Set(value As ExImage)
            'プロパティに値をセット、つまり中身が変化する
            _FocusExImage = value
            ''FocusExImageの中身が入れ替わった時実行
            Call DisplayUpdateLocate(value)
            '見本画像更新
            If value Is Nothing Then
                mihon.Source = Nothing
            Else
                mihon.Source = value.Source
            End If
        End Set
    End Property

    'ExImageを左上のグリッドに移動
    Private Sub AjustGrid(ex As ExImage)
        Dim p As Point = GetRect(ex).Location '位置取得
        Dim g As Integer = gridSdr.Value '指定グリッド数値取得
        Dim xm As Integer = p.X Mod g '横位置をグリッドで割った余り
        Dim ym As Integer = p.Y Mod g '縦位置を～

        If xm <> 0 Then '0以外なら
            SetLeft(ex, p.X - xm) '最寄りの左のグリッドに移動
        End If
        If ym <> 0 Then
            SetTop(ex, p.Y - ym) '最寄りの上のグリッドに移動
        End If

        Call DisplayUpdateLocate(ex)
    End Sub

    'マウスドラッグ移動、グリッドに合わせた移動
    Private Sub ExImage_DragMove(sender As Object, e As DragDeltaEventArgs)
        Dim g As Integer = gridSdr.Value
        Dim ex As ExImage = DirectCast(sender, ExImage)

        'Pixtack紫陽花と同じ方式
        Dim xIma As Integer = GetLeft(ex) + e.HorizontalChange 'ExImageの横位置 + マウスの横移動距離
        Dim yIma As Integer = GetTop(ex) + e.VerticalChange '縦位置
        '移動先指定
        SetLeft(ex, xIma - (xIma Mod g)) '横位置 - (横位置をグリッド数値で割った余り)
        SetTop(ex, yIma - (yIma Mod g)) '縦位置

        Call DisplayUpdateLocate(ex) '位置ステータスラベル更新
    End Sub

    'ExImageを作成して追加した直後に動かす
    Private Sub ExImage_Loaded(sender As Object, e As RoutedEventArgs)
        Call AjustGrid(sender) '最寄りのグリッドに位置を合わせる
    End Sub

    'ファイルパスからBitmapImage(画像)を作成して返す
    Private Function GetBitmapImage(filePath As String) As BitmapImage
        Dim bmp As New BitmapImage
        Using fs As New FileStream(filePath, FileMode.Open, FileAccess.Read)
            With bmp
                .BeginInit()
                .StreamSource = fs
                .CacheOption = BitmapCacheOption.OnLoad
                .EndInit()
                .Freeze()
            End With
        End Using
        Return bmp
    End Function

    'ExImageを作成して追加
    Private Sub AddThumb(filesPath As String, locate As Point)
        Dim ex As New ExImage(Me)
        CollectionExImage.Add(ex) 'リストコレクションに追加
        SetZIndex(ex, CollectionExImage.Count - 1) 'ZIndexを指定
        canvas1.Children.Add(ex)
        Dim bmp As BitmapImage = GetBitmapImage(filesPath)
        With ex
            .Source = bmp ' GetBitmapImage(filesPath)
            '.Width = bmp.PixelWidth '100ピクセルの画像をSourceに指定した時
            '.Height = bmp.PixelHeight 'ExImageのサイズ指定しないとExImageは100.0139になる
        End With
        SetLeft(ex, locate.X) '表示する位置は必須、指定しないとDragdeltaイベントで移動量が取得できない
        SetTop(ex, locate.Y)  '必須
        AddHandler ex.ExDragDelta, AddressOf ExImage_DragMove 'これはマウスドラッグ用
        AddHandler ex.MouseDown, AddressOf ExImage_MouseDown '画像をクリックした時に動かすメソッド
        AddHandler ex.Loaded, AddressOf ExImage_Loaded
    End Sub

    'ウィンドウに画像ファイルがドロップされた時
    Private Sub MainWindow_Drop(sender As Object, e As DragEventArgs) Handles Me.Drop
        Dim filesPath() As String = e.Data.GetData(DataFormats.FileDrop) 'ファイルパス取得
        Dim locate As New Point(0, 0) 'ExImageを表示する位置
        For i As Integer = 0 To filesPath.Length - 1
            Call AddThumb(filesPath(i), locate) 'ExImage作成表示
            locate.Offset(30, 30) '位置の変更
        Next
    End Sub



    'textBlockの表示更新
    Private Sub kousin()
        tbZIndex.Text = "ZIndex = " & GetZIndex(FocusExImage).ToString
    End Sub
    '1つ上に移動
    Private Sub age_Click(sender As Object, e As RoutedEventArgs) Handles age.Click
        Dim z As Integer = CollectionExImage.IndexOf(FocusExImage)
        Call ZOrder(z, z + 1)
    End Sub
    '1つ下に移動
    Private Sub sage_Click(sender As Object, e As RoutedEventArgs) Handles sage.Click
        Dim z As Integer = CollectionExImage.IndexOf(FocusExImage)
        Call ZOrder(z, z - 1)
    End Sub
    '画像のZOrder指定、ExImageのZIndex指定
    Private Sub ZOrder(Moto As Integer, Saki As Integer)
        If FocusExImage Is Nothing Then Return
        CollectionExImage.Move(Moto, Saki) '移動元Index、移動先Index
        Call kousin()
    End Sub
    '画像クリックした時
    Private Sub ExImage_MouseDown(sender As Object, e As RoutedEventArgs)
        Call AjustGrid(sender)
        FocusExImage = sender 'クリックしたExImageを記録
        'mihon.Source = exex.Source '見本を表示
        Call kousin() 'textBlockのZIndex表示更新
    End Sub



    '位置調整
    Public Sub AjustLocation()
        Dim r As Rect = GetUnion(CollectionExImage)
        canvas1.Width = r.Width
        canvas1.Height = r.Height
        If r.X <> 0 OrElse r.Y <> 0 Then
            For Each ex As ExImage In CollectionExImage
                SetLeft(ex, GetLeft(ex) - r.X)
                SetTop(ex, GetTop(ex) - r.Y)
            Next
            Call AjustGrid(FocusExImage)
        End If
    End Sub

    '    プログラミング Windows 第6版 第10章 WPF編 - 荒井省三のBlog - Site Home - MSDN Blogs
    'http://blogs.msdn.com/b/shozoa/archive/2014/08/22/using-programming-windows-chapter10.aspx
    'ExImageのRectを取得、回転後のRectにも対応
    Private Function GetRect(ex As ExImage) As Rect
        'RenderSize版100.0139
        'Dim cVisual As GeneralTransform = ex.TransformToVisual(canvas1)
        'Dim r As Rect = cVisual.TransformBounds(New Rect(ex.RenderSize))
        'Return r

        'SourceのPixelWidth版100
        Dim gt As GeneralTransform = ex.TransformToVisual(canvas1)
        Dim b As BitmapImage = ex.Source
        Dim r As Rect = gt.TransformBounds(New Rect(New Size(b.PixelWidth, b.PixelHeight)))
        Return r
    End Function

    'すべてのExImageのRectのUnionのRectを取得
    Private Function GetUnion(ex As ObservableCollectionExImage) As Rect
        Dim r As Rect = GetRect(ex(0))
        For i As Integer = 1 To ex.Count - 1
            r = Rect.Union(r, GetRect(ex(i)))
        Next
        Return r
    End Function



    '画像ファイルとして保存

    '        キャンバスに描いた絵を画像ファイルとして保存する | HIRO's.NET Blog
    'http://blog.hiros-dot.net/?page_id=3802
    'Daizen Ikehara : [WPF] XamQRCodeBarcode を画像として保存 [Tips]
    'http://blogs.jp.infragistics.com/blogs/dikehara/archive/2014/02/12/wpf-xamqrcodebarcode-tips.aspx
    '    RenderTargetBitmap tips - Jaime Rodriguez - Site Home - MSDN Blogs
    'http://blogs.msdn.com/b/jaimer/archive/2009/07/03/rendertargetbitmap-tips.aspx

    Private Sub SaveAllImage()
        If CollectionExImage.Count = 0 Then Return '画像がなければ何もしない

        'ダイアログ設定
        Dim dialogSave As New Microsoft.Win32.SaveFileDialog
        With dialogSave
            .Filter = "*.png|*.png|*.jpg|*.jpg;*.jpeg|*.bmp|*.bmp|*.gif|*.gif|*.tiff|*.tiff"
            .AddExtension = True
        End With

        'ダイアログ表示
        If dialogSave.ShowDialog Then
            '保存画像サイズ取得
            Dim canvasRect As Rect = GetUnion(CollectionExImage)

            '描画先を作成
            Dim dv As New DrawingVisual
            Using dc As DrawingContext = dv.RenderOpen
                Dim vb As New VisualBrush(canvas1) 'Canvas内に表示されているもの自体を使ってVisualBrush作成
                dc.DrawRectangle(vb, Nothing, canvasRect) '四角形にブラシで塗り
            End Using

            '描画
            Dim rtb As New RenderTargetBitmap(canvasRect.Width, canvasRect.Height, 96, 96, PixelFormats.Pbgra32)
            rtb.Render(dv)

            '画像エンコーダ選択
            Dim enc As BitmapEncoder = Nothing
            Select Case dialogSave.FilterIndex
                Case 1
                    enc = New PngBitmapEncoder
                Case 2
                    Dim je As New JpegBitmapEncoder
                    je.QualityLevel = 97 '1-100 初期値は75
                    enc = je
                Case 3
                    enc = New BmpBitmapEncoder
                Case 4
                    enc = New GifBitmapEncoder
                Case 5
                    enc = New TiffBitmapEncoder
            End Select

            'エンコーダに画像フレームを渡す
            Dim bf As BitmapFrame = BitmapFrame.Create(rtb)
            enc.Frames.Add(bf)

            'ファイルとして保存
            Using fs As New FileStream(dialogSave.FileName, FileMode.Create)
                enc.Save(fs)
            End Using
        End If
    End Sub

    '画像ファイルとして保存
    Private Sub save_Click(sender As Object, e As RoutedEventArgs) Handles save.Click
        Call SaveAllImage()
    End Sub
    Private Sub kaiten_Click(sender As Object, e As RoutedEventArgs) Handles kaiten.Click
        Dim rtf As New RotateTransform(30)
        FocusExImage.RenderTransform = rtf
    End Sub



    '削除ボタン押した時
    Private Sub remove_Click(sender As Object, e As RoutedEventArgs) Handles remove.Click
        If FocusExImage Is Nothing Then Return
        Call RemoveExImage(FocusExImage)
    End Sub

    '選択画像削除
    Private Sub RemoveExImage(ex As ExImage)
        Dim i As Integer = CollectionExImage.IndexOf(ex) '削除対象のIndex取得
        CollectionExImage.Remove(ex) 'リストコレクションから削除
        canvas1.Children.Remove(ex) 'canvas1から削除(表示から消す)
        '削除後、選択画像(FocusExImage)の変更
        'ひとつ下の画像を選択、一番下だったらひとつ上の画像、最後の画像だったらNothingにする
        '画像が1つもなければ空にする
        '削除画像が一番下ならひとつ上の画像を選択
        'それ以外ならひとつ下の画像を選択
        If CollectionExImage.Count = 0 Then
            FocusExImage = Nothing
        ElseIf i = 0 Then
            FocusExImage = CollectionExImage(i)
        Else
            FocusExImage = CollectionExImage(i - 1)
        End If
    End Sub

End Class