2018年9月10日月曜日

Excel VBAでTiff その2

 前回のプログラムを少しいじって、Tiffファイルを読み書きできるようにしました。ただし、面倒なのでRGBだけとか制限をつけていますが。
 作ってみて思うのですが、やっぱりBitmapのフォーマットが単純でいいです。。。

 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

Private ifde() As DIRECTORY_ENTRY

Public Sub test()
    Dim i As Long
    Dim j As Long
    Dim pos As Long
    Dim filename As String
    Dim width As Long
    Dim height As Long
    Dim data() As Byte
 
    '------------------------------
    width = 128
    height = 128
    ReDim data(width * height * 3 - 1) As Byte
 
 
    For i = 0 To height - 1
        For j = 0 To width - 1
            pos = (i * width + j) * 3
            data(pos + 0) = 255 * j / width
            data(pos + 1) = 255 * i / height
            data(pos + 2) = 0
        Next j
    Next i
 
    '------------------------------
    filename = ThisWorkbook.Path + "\temp.tif"
    writeTiff filename, data, width, height
 
    '------------------------------
    readTiff filename, data, width, height
 
    '------------------------------
End Sub

'Tiffファイルの保存
'Intel系, IFDは1個, Stripは1個, 24bitフルカラーのみ対応
Public Sub writeTiff(filename As String, data() As Byte, width As Long, height As Long)
    Dim buf() As Byte
    Dim offset As Long
 
    Open filename For Binary As 1
        '------------------------------
        'Image File Header
        ReDim buf(3) As Byte
        buf(0) = &H49
        buf(1) = &H49
        buf(2) = 42
        buf(3) = 0
        Put 1, , buf
     
        offset = width * height * 3 + 8
        Put 1, , offset
     
        '------------------------------
        '画像データ
        Put 1, , data
     
        '------------------------------
        'Image File Directory
        ReDim buf(1) As Byte
        buf(0) = 11
        buf(1) = 0
        Put 1, , buf
     
        ReDim ifde(10) As DIRECTORY_ENTRY
        ifde(0).Tag = 256: ifde(0).Type = 3: ifde(0).Count = 1: ifde(0).Value = width
        ifde(1).Tag = 257: ifde(1).Type = 3: ifde(1).Count = 1: ifde(1).Value = height
        ifde(2).Tag = 258: ifde(2).Type = 3: ifde(2).Count = 3: ifde(2).Value = offset + 138
        ifde(3).Tag = 259: ifde(3).Type = 3: ifde(3).Count = 1: ifde(3).Value = 1
        ifde(4).Tag = 262: ifde(4).Type = 3: ifde(4).Count = 1: ifde(4).Value = 2
        ifde(5).Tag = 273: ifde(5).Type = 4: ifde(5).Count = 1: ifde(5).Value = 8
        ifde(6).Tag = 274: ifde(6).Type = 3: ifde(6).Count = 1: ifde(6).Value = 1
        ifde(7).Tag = 277: ifde(7).Type = 3: ifde(7).Count = 1: ifde(7).Value = 3
        ifde(8).Tag = 278: ifde(8).Type = 3: ifde(8).Count = 1: ifde(8).Value = height
        ifde(9).Tag = 279: ifde(9).Type = 4: ifde(9).Count = 1: ifde(9).Value = width * height * 3
        ifde(10).Tag = 284: ifde(10).Type = 3: ifde(10).Count = 1: ifde(10).Value = 1
        Put 1, , ifde
     
        offset = 0
        Put 1, , offset
     
        'BitsPerSample
        ReDim buf(5) As Byte
        buf(0) = 8
        buf(1) = 0
        buf(2) = 8
        buf(3) = 0
        buf(4) = 8
        buf(5) = 0
        Put 1, , buf
     
        '------------------------------
    Close 1
End Sub

