ExtractFrames.vb
'' 
'' このコードは、DioDocs for Imaging のサンプルの一部として提供されています。
'' © MESCIUS inc. All rights reserved.
'' 
Imports System.IO
Imports System.Drawing
Imports System.Collections.Generic
Imports System.Linq
Imports System.Numerics
Imports GrapeCity.Documents.Drawing
Imports GrapeCity.Documents.Text
Imports GrapeCity.Documents.Imaging
Imports GCTEXT = GrapeCity.Documents.Text
Imports GCDRAW = GrapeCity.Documents.Drawing

'' このサンプルでは、TIFF 画像からフレームを抽出する方法と、
'' GcBitmap インスタンスとして読み込む方法を示します。
Public Class ExtractFrames
    Function GenerateImage(
        ByVal pixelSize As Size,
        ByVal dpi As Single,
        ByVal opaque As Boolean,
        Optional ByVal sampleParams As String() = Nothing) As GcBitmap

        '' 結果となる画像を作成します。
        Dim bmp = New GcBitmap(pixelSize.Width, pixelSize.Height, opaque, dpi, dpi)

        '' ターゲットビットマップの一部が塗りつぶされない可能性がある場合
        '' (この例のようにTIFF内のフレーム数が4未満になる可能性がある場合など)、
        '' 結果となるビットマップをクリアしなければなりません。これは、GcBitmapのコンストラクタが
        '' ピクセル用に割り当てられたメモリをクリアしないためです。
        '' (大きなビットマップの初期化は非常に遅くなる可能性があるため、時間を節約するためです。)
        bmp.Clear()

        '' サンプルTIFFのパス
        Dim imagePath = Path.Combine("Resources", "ImagesBis", "BmpWriteTiff3.tiff")

        '' TIFFフレーム用のビットマップを保持するリストです。
        Dim frameBmps(0) As GcBitmap

        '' TIFFファイルからすべてのフレームを読み取ります。
        Using stm = New FileStream(imagePath, FileMode.Open, FileAccess.Read, FileShare.Read, 4096, FileOptions.RandomAccess)
            Using tr = New GcTiffReader(stm)
                ReDim frameBmps(tr.Frames.Count - 1)
                For i = 0 To tr.Frames.Count - 1
                    frameBmps(i) = tr.Frames(i).ToGcBitmap()
                    frameBmps(i).Opaque = opaque
                Next
            End Using
        End Using

        '' フレームのビットマップをリサイズし、結果の画像にレンダリングします。
        Dim w = pixelSize.Width / 2
        Dim h = pixelSize.Height / 2
        If frameBmps.Length > 0 Then
            Using tbmp = frameBmps(0).Resize(w, h)
                bmp.BitBlt(tbmp, 0, 0)
            End Using
        End If
        If frameBmps.Length > 1 Then
            Using tbmp = frameBmps(1).Resize(w, h)
                bmp.BitBlt(tbmp, w, 0)
            End Using
        End If
        If frameBmps.Length > 2 Then
            Using tbmp = frameBmps(2).Resize(w, h)
                bmp.BitBlt(tbmp, 0, h)
            End Using
        End If
        If frameBmps.Length > 3 Then
            Using tbmp = frameBmps(3).Resize(w, h)
                bmp.BitBlt(tbmp, w, h)
            End Using
        End If

        '' フレームビットマップを破棄します。
        For Each tbmp In frameBmps
            tbmp.Dispose()
        Next

        '' 4つの領域の間に境界線を追加し、それぞれのキャプションを描画します。
        Using g = bmp.CreateGraphics()
            Dim foreColor = Color.Yellow
            Dim backColor = Color.Blue
            Dim fnt = GCTEXT.Font.FromFile(Path.Combine("Resources", "Fonts", "FreeMono.ttf"))
            Dim lineh = 2
            g.DrawLine(w, 0, w, h * 2, New GCDRAW.Pen(Color.Gray, lineh * 2))
            g.DrawLine(0, h, w * 2, h, New GCDRAW.Pen(Color.Gray, lineh * 2))
            Dim tf = New TextFormat() With {.Font = fnt, .FontSize = 18, .ForeColor = foreColor, .BackColor = backColor, .FontBold = True}
            Dim th = g.MeasureString("QWERTY", tf).Height
            If frameBmps.Length > 0 Then
                g.DrawString(" Frame 0 ", tf, New PointF(0, h - th + lineh))
            End If
            If frameBmps.Length > 1 Then
                g.DrawString(" Frame 1 ", tf, New PointF(w + lineh, h - th + lineh))
            End If
            If frameBmps.Length > 2 Then
                g.DrawString(" Frame 2 ", tf, New PointF(0, h * 2 + lineh - th + lineh))
            End If
            If frameBmps.Length > 3 Then
                g.DrawString(" Frame 3 ", tf, New PointF(w + lineh, h * 2 + lineh - th + lineh))
            End If
        End Using

        Return bmp
    End Function
End Class