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