'Tiffファイルの読み込み
'Intel系, IFDは1個, Stripは1個, 24bitフルカラーのみ対応
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
     
        '------------------------------
        For i = 0 To num - 1
            If ifde(i).Type = 3 And ifde(i).Count = 1 Then
                ifde(i).Value = ifde(i).Value Mod CLng(256) * 256
            End If
        Next i
     
        For i = 0 To num - 1
            If ifde(i).Tag = 256 Then
                width = ifde(i).Value
            ElseIf ifde(i).Tag = 257 Then
                height = ifde(i).Value
            End If
        Next i
     
        For i = 0 To num - 1
            If ifde(i).Tag = 258 Then
                If ifde(i).Type <> 3 Then GoTo Label1
                If ifde(i).Count <> 3 Then GoTo Label1
                ReDim buf(5) As Byte
                Seek 1, ifde(i).Value + 1
                Get 1, , buf
                If buf(0) <> 8 Or buf(1) <> 0 Or buf(2) <> 8 Or buf(3) <> 0 Or buf(4) <> 8 Or buf(5) <> 0 Then GoTo Label1
            ElseIf ifde(i).Tag = 259 And ifde(i).Value <> 1 Then GoTo Label1
            ElseIf ifde(i).Tag = 262 And ifde(i).Value <> 2 Then GoTo Label1
            ElseIf ifde(i).Tag = 277 And ifde(i).Value <> 3 Then GoTo Label1
            ElseIf ifde(i).Tag = 278 And ifde(i).Value <> height Then GoTo Label1
            ElseIf ifde(i).Tag = 279 And ifde(i).Value <> width * height * 3 Then GoTo Label1
            ElseIf ifde(i).Tag = 274 And ifde(i).Value <> 1 Then GoTo Label1
            ElseIf ifde(i).Tag = 284 And ifde(i).Value <> 1 Then GoTo Label1
            End If
        Next i
     
        '------------------------------
        '画像データ
        For i = 0 To num - 1
            If ifde(i).Tag = 279 Then
                ReDim data(ifde(i).Value - 1) As Byte
            End If
        Next i
     
        For i = 0 To num - 1
            If ifde(i).Tag = 273 Then
                Seek 1, ifde(i).Value + 1
                Get 1, , data
            End If
        Next i
     
        '------------------------------
    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

Excel VBAでTiff その1

 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

Excel VBAでSort

 昔作ったExcel VBAのSortのプログラムを見つけました。せっかくなので、以下に載せます。

 10,000個くらいの数値なら一瞬でソートしてくれました。1,000,000個くらいになるとPCが少し固まりました。
 ビッグデータなんてのが流行っていますが、データ件数が1,000,000を超えると処理に時間がかかって大変そうです。

 ソースコードは、ご自由にご利用ください。ただし、趣味のプログラムなので、保証はありません。


Option Explicit

Public Sub test()
    Dim i As Long
    Dim N As Long
    Dim num() As Long
 
    Sheet1.Cells.ClearContents
 
    N = 8
    ReDim num(N - 1) As Long
 
    For i = 0 To N - 1
        num(i) = N * Rnd()
    Next i
 
    For i = 0 To N - 1
        Sheet1.Cells(i + 1, 1) = num(i)
    Next i
 
    'sort_selection num, N
    'sort_insert num, N
    sort_quick num, 0, N - 1
 
    For i = 0 To N - 1
        Sheet1.Cells(i + 1, 2) = num(i)
    Next i
End Sub

'選択ソート
'最小値を見つけて、小さい順に並べる
Public Sub sort_selection(num() As Long, N As Long)
    Dim i As Long
    Dim j As Long
    Dim temp As Long
 
    For i = 0 To N - 1
        For j = i To N - 1
            If num(j) < num(i) Then
                temp = num(i)
                num(i) = num(j)
                num(j) = temp
            End If
        Next j
    Next i
End Sub

'挿入ソート
'ソートされている部分に後ろから1つずつ値を挿入していく
Public Sub sort_insert(num() As Long, N As Long)
    Dim i As Long
    Dim j As Long
    Dim temp As Long
 
    For i = 0 To N - 1
        temp = num(i)
     
        For j = i To 1 Step -1
            If temp < num(j - 1) Then
                num(j) = num(j - 1)
            Else
                Exit For
            End If
        Next j
         
        num(j) = temp
    Next i
End Sub

