Excel VBAでTiffファイルのタグを読み込むプログラムを作りました。
Tiffファイルのフォーマットは最初にコメントで書いてありますが、詳細はこちらをご覧ください。
ソースコードは、ご自由にご利用ください。ただし、趣味のプログラムなので、保証はありません。
Option Explicit
'--------------------------------------------------
'TIFF(Tag Image File Format)ファイルの構造
'<Image File Header> + <Image File Directory (IFD)> + <画像データ>
'
'複数のIFDも可能
'ファイル内のどこに画像データを格納するかは自由
'
'--------------------------------------------------
'<Image File Header>
'ByteOrder 2bytes Intel系なら&H49(II), Motorola系なら&H4D(MM)
'42 2bytes 固定値
'Offset 4bytes 最初のIFDへのオフセット (ファイルの先頭からデータまでのバイト数, 偶数)
'
'--------------------------------------------------
'<Image File Directory (IFD)>
'<NumberOfDirectoryEntries> + <DirectoryEntry 1> + <DirectoryEntry 2> + ... + Offset
'
'NumberOfDirectoryEntries 2bytes DirectoryEntryの個数
'DirectoryEntry 12bytes
'Offset 4bytes 次のIFDへのオフセット (ファイルの先頭からデータまでのバイト数, 偶数)
'
'各DirectoryEntryには、画像の幅、高さ、画像データへのオフセットなどのデータが格納されている
'次のIFDが無い場合、Offsetはゼロ
'
'--------------------------------------------------
'<DirectoryEntry>
'Tag 2bytes データの名前
'Type 2bytes データの型
'Count 4bytes データの数
'Value 4bytes データ
'
'IFD内のDirectoryEntryは、Tagの値が小さい順に格納されている
'データのサイズが4バイト未満の場合、Valueは左詰め
'データのサイズが4バイトを超える場合、Valueはデータへのオフセット (ファイルの先頭からデータまでのバイト数)
'
'--------------------------------------------------
'<画像データ>
'<Strip 1> + <Strip 2> + ...
'
'画像データは1つ以上のStripで構成されている
'各StripへのオフセットはIFD内のStripOffsetsのDirectoryEntryに格納されている
'
'--------------------------------------------------
'DirectoryEntryのTag
'
'RGB Imageで必要な必須Tag
'256 SHORT/LONG ImageWidth 画像の幅
'257 SHORT/LONG ImageLength 画像の高さ
'258 SHORT BitsPerSample RGBなら1ピクセルに3サンプルなのでデータは8, 8, 8
'259 SHORT Compression 非圧縮なら1
'262 SHORT PhotometricInterpretation RGBなら2
'273 SHORT/LONG StripOffsets 各Stripへのオフセット
'277 SHORT SamplesPerPixel RGBなら3
'278 SHORT/LONG RowsPerStrip 1つのStripに格納されている行数
'279 LONG/SHORT StripByteCounts 1つのStripのバイトサイズ
'
'1つのStripにすべての画像データが格納されている24bit RGB画像の場合
'RowsPerStrip = ImageLength
'StripByteCounts = ImageWidth * ImageLength * 3
'
'必須ではないTag
'282 RATIONAL XResolution X方向の分解能
'283 RATIONAL YResolution Y方向の分解能
'296 SHORT ResolutionUnit 分解能の単位
'
'274 SHORT Orientation 画像の向き
'284 SHORT PlanarConfiguration データの格納方法(1 : RGBRGB..., 2 : R image, G image...)
'
'--------------------------------------------------
'DirectoryEntryのType
'
'1 Byte 1bytes
'2 ASCII 1bytes
'3 SHORT 2bytes
'4 LONG 4bytes
'
'--------------------------------------------------
Private Type DIRECTORY_ENTRY
Tag As Integer
Type As Integer
Count As Long
Value As Long
End Type
Dim ifde() As DIRECTORY_ENTRY
Public Sub test()
Dim i As Long
Dim filename As String
Dim width As Long
Dim height As Long
Dim data() As Byte
'------------------------------
ChDir ThisWorkbook.Path
filename = Application.GetOpenFilename
If filename = "False" Then Exit Sub
readTiff filename, data, width, height
'------------------------------
Sheet1.Cells.ClearContents
Sheet1.Cells(1, 1) = filename
Sheet1.Cells(2, 1) = FileLen(filename)
Sheet1.Cells(4, 1) = "Tag"
Sheet1.Cells(4, 2) = "Type"
Sheet1.Cells(4, 3) = "TypeList"
Sheet1.Cells(4, 4) = "TypeSize"
Sheet1.Cells(4, 5) = "Count"
Sheet1.Cells(4, 6) = "Value"
Sheet1.Cells(4, 7) = "TagList"
For i = LBound(ifde) To UBound(ifde)
Sheet1.Cells(5 + i, 1) = ifde(i).Tag
Sheet1.Cells(5 + i, 2) = ifde(i).Type
Sheet1.Cells(5 + i, 3) = typeList(ifde(i).Type)
Sheet1.Cells(5 + i, 4) = typeSize(ifde(i).Type)
Sheet1.Cells(5 + i, 5) = ifde(i).Count
Sheet1.Cells(5 + i, 6) = ifde(i).Value
Sheet1.Cells(5 + i, 7) = tagList(ifde(i).Tag)
Next i
'------------------------------
End Sub
'Tiffファイルの読み込み
'最初のIFDだけ読み込む
Public Sub readTiff(filename As String, ByRef data() As Byte, ByRef width As Long, ByRef height As Long)
On Error GoTo Label1
Dim i As Long
Dim buf() As Byte
Dim offset As Long
Dim num As Long
Open filename For Binary As 1
'------------------------------
'Image File Header
ReDim buf(3) As Byte
Get 1, , buf
If buf(0) <> &H49 Or buf(1) <> &H49 Then GoTo Label1
If buf(2) <> 42 Or buf(3) <> 0 Then GoTo Label1
Get 1, , offset
'------------------------------
'Image File Directory
Seek 1, offset + 1
ReDim buf(1) As Byte
Get 1, , buf
num = CLng(buf(1)) * 256 + buf(0)
ReDim ifde(num - 1) As DIRECTORY_ENTRY
Get 1, , ifde
Get 1, , offset
'------------------------------
Close 1
Exit Sub
Label1:
Close 1
MsgBox "error", vbExclamation
End Sub
Private Function typeList(tp As Integer) As String
If tp = 1 Then
typeList = "BYTE"
ElseIf tp = 2 Then typeList = "ASCII"
ElseIf tp = 3 Then typeList = "SHORT"
ElseIf tp = 4 Then typeList = "LONG"
ElseIf tp = 5 Then typeList = "RATIONAL"
ElseIf tp = 6 Then typeList = "SBYTE"
ElseIf tp = 7 Then typeList = "UNDEFINED"
ElseIf tp = 8 Then typeList = "SSHORT"
ElseIf tp = 9 Then typeList = "SLONG"
ElseIf tp = 10 Then typeList = "SRATIONAL"
ElseIf tp = 11 Then typeList = "FLOAT"
ElseIf tp = 12 Then typeList = "DOUBLE"
End If
End Function
Private Function typeSize(tp As Integer) As Long
If tp = 1 Then
typeSize = 1
ElseIf tp = 2 Then typeSize = 1
ElseIf tp = 3 Then typeSize = 2
ElseIf tp = 4 Then typeSize = 4
ElseIf tp = 5 Then typeSize = 8
ElseIf tp = 6 Then typeSize = 1
ElseIf tp = 7 Then typeSize = 1
ElseIf tp = 8 Then typeSize = 2
ElseIf tp = 9 Then typeSize = 4
ElseIf tp = 10 Then typeSize = 8
ElseIf tp = 11 Then typeSize = 4
ElseIf tp = 12 Then typeSize = 8
End If
End Function
Private Function tagList(Tag As Integer) As String
If Tag = 254 Then
tagList = "NewSubfileType"
ElseIf Tag = 255 Then tagList = "SubfileType"
ElseIf Tag = 256 Then tagList = "ImageWidth"
ElseIf Tag = 257 Then tagList = "ImageLength"
ElseIf Tag = 258 Then tagList = "BitsPerSample"
ElseIf Tag = 259 Then tagList = "Compression"
ElseIf Tag = 262 Then tagList = "PhotometricInterpretation"
ElseIf Tag = 263 Then tagList = "Threshholding"
ElseIf Tag = 264 Then tagList = "CellWidth"
ElseIf Tag = 265 Then tagList = "CellLength"
ElseIf Tag = 266 Then tagList = "FillOrder"
ElseIf Tag = 269 Then tagList = "DocumentName"
ElseIf Tag = 270 Then tagList = "ImageDescription"
ElseIf Tag = 271 Then tagList = "Make"
ElseIf Tag = 272 Then tagList = "Model"
ElseIf Tag = 273 Then tagList = "StripOffsets"
ElseIf Tag = 274 Then tagList = "Orientation"
ElseIf Tag = 277 Then tagList = "SamplesPerPixel"
ElseIf Tag = 278 Then tagList = "RowsPerStrip"
ElseIf Tag = 279 Then tagList = "StripByteCounts"
ElseIf Tag = 280 Then tagList = "MinSampleValue"
ElseIf Tag = 281 Then tagList = "MaxSampleValue"
ElseIf Tag = 282 Then tagList = "XResolution"
ElseIf Tag = 283 Then tagList = "YResolution"
ElseIf Tag = 284 Then tagList = "PlanarConfiguration"
ElseIf Tag = 285 Then tagList = "PageName"
ElseIf Tag = 286 Then tagList = "XPosition"
ElseIf Tag = 287 Then tagList = "YPosition"
ElseIf Tag = 288 Then tagList = "FreeOffsets"
ElseIf Tag = 289 Then tagList = "FreeByteCounts"
ElseIf Tag = 290 Then tagList = "GrayResponseUnit"
ElseIf Tag = 291 Then tagList = "GrayResponseCurve"
ElseIf Tag = 292 Then tagList = "T4Options"
ElseIf Tag = 293 Then tagList = "T6Options"
ElseIf Tag = 296 Then tagList = "ResolutionUnit"
ElseIf Tag = 297 Then tagList = "PageNumber"
ElseIf Tag = 301 Then tagList = "TransferFunction"
ElseIf Tag = 305 Then tagList = "Software"
ElseIf Tag = 306 Then tagList = "DateTime"
ElseIf Tag = 315 Then tagList = "Artist"
ElseIf Tag = 316 Then tagList = "HostComputer"
ElseIf Tag = 317 Then tagList = "Predictor"
ElseIf Tag = 318 Then tagList = "WhitePoint"
ElseIf Tag = 319 Then tagList = "PrimaryChromaticities"
ElseIf Tag = 320 Then tagList = "ColorMap"
ElseIf Tag = 321 Then tagList = "HalftoneHints"
ElseIf Tag = 322 Then tagList = "TileWidth"
ElseIf Tag = 323 Then tagList = "TileLength"
ElseIf Tag = 324 Then tagList = "TileOffsets"
ElseIf Tag = 325 Then tagList = "TileByteCounts"
ElseIf Tag = 332 Then tagList = "InkSet"
ElseIf Tag = 333 Then tagList = "InkNames"
ElseIf Tag = 334 Then tagList = "NumberOfInks"
ElseIf Tag = 336 Then tagList = "DotRange"
ElseIf Tag = 337 Then tagList = "TargetPrinter"
ElseIf Tag = 338 Then tagList = "ExtraSamples"
ElseIf Tag = 339 Then tagList = "SampleFormat"
ElseIf Tag = 340 Then tagList = "SMinSampleValue"
ElseIf Tag = 341 Then tagList = "SMaxSampleValue"
ElseIf Tag = 342 Then tagList = "TransferRange"
ElseIf Tag = 512 Then tagList = "JPEGProc"
ElseIf Tag = 513 Then tagList = "JPEGInterchangeFormat"
ElseIf Tag = 514 Then tagList = "JPEGInterchangeFormatLngth"
ElseIf Tag = 515 Then tagList = "JPEGRestartInterval"
ElseIf Tag = 517 Then tagList = "JPEGLosslessPredictors"
ElseIf Tag = 518 Then tagList = "JPEGPointTransforms"
ElseIf Tag = 519 Then tagList = "JPEGQTables"
ElseIf Tag = 520 Then tagList = "JPEGDCTables"
ElseIf Tag = 521 Then tagList = "JPEGACTables"
ElseIf Tag = 529 Then tagList = "YCbCrCoefficients"
ElseIf Tag = 530 Then tagList = "YCbCrSubSampling"
ElseIf Tag = 531 Then tagList = "YCbCrPositioning"
ElseIf Tag = 532 Then tagList = "ReferenceBlackWhite"
ElseIf Tag = 33432 Then tagList = "Copyright"
End If
End Function
0 件のコメント:
コメントを投稿