強力鎯頭 VB BLOG

VB.Net 拆解多頁的 Tiff 的並存檔

一些數位證件或電腦接收的傳真亦或是掃瞄器掃出的多頁 TIFF 檔
該如何透過程式,逐一取出單張Tiff圖檔
(TIFF ; Tagged Image File Format) http://zh.wikipedia.org/wiki/TIFF

Sample 參考如下: 

Imports System Imports System.IO Imports System.Drawing Imports System.Drawing.Imaging Imports System.Runtime.InteropServices Public Class Form1 Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click Dim f() As String = {"C:\某資料夾\欲處理之Tiff圖檔.tif"} SplitTiff(f) ' 開始 End Sub Private Shared Sub SplitTiff(ByVal tifFiles() As String) Using encParas As New EncoderParameters(1) Dim Codec As ImageCodecInfo = GetTiffCodec() encParas.Param(0) = New EncoderParameter _ (Encoder.Compression, EncoderValue.CompressionCCITT4) For Each tif As String In tifFiles Dim p As String = Path.GetDirectoryName(tif) Dim f As String = Path.GetFileNameWithoutExtension(tif) Dim img As Image = Image.FromFile(tif) For l = 0 To img.GetFrameCount(FrameDimension.Page) - 1 img.SelectActiveFrame(FrameDimension.Page, l) Dim bmp As New Bitmap(img) bmp = cvt(bmp) bmp.Save(String.Format("{0}\{1}_{2}.tif", p, f, l), Codec, encParas) bmp.Dispose() Next img.Dispose() Next End Using End Sub Private Shared Function cvt(ByVal oriBmp As Bitmap) As Bitmap Dim srcBmp As Bitmap = Nothing If oriBmp.PixelFormat <> PixelFormat.Format32bppArgb Then srcBmp = New Bitmap(oriBmp.Width, oriBmp.Height, PixelFormat.Format32bppArgb) srcBmp.SetResolution(oriBmp.HorizontalResolution, oriBmp.VerticalResolution) Dim g As Graphics = Graphics.FromImage(srcBmp) g.DrawImageUnscaled(oriBmp, 0, 0) Else srcBmp = oriBmp End If Dim bmpData As BitmapData = srcBmp.LockBits(New Rectangle _ (0, 0, srcBmp.Width, srcBmp.Height), ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb) Dim imgSize As Int32 = bmpData.Stride * bmpData.Height Dim srcBuf(imgSize - 1) As Byte Marshal.Copy(bmpData.Scan0, srcBuf, 0, imgSize) srcBmp.UnlockBits(bmpData) Dim dstBmp As Bitmap = New Bitmap(srcBmp.Width, srcBmp.Height, PixelFormat.Format1bppIndexed) Dim dstData As BitmapData = dstBmp.LockBits(New Rectangle _ (0, 0, dstBmp.Width, dstBmp.Height), ImageLockMode.WriteOnly, PixelFormat.Format1bppIndexed) imgSize = dstData.Stride * dstData.Height Dim dstBuf(imgSize - 1) As Byte Dim srcIdx As Int32 = 0, dstIdx As Int32 = 0 Dim pxlTtl As Int32 = 0, dstVal As Byte = 0 Dim pxlVal As Int32 = 128 Dim ht As Int32 = srcBmp.Height, wd As Int32 = srcBmp.Width For y As Int32 = 0 To ht - 1 srcIdx = y * bmpData.Stride : dstIdx = y * dstData.Stride dstVal = 0 : pxlVal = 128 For x As Int32 = 0 To wd - 1 pxlTtl = Int32.Parse(srcBuf(srcIdx + 1)) + _ Int32.Parse(srcBuf(srcIdx + 2)) + _ Int32.Parse(srcBuf(srcIdx + 3)) If pxlTtl > 500 Then dstVal += CType(pxlVal, Byte) If pxlVal = 1 Then dstBuf(dstIdx) = dstVal dstIdx += 1 dstVal = 0 pxlVal = 128 Else pxlVal >>= 1 End If srcIdx += 4 Next If pxlVal <> 128 Then dstBuf(dstIdx) = dstVal Next Marshal.Copy(dstBuf, 0, dstData.Scan0, imgSize) dstBmp.UnlockBits(dstData) Return dstBmp End Function Private Shared Function GetTiffCodec() As ImageCodecInfo GetTiffCodec = Nothing For Each enc As ImageCodecInfo In ImageCodecInfo.GetImageEncoders If enc.FormatDescription.Equals("TIFF") Then Return enc Next End Function End Class