'クイックソート
'pivotの値より大きいか小さいかで選り分ける
Public Sub sort_quick(num() As Long, n1 As Long, n2 As Long)
    Dim i As Long
    Dim j As Long
    Dim pivot As Long
    Dim temp As Long
 
    '------------------------------
    'すべての値が同じ場合は、ここで終了
    For i = n1 To n2
        If num(n1) <> num(i) Then Exit For
    Next i
 
    If i = n2 + 1 Then Exit Sub
 
    '------------------------------
    'pivotを選択 (pivotより小さい値が必ず存在する)
    If num(n1) < num(i) Then
        pivot = num(i)
    Else
        pivot = num(n1)
    End If
 
    '------------------------------
    i = n1
    j = n2
 
    Do While True
        Do While num(i) < pivot
            i = i + 1
        Loop
     
        Do While pivot <= num(j)
            j = j - 1
        Loop
     
        If j < i Then Exit Do
     
        temp = num(i)
        num(i) = num(j)
        num(j) = temp
    Loop
 
    sort_quick num, n1, i - 1
    sort_quick num, j + 1, n2
End Sub

2018年8月12日日曜日

ケネディの言葉を思い返して

"Ask not what your country can do for you, ask what you can do for your country."

 ジョン・F・ケネディの大統領就任演説の一節です。平易な言葉で構成され、前半と後半がきれいに対比されている、美しい文章だと思います。


 ここ数年、地震、豪雨、猛暑と自然災害が続きます。そういった災害が起きると、国の助成金の話が出てくるものです。
 年金、生活保護、地方交付金など、国がお金を払う支援制度は、あまたあります。
 過労死の問題で、国の支援を要求するなんて話もありました。


「弱者が国の支援を求める」そんなニュースを聞くことは、少なからずあります。助けを求めるのは間違いではないでしょう。
 ですが、支援ばかりを要求するコメントを聞くと、不快に感じます。

 社会の支援を求めるだけでなく、社会のために貢献することは大事なことです。金銭ばかりを要求する放蕩者ではいけないと思うのです。

 ケネディ大統領の演説を思い返して、そんなことを考えたりしてます。


2018年6月3日日曜日

モンテスキューに敬意を込めて

 ここのところ、国会では、官僚が文書を改ざんしたとか、政治家が失言したとか、といった話題が盛んに話されているようです。
 聞いていて辟易します。「国会は法律を作る立法府」じゃなかったっけ?というところから、私はモンテスキューを思い出しました。

 モンテスキューについては、小学生のときに習いました。「法の精神」を著した人物で、権力を立法、司法、行政に分ける三権分立を提唱した人と記憶しています。

 小学生の私は、「まぁ、そんなものなのか」と思っていました。「学校で教えるのだから、きっと大事なことなのだろう」くらいに思っていました。今の子供も三権分立というのを習うのでしょうか?習ったとしても、国会が立法府であることを理解するのは難しいかもしれません。

 かつてモンテスキューが考えていた事と、今の国会で言ったとか言ってないとかを延々と話している方々の考えている事は、まったく別物でしょう。

参考:Wikipedia 法の精神

2018年3月18日日曜日

Where my money at ?

 珍しく東京で電車に乗った時のことですが、小学校5,6年生と思しき子供が本を読んでいるのを見かけました。読んでいた本は、「ピーター・リンチの株で勝つ」。
 昨今は、子供も投資を考える時代みたいです。

 (私はこの本を読んでいないので、詳しくは知りませんが。)

 政府は投資を推奨しているみたいです。少額投資非課税制度 (NISA) や、確定拠出型年金 (Idecoなど) が色々なところで宣伝されています。
 (正直なところ、確定拠出年金のように、半ば強制的に投資させられるのは、いい気分ではないです。)

 みんなが投資すれば、市場にお金が供給されて、物価上昇率2%の目標も達成できるでしょう。
 ワー、スバラシー (棒読み)。

 投資は重要な経済活動です。投資で資金が集まる産業は発展します。つまり、将来的に発展させたい産業に投資が行われるようにすべきです。
 どの産業を発展させるかの選択は、非常に難しい問題です。政治的な意図も絡んできます。将来を左右する問題である以上、あまり安易に投資を推奨されるのには違和感を覚えます。

 ただ株価の数字だけ見て利益を追及するのはマネーゲームです。「利益のためなら、どんな犯罪組織に投資してもOK」ということになってしまいます。
 残念ながら、将来の社会を見据えた投資と、ただのマネーゲームとの区別は難しいです。

 
 政府が推奨しているのだから、これからは投資が盛んに行われる社会になるのかもしれません。
 私の希望としては、「パソコンに向かっているだけのトレーダー」が得をして、「汗を流して働いている労働者」が損をする、そんな社会にはなって欲しくないです。



 余談ですが、今回のタイトルは、Wyclef Jeanの"Sweetest Girl"という曲からとりました。"~work for the president"ってところの歌詞が面白いです。


