イメージビューワー(4)

VB SampleImageViewer 4 : Addition

　画像ビューワーの４回目です。４回目は拡張編です。画像処理で、追加可能な機能のうち、主なものの自作サンプルを掲載します。ここでは、画像の保存、枠入れ・文字入れ、トリミング を取り上げています。

【INDEX】
・Page 1 [本編]　プロジェクトの概観 / メインフォームの設計 / フォルダツリーの作成
・Page 2 [本編]　サムネールの設計 / サムネールの作成 / 画像サイズの設定 / 画像一覧の表示
・Page 3 [本編]　サブフォームの設計 / 元画像の表示 / 画像の拡大・縮小 / 画像の回転・反転
»Page4 [拡張編]　画像の保存 / 画像への枠入れ・文字入れ / 画像のトリミング
・Page 5 [番外編]　スライドショー / マニュアル・スライド / フィットモード / オート・スライド

（作成環境 : Visual Basic .net 2002 / Framework SDK 1.0）

●画像の保存

　画像の保存は、Imageクラスの Saveメソッドを使用します。表示中のイメージは、PIC1.Image で取得できます。保存形式は、ここでは、BMP, JPG, PNG, GIF を指定できるようにしています。JPGで保存する時は、画質を指定することができます。サンプルでは、高画質（(90), 標準画質(75), 低画質(60)に分けています。ただし、コーデック情報を取得して要素 （この場合は Quality） と値を設定する必要があります。

