'''' This code is part of Document Solutions for Imaging demos.'' Copyright (c) MESCIUS inc. All rights reserved.''Imports System.IOImports System.DrawingImports System.Collections.GenericImports System.LinqImports System.NumericsImports GrapeCity.Documents.DrawingImports GrapeCity.Documents.TextImports GrapeCity.Documents.ImagingImports GCTEXT = GrapeCity.Documents.TextImports GCDRAW = GrapeCity.Documents.Drawing
'' This sample shows how to extract frames from a TIFF image,'' and how to read them as GcBitmap instances.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
        '' Create the resulting image:        Dim bmp = New GcBitmap(pixelSize.Width, pixelSize.Height, opaque, dpi, dpi)
        '' If there is a possibility that we will not fill some areas of the target bitmap        '' (as in this case where the number of frames in the TIFF may be less than 4),        '' we MUST clear the resulting bitmap as GcBitmap ctor does NOT clear the memory        '' allocated for the pixels (to save time, as initializing large bitmaps may be        '' very slow):        bmp.Clear()
        '' Sample TIFF image path:        Dim imagePath = Path.Combine("Resources", "ImagesBis", "BmpWriteTiff3.tiff")
        '' List to hold bitmaps for the TIFF frames:        Dim frameBmps(0) As GcBitmap
        '' Read all frames from the TIFF file:        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
        '' Resize and render the frames' bitmaps into the resulting image:        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
        '' Dispose the frame bitmaps:        For Each tbmp In frameBmps            tbmp.Dispose()        Next
        '' Add borders between the quadrants, and captions for each:        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 FunctionEnd Class