C#でファイルサイズのリストを作ろう

 パソコンのHDDの空き容量が少なくなってきたので、いらないファイルがないか調べてみることにしました。

 コマンドプロンプトで、
    dir /s /-c > filelist.txt
と入力して実行します。すると、filelist.txtには、現在のディレクトリの下にある全てのファイルとディレクトリが出力されます。"/s"は下の階層まで表示するオプションで、"/-c"はファイルサイズの数字にカンマを入れないというオプションです。

 これを、Cドライブの直下でやると、Cドライブにある全てのファイルとディレクトリが出力されます。処理に1分くらいかかるかもしれません。私の場合、出力結果は30MByteくらいになりました。

 これでファイルサイズのリスト自体はできるのですが、余計な文字列があるため分かりにくいです。というわけで、C#でファイルサイズとファイル名だけ抽出するプログラムを作ってみました。ソースコードを下の方に載せておきます。空白行とかを無視して、必要な情報を抜き取っているだけです。

 もちろんExcel VBAとかで作ることもできます。そもそも、ファイルサイズのリストを作るフリーソフトは多数あるので、わざわざプログラムを書く必要はありません。敢えてプログラムを自分で書いているのは、ただの趣味です。

 で、抽出結果をExcelで読み込んで調べてみたところ、"cab_*"という0~100MByteのファイルが1000個以上ありました。
 「なんじゃこりゃ?」と思って、Google先生に聞いてみたら、どうもいらないファイルらしいです(参考)。

 早速、"cab_*"ファイルを削除したら、空き容量が50GByteくらい増えました。

 これにて一件落着。めでたし、めでたし。勉強になりました。




using System;
using System.IO;
using System.Text;

public class Program
{
public static void Main( string[] args)
{
if( args.Length == 0)
{
return;
}

string readfile = args[0];
string writefile = readfile + ".parse.csv";

try
{
using( StreamReader sr = new StreamReader( readfile, Encoding.GetEncoding( "shift_jis")))
{
using( StreamWriter sw = new StreamWriter( writefile, false, Encoding.GetEncoding( "shift_jis")))
{
ParseDir( sr, sw);
}
}
}
catch( System.Exception err)
{
Console.WriteLine( err.Message);
}
}

private static void ParseDir( StreamReader sr, StreamWriter sw)
{
string str;

str = sr.ReadLine();
str = sr.ReadLine();

while( !sr.EndOfStream)
{
str = sr.ReadLine();

if( str.Length == 0)
{
continue;
}

if( str[0] != ' ' && str.IndexOf( "<") == -1)
{
sw.Write( Convert.ToInt64( str.Substring( 19, 16)));
sw.Write( ", ");
sw.Write( "\"" + str.Substring( 36, str.Length - 36) + "\"");
sw.WriteLine();
}
}
}
}

2018年2月18日日曜日

流れの設計

 通勤に軽自動車を使っています。スズキのハスラーです。最近は、朝が寒くて、車の全面が凍り付いてしまい、融かすのに一苦労しています。

 氷が融けると水になります。ハスラーの天井は水平なので、天井で融けた水は流れずに残ります。残った水が乾くと、埃の跡になります。ウォータースポットと呼ばれる汚れです。

 例えば、車両の天井に少し傾斜があれば、水は流れて行くので、埃の跡は残りにくいでしょう (もちろん、車の表面の撥水性も大事です)。

 (ちなみに、同様の現象を、科学の世界ではコーヒーリング現象と呼ぶそうです。半導体の世界ではウォーターマークと呼んだりします。)


 私のアパートのキッチンの流しには、プラスチック製のフタのようなものがあります。水は流すけど、大きなものはせき止めるアレです。そのフタの下にさらに金網があります。

 このフタですが、これまた水平に設計されています。水を流した後は、表面張力で、このフタの上に水が溜まります。いつまで経っても乾きません。

 キッチンに水が残っていると、雑菌が繁殖しやすくなり、不衛生です。そこで私はペットボトルのフタくらいのプラスチックをこのフタに挟んで、傾きをつけてやりました。案の定、水が流れやすくなって、フタはすぐ乾くようになりました。


 流れを設計するというのは、とても重要なことです。エアコンの効きをよくするには、部屋の中の流れを考えます。人の流れやクルマの流れも同じで、意図的に流れを作ると、混雑しにくくなります。

 ポイントは、淀みを作らないことです。流れる水は清いものですから。