・ 通常の保存 ... PIC1.Image.Save(保存ファイル名, 保存形式）
・ JPGで画質指定 ... PIC1.Image.Save(保存ファイル名, コーデック情報, 指定する要素と値）

　コーデックとは、データを変換（圧縮・圧縮解除）するしくみのことです。この仕様はファイル形式によって異なります。下記のサンプルはかなり長くなっていますが、保存ファイルダイアログの設定や処理にかかるコードが長いだけです。

SubForm.vb
' イメージの保存
Private Sub SaveImage()
    If IsNothing(PIC1.Image) Then Exit Sub
    Dim oDialog As New SaveFileDialog()              ' 保存ダイアログ
    Dim oParams As Imaging.EncoderParameters  ' エンコーダ・パラメータ

    Try
        Dim sExt As String = LCase(IO.Path.GetExtension(m_path))  ' 拡張子の取得

        ' ダイアログボックスの初期化
        With oDialog
            .DefaultExt = sExt               ' 既定の拡張子
            .OverwritePrompt = False    ' 同名ファイルの自動警告をしない
            .FileName = m_path             ' ダイアログに表示するファイル名
            .Filter = "BMP(*.bmp)|*.bmp|JPG/高画質(*.jpg)|*.jpg|JPG/標準画質(*.jpg)" _
                    & "|*.jpg|JPG/低画質(*.jpg)|*.jpg|PNG(*.png)|*.png|GIF(*.gif)|*.gif" ' フィルター
        End With

        ' 拡張子からフィルターを自動選択（指定がない時はBMP）
        If sExt = ".jpg" Then : oDialog.FilterIndex = 3
        ElseIf sExt = ".jpeg" Then : oDialog.FilterIndex = 3
        ElseIf sExt = ".png" Then : oDialog.FilterIndex = 5
        ElseIf sExt = ".gif" Then : oDialog.FilterIndex = 6
        Else : oDialog.FilterIndex = 1
        End If

        ' ダイアログの表示 〜 保存処理の実行
        If oDialog.ShowDialog = DialogResult.OK Then
            Dim bJPG As Boolean = False               ' JPGかどうか
            Dim sFile As String = oDialog.FileName  ' 保存ファイル名
            Dim oFormat As Imaging.ImageFormat    ' 保存フォーマット
            Dim nQuality As Integer                       ' 画質(JGPのみ)

            ' 保存形式とオプションの取得
            sExt = ""
            If oDialog.FilterIndex = 1 Then
                oFormat = Imaging.ImageFormat.Bmp
                sExt = ".bmp"
            ElseIf oDialog.FilterIndex = 5 Then
                oFormat = Imaging.ImageFormat.Png
                sExt = ".png"
            ElseIf oDialog.FilterIndex = 6 Then
                oFormat = Imaging.ImageFormat.Gif
                sExt = ".gif"
            Else
                bJPG = True
                oFormat = Imaging.ImageFormat.Jpeg
                sExt = ".jpg"
                If oDialog.FilterIndex = 2 Then : nQuality = 90
                ElseIf oDialog.FilterIndex = 3 Then : nQuality = 75
                ElseIf oDialog.FilterIndex = 4 Then : nQuality = 60
                End If
            End If

            ' 拡張子の指定に変更がある時はファイル名を変更
            If sExt <> "" AndAlso sFile.EndsWith(sExt) = False Then
                sFile = IO.Path.ChangeExtension(sFile, sExt)
            End If

            ' 同名のファイルが存在した時は警告を表示
            If IO.File.Exists(sFile) Then
                If MessageBox.Show("ファイル [" & sFile & "] と同じ名前のファイルがあります。" _
                    & vbCrLf & "上書きして保存しますか？", "上書き保存", _
                    MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation) = DialogResult.No _
                    Then : Exit Try
                End If
            End If

            ' JPG で保存する場合
            If bJPG Then
                ' コーデック一覧の取得
                Dim aInfo() As Imaging.ImageCodecInfo _
                            = Imaging.ImageCodecInfo.GetImageEncoders()

                ' コーデック一覧から MIME = "image/jpeg" を探す
                Dim oInfo As Imaging.ImageCodecInfo
                For Each oInfo In aInfo
                    If oInfo.MimeType = "image/jpeg" Then
                        ' MIME が見つかれば画質(nQuality)をパラメータに指定して保存
                        oParams = New Imaging.EncoderParameters(1)
                        oParams.Param(0) = _
                                New Imaging.EncoderParameter(Imaging.Encoder.Quality, nQuality)
                        PIC1.Image.Save(sFile, oInfo, oParams)
                        Exit Try
                    End If
                Next
            End If

            ' JPG以外か、JPGでMIMEが見つからない時は、既定の方法で保存
            PIC1.Image.Save(sFile, oFormat)
        End If

    Catch ex As Exception        ' 例外処理
        MessageBox.Show(ex.Message, "エラー", _
                    MessageBoxButtons.OK, MessageBoxIcon.Stop)
    End Try

    ' リソースの解放
    If Not IsNothing(oParams) Then oParams.Dispose()
    If Not IsNothing(oDialog) Then oDialog.Dispose()
End Sub    

●画像への枠入れ・文字入れ

　表示中のイメージに枠や文字を追加する機能です。表示中の画像である PIC1.Image を取り出して、グラフィックオブジェクトで、直接文字や図形を描画するだけです。
　ここでは、あらかじめ決めておいた色や太さ、位置、サイズ等の枠/文字を入れるサンプルのみを示します。興味のある方は、色や位置、サイズなどをダイアログボックスなどで指定できるよう工夫して、より実用的なものにしてください。

SubForm.vb

' 枠入れ
Private Sub AddFrame()
    Dim g As Graphics = Graphics.FromImage(PIC1.Image)
    Dim p As New Pen(Color.FromArgb(102, 0, 0, 204), 10)

    g.DrawRectangle(p, 0, 0, PIC1.Image.Width, PIC1.Image.Height)    ' 四角形を描画

    p.Dispose()
    g.Dispose()
    PIC1.Invalidate()
End Sub

' 文字入れ
Private Sub AddString()
    Dim g As Graphics = Graphics.FromImage(PIC1.Image)
    Dim f As New Font("MS UI Gothic", 18, FontStyle.Bold, GraphicsUnit.Pixel)
    Dim br As New SolidBrush(Color.FromArgb(192, 192, 0, 0))

    g.DrawString("絵図帖", f, br, 10, 10)                ' 文字を描画

    br.Dispose()
    f.Dispose()
    g.Dispose()
    PIC1.Invalidate()
End Sub    

　枠や文字が入ったままの画像は、もちろん保存が可能です。ただし、上例では元画像 (m_image) はそのままにしていますので、拡大・縮小などの操作をすると消えてしまいます。消えないようにするには、

　m_image.Dispose()
　m_image = New Bitmap(PIC1.Image)

といった記述を追加するなどして、 m_image を入れ替えれる必要があります。

●画像のトリミング

　Graphicsクラスには、トリミングに対応した DrawImage メソッドのオーバーロードが用意されています。

　DrawImage( 元画像, 描画領域, 抽出範囲, 描画単位 )

　このパターンを使用すると、元画像の指定した範囲を、指定した領域に描画できます。元の範囲と描画領域のサイズが異なる時は、描画領域に合わせて、自動的に拡大・縮小が行われます。
　下記は、トリミングを実行する関数の例です。引数に、表示画像の中の抽出範囲を Rectangle構造体で指定するようにしています。表示中の画像は PIC1.Image で取り出すことができますので、指定範囲を新しいイメージオブジェクトを作成して描画し直せば、トリミングの完了です。

SubForm.vb
' トリミング（引数rect : 抽出領域）
Private Sub TrimImage(ByVal rect As Rectangle)
    ' 新しいビットマップ、グラフィックオブジェクト、描画領域の作成
    Dim m As New Bitmap(rect.Width, rect.Height)
    Dim g As Graphics = Graphics.FromImage(m)
    Dim r As New Rectangle(0, 0, rect.Width, rect.Height) 

    ' 作成したビットマップに元画像の選択領域を描画
    g.DrawImage(PIC1.Image, r, rect, GraphicsUnit.Pixel) 
    g.Dispose()

    ' 元画像を入れ替えて表示
    m_image.Dispose()
    m_image = m
    DrawImage()
End Sub    

　上記の例では、元画像を入れ替えてから再表示を行っています。拡大や縮小などの操作は、抽出した画像が対象となります。元画像を入れ替えたくない時は、PIC1.Image に対してのみ画像を入れ替えます。
　なお、抽出範囲を指定する仕様は様々考えられますが、ここでは、ラベルをマウスで操作して選択（上図・範囲選択の半透明部分）するサンプルを掲載しておきます。ラベルに透明色（アルファ値）を設定して下の画像が確認できるようにして、さらに、マウス操作に応じて大きさが変わるようになっています。

Private m_trim As Boolean = False     ' トリムフラグ
Private m_label As Label                   ' トリムの範囲表示用ラベル
Private m_coord As Point                 ' 座標記憶用

' フォームのアンロードイベント
Protected Overrides Sub OnClosing(ByVal e As System.ComponentModel.CancelEventArgs)
    If Not IsNothing(m_image) Then m_image.Dispose()
    If Not IsNothing(m_label) Then m_label.Dispose()        ' 追加したコード
End Sub

' マウスイベント ... MouseDown
Private Sub PIC1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
            Handles PIC1.MouseDown
    If e.Button = MouseButtons.Left Then
        'トリムモードの時
        If m_trim Then
            m_coord = New Point(e.X, e.Y)        ' 始点座標の取得
            '領域確認用ラベルの追加
            If Not IsNothing(m_label) Then m_label.Dispose()
            m_label = New Label()
            m_label.BackColor = Color.FromArgb(51, 64, 64, 64)
            m_label.Text = ""
            PIC1.Controls.Add(m_label)             ' ラベルを PIC1 に追加
        End If
    End If
End Sub

' マウスイベント ... MouseMove
Private Sub PIC1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
            Handles PIC1.MouseMove
    Static r As Rectangle      ' 現在のトリミング領域
    Static pt As Point           ' スクロールさせる座標
    If m_trim Then
        If Not IsNothing(m_label) Then
            ' 自動スクロール（常に終点座標の画像部分が表示されるようにする）
            Dim b As Boolean = False    ' スクロールさせるかどうか
            If e.X + PN1.AutoScrollPosition.X > PN1.ClientSize.Width Then
                pt.X = (PN1.AutoScrollPosition.X - 1) * -1    ' 右側
                b = True
            ElseIf e.X + PN1.AutoScrollPosition.X < 0 Then
                pt.X = (PN1.AutoScrollPosition.X + 1) * -1    ' 左側
                b = True
            End If
            If e.Y + PN1.AutoScrollPosition.Y > PN1.ClientSize.Height Then
                pt.Y = (PN1.AutoScrollPosition.Y - 1) * -1    ' 下側
                b = True
            ElseIf e.Y + PN1.AutoScrollPosition.Y < 0 Then
                pt.Y = (PN1.AutoScrollPosition.Y + 1) * -1    ' 上側
                b = True
            End If
            If b Then PN1.AutoScrollPosition = pt               ' スクロールの実行

            ' 終点座標の取得
            r.X = e.X
            r.Y = e.Y
            ' X座標のチェック（はみ出した部分をカット）
            If e.X < 0 Then r.X = 0
            If e.X > PIC1.Image.Width Then r.X = PIC1.Image.Width
            ' Y座標のチェック（はみ出した部分をカット）
            If e.Y < 0 Then r.Y = 0
            If e.Y > PIC1.Image.Height Then r.Y = PIC1.Image.Height
            ' サイズの取得（絶対値を算出）
            r.Width = Math.Abs(r.X - m_coord.X)
            r.Height = Math.Abs(r.Y - m_coord.Y)
            ' 左上隅座標のチェック（始点と終点で値の小さい方を採用）
            If r.X > m_coord.X Then r.X = m_coord.X
            If r.Y > m_coord.Y Then r.Y = m_coord.Y
            ' ラベルを再配置
            m_label.SetBounds(r.X, r.Y, r.Width, r.Height)
        End If
    End If
End Sub

' マウスイベント ... MouseUp
Private Sub PIC1_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) _
            Handles PIC1.MouseUp
    If m_trim Then
        If Not IsNothing(m_label) Then
            ' 抽出領域の確定
            Dim r As New Rectangle(m_label.Location, m_label.Size)
            ' 確認ダイアログの表示
            If MessageBox.Show("この範囲を抽出しますか？", "トリミング", _
                MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.Yes _
                Then : TrimImage(r)        ' トリミングの実行
            End If
            m_label.Dispose()                ' ラベルの破棄
            m_label = Nothing               ' 変数を初期化
        End If
        m_trim = False                       ' トリムモードを解除
    End If
End Sub

' ツールバーボタン（トリム用に tbTrim ボタンを設定したとして）
Private Sub TB1_ButtonClick(ByVal sender As Object, _
            ByVal e As ToolBarButtonClickEventArgs) Handles TB1.ButtonClick
    If e.Button Is tbSave Then
        SaveImage()
    ElseIf ...
        ... （略）
        ...
    ElseIf e.Button Is tbTrim Then
        m_trim = True                ' トリムモードをオンにする
    End If
End Sub    

* AutoScrollPosition について
　このコードの制作時の環境（バージョン）では、取得時はマイナス値となりますが、設定時はプラス値でないと無効になってしまうようです。-1 を掛けているのはそのためです。