参考:コーヒーステインウォーターマーク

ぶらり寝台列車の旅

 世の中には様々な交通手段があります。

 私が住んでいるところから東京まで行くには、新幹線 or 飛行機というのが普通なのですが、今まで寝台列車というやつに乗ったことがなかったので、試してみることにしました。

 乗ってみたのはサンライズ瀬戸・出雲です。この列車は、7両編成のサンライズ瀬戸(高松発)と、同じく7両編成のサンライズ出雲(出雲市発)が岡山駅で連結されて東京駅へ向かいます。私が乗ったのは岡山駅からです。岡山駅を夜の22:34に出発、東京駅に翌朝の7:08に到着します。

 チケットは、インターネットでは購入できないとのことで、みどりの窓口で購入しました。値段は、一番安いノビノビ座席で、¥16,000くらいです。岡山までの運賃もあったため、新幹線で移動するより少し安い程度でした。高い座席を選ぶと新幹線より高額になると思います。ちなみに高速バスだと、¥10,000くらいなので、値段だけなら高速バスの方がずっとお得です。

 そして、乗車当日。

 夜中の岡山駅で寒い中待っていると、ようやく列車がやってきました。Web Siteに載っている通りの列車ですが、初めて見る2階建ての車両は新鮮に感じます。
 予約したノビノビ座席は、2階建てベッドをたくさん並べて、間を少し区切ったような感じの座席です。カーペット敷きで、十分に足を伸ばして眠れる広さがあります。各座席には毛布が用意されていました。枕は無かったです。高速バスと違って完全に横になれるので快適でした。

 ちなみに、サンライズ瀬戸・出雲には、自販機はありますが、車内販売はありません。また、トイレとシャワールームがあります。シャワールームを使うには、別途カードが必要らしいです。

 「わざわざ新幹線を使わずに、寝台列車に乗るのはどんな物好きだろう?」と、周りの様子を伺うと、乗っていたのはたくさんの外国人旅行者でした。ヨーロッパ系?、インド系?の旅行者らしき人達。よくは分からなかったのですが、中国系、韓国系の旅行者の方もいたかもしれません (マナーが悪いと言われがちな、中国人観光客の集団といった感じの人々はいませんでした)。それと日本人の家族連れや年配の旅行者。寝台列車を選ぶという物好きな人々であることは間違いないと思います (人のことは言えませんが)。

 乗車後、とりあえず自分の指定座席に行くと、隣の外国人旅行者が、「友達と並びたいから場所を交換してくれ」って。で、交換したら、また別の外国人旅行者が同じく「交換してくれ」って。で、2回も場所を交換しました。うーん。なんともたくましい旅行者の方々。

 列車が出発したら、あとは東京駅まで寝て待つだけです。22:34に岡山駅を出て、ふと目が覚めたときには、大阪駅でした。さすがに深夜なので、人もほとんどいません。列車は暗闇の中をひたすら進んでいきます。楽しむ景色はありませんが、少しワクワクします。

 また、ひと眠りして目が覚めると、今度は静岡駅でした。朝の5:00くらいだったと思います。東京駅には7:08着の予定です。

「・・・あれっ。」

 新幹線と違いスピードは出ないのに、まだ静岡駅です。「なんか遅いなぁ」と思っていたら、車内放送が。40分の遅れとのこと。

「えぇーーー。」

 「なんで夜行列車が遅れるの?」と思っていたら、また車内放送が。なんでも、先行する貨物列車がシカと衝突したそうです。

「・・・シカじゃ、仕方ない・・・」

 車内放送によると、東京駅着は8:30になるとのこと。それだと私は遅刻してしまうので、熱海で振り替え輸送の新幹線こだまに乗り換えました。ちなみに、私は運良く座れましたが、早朝の東京往きの新幹線は立ち乗りの人もいるくらい混んでいます。

 結局、東京駅には7:30頃に着いたので、私は無事に間に合いました。


 初めての寝台列車の旅。なかなか思い出深い体験になりました。

参考:サンライズ瀬戸・出雲