「ワイドショーはすごいなぁ」と思うのは、なんだかんだで続いていることですね。内容が批判されることも多いですが、それでも放送を続けているのは逞しいことです。ネタを集めて番組を作るのは大変な仕事だと思います。
しばらくめんどくさくてコラム書いてなかったのですが、ワイドショーの逞しさを見習ってたまには適当に書いてみます。
------------------------------
交通事故
ここのところ、悲しい交通事故が続いたので、まずは、哀悼の意を表したいと思います。
私なんか、ただの他人でしかないんですが、それでも悲しい事故の報道には心が痛みます。運転には気を付けましょう。
------------------------------
年金の話
で、続いては話題の年金の話。一世帯あたり2000万円くらい足りないそうです。2000万円という額のインパクトが大きいので、そればかりに注意が向いてしまうのは仕方ないことです。
この話の元々の出どころは金融庁の有識者会議が公表した報告書だそうです。65歳で定年、その後、30年間年金をもらうとすると、毎月の生活費が5.5万円足りなくなるらしく、単純に掛け算して、 5.5 x 12 x 30 = 1980万円ということらしいです。算数が分かれば誰でも分かる計算です。だから算数は勉強しておけと言ったろうに。
毎月の生活費が5.5万円足りないというのは平均値でしょう。医療費がかかる人はもっと必要になると思われます。
この報告書にはまったく悪意はないと思うんです。むしろ報告書をまとめた方々には善意しかないと思います。「皆様、老後の生活のために年金以外のお金も用意してね」っていう意図です。なので、私はこの報告書を批判する気はまったくありません。まぁ、2000万円と聞いた世論がどう反応するかまで想像できなかったのが残念なところですね。
ところで、昨今、日銀は物価上昇率2%を目標とした量的緩和というやつを実施しています。物価上昇率2%というのは、物価が1.02倍になるということです。
1.02倍なんて大したことないと思うかもしれませんが、1.02倍が10年続くと、だいたい1.2倍になります。20年でだいたい1.5倍、30年で1.8倍近くです。簡単な等比級数の計算ですね。数学を少し知っていれば当たり前です。30年で総和をとると、2700万円くらいでした。等比級数の総和も簡単な計算ですが、、、Excelだと一瞬ですね。だから数学は勉強しておけと言ったろうに。
この年金の試算を行った方々は日銀の政策を考慮しているのでしょうか？物価の上昇を無視したのであれば、金融庁は日銀に協力する気がないみたいに感じられます。物価の上昇を知っていて計算に入れなかったのであれば、それは数学を無視している感じがします。
話は変わって、国債の発行残高は1000兆円くらいだそうです。これは将来税金で支払われるであろう借金で、国民一人当たり1000万円くらいです。よって1人当たりさらに1000万円必要になるかもしれません。
いろいろ適当なことを書きましたが、とどのつまり、この試算はすごくおおざっぱな計算だ、というのが私の結論です。こういう試算が悪いとは言わないですが、計算モデルが不正確だとただの数字遊びにしかなりません。
数字だけいじっていても意味がないんです。だから数学なんか勉強してもって言ったろうに。あれっ?
------------------------------
投資のお話
お金の話でもう少し追加しておきましょう。年金だけでは足りないお金をどうするかという話で、投資が推奨されているみたいです。
将来のために投資をしましょうって、なんかそんな詐欺があった気がするんですが。。。
投資は成功する人と失敗する人がいます。投資をやって失敗して生活費がありません、ということになりそうで不安です。
そもそもみんなが投資をしたからって、経済が活性化するわけではありません。お金の計算だけならただのマネーゲームです。数字で遊んでいても意味はありません。だから数学なんか勉強してもって言ったろうに。。。あれれっ?
重要なのは金勘定ではなく、どういった産業を発展させるかです。
太陽光発電を発展させるなら、そういう風に制度を作れば良いということですね。そしたら、みんなが投資をします。そして、制度が悪ければ、失敗に終わるんです。
------------------------------
地上イージス
話は変わって、地上配備型迎撃ミサイルシステム「イージス・アショア」の配備が検討されているそうです。名前が小難しいので、略して地上イージスと呼ばれているようです。要は北朝鮮からのミサイルへの対策です。
ミサイル打たれて街が破壊されました、なんてことになったら大問題です。だからお金をかけて迎撃システムを配備しようということらしいです。起きるかどうか分からない事態の対策もしないといけないから大変です。
で、地上イージスの配置場所を検討するときの迎角の値に間違いがあったそうです。グーグルアースの断面図を、ディスプレイに定規を当てて測ってしまったとか。
迎角なんてあまり考えたことないだろうし、断面図があったらそのまま測りたくなる気持ちは分からなくはないです。でも、何億円という規模の問題で、こんな恥ずかしいミスをするとは。しかもチェックをすり抜けて公表しちゃうとは。
候補地近隣の住民が怒るのは当然ですね。だから数学は勉強しておけといったろうに。
------------------------------
レジ袋規制
では、次です。レジ袋を規制しようという動きがあるそうです。
「ちっさ」と感じたのは私だけでしょうか？対象が小さすぎるでしょう。少し前にプラスチックストローをやめるみたいな話もありましたが、これも対象がすごく限られていると思います。
「容器包装リサイクル法」というのがあるのをご存知でしょうか？1995年に制定されているらしいです。スーパーマーケットとかにプラスチックトレイの回収ボックスがあるのはこの法律の影響です。
せっかく容器包装全般を対象とした法律があるのだから、レジ袋だけ気にするのではなく、もっと広い目線で検討して欲しいものです。
そういえば、レジ袋の規制に対するコメントで、「ゴミ袋に使えるから困る」なんてのを見かけました。地球の環境問題とご家庭のごみ問題を同じレベルで比べている感じです。木を見て森を見ずと言いましょうか。もっと広い目線で考えて欲しいものです
私は、「ゴミ処理にはお金がかかる」→「ゴミ袋は有料」→「ゴミを減らす」、という流れが正しいと思います。
それと、先ほどの投資の話と絡めるなら、「環境負荷の低い材料の推奨」→「みんなが投資」→「新しい産業の発展」、という流れが起きるといいですね。
余談ですが、私はかれこれ何年もエコバックを携帯しています。たたむと財布くらいの大きさになる袋で、まったく不便はないです。むしろ、レジ袋はゴミになって邪魔です。店員さんがサービスでレジ袋に入れてくれるのは分かるのですが。。。レジ袋がサービスであるという価値観は変わって欲しいものです。
------------------------------
入試不正
入学試験の季節は終わっちゃいましたが、医学部の入試不正なんて話題がありました。ワイドショーっぽくこの話題にも触れておきましょう。
一部の大学の入学試験で女性や浪人生が不利になるようにしていたそうです。まぁ、テストの点数で合否を決めると言っておいて、裏で細工をしてたらまずいですね。
不合格にされた方々はご愁傷さまです。諦めずに医者を目指すもよし、別の道を探すもよし。前向きに強く生きていただければと思います。他人事なんで適当ですが。
正直な私の意見を言うと、男女で区別するのは悪くないと思うんです。
体力とかに男女差があるのは当然です。業務の都合で男性の医者の需要が多いのであれば、大学が男性の合格者を多くするのは理にかなっています。むしろ社会に出て働くときのことを何も考えずにテストの数字だけで合格者を決める方が良くないと思います。
もちろん、女性が医者になるべきではないとか、女性が劣っているとか言うつもりはまったくありません。女性の方が向いている場合も多々あると思います。誤解なきよう。
不合理な差別は良くないですが、合理的な理由があるなら差異は受け入れるべきです。最近は少しでも差別があると批判される気がして。。。それはやりすぎでは？と思ったりもします。
まぁ、裏で細工するのはやっぱりダメなんですけどね。
------------------------------
放送後記
しばらくコラムをさぼってたんですが、実は何度か書こうかと思ったりもしてたんです。ただ、書こうと思った内容が世間の常識から少しずれてる気がして。こういう考えの人はいないんかなぁなどと思っちゃって二の足を踏んでました。
まぁ、たいして読者もいないんで、気にする必要はないんですが (^_^)
余計なことを言って批判されるのがワイドショーの宿命です。というわけで、そういうワイドショーの逞しさを見習って、少しずれてる私の思考・妄想を書いてみました。
いつもはもう少し出典を明確にするのですが、まぁ、取材が甘いのもワイドショーっぽいということでご容赦ください。
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
作ってみて思うのですが、やっぱり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
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
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・ケネディの大統領就任演説の一節です。平易な言葉で構成され、前半と後半がきれいに対比されている、美しい文章だと思います。
ここ数年、地震、豪雨、猛暑と自然災害が続きます。そういった災害が起きると、国の助成金の話が出てくるものです。
年金、生活保護、地方交付金など、国がお金を払う支援制度は、あまたあります。
過労死の問題で、国の支援を要求するなんて話もありました。
「弱者が国の支援を求める」そんなニュースを聞くことは、少なからずあります。助けを求めるのは間違いではないでしょう。
ですが、支援ばかりを要求するコメントを聞くと、不快に感じます。
社会の支援を求めるだけでなく、社会のために貢献することは大事なことです。金銭ばかりを要求する放蕩者ではいけないと思うのです。
ケネディ大統領の演説を思い返して、そんなことを考えたりしてます。
ジョン・F・ケネディの大統領就任演説の一節です。平易な言葉で構成され、前半と後半がきれいに対比されている、美しい文章だと思います。
ここ数年、地震、豪雨、猛暑と自然災害が続きます。そういった災害が起きると、国の助成金の話が出てくるものです。
年金、生活保護、地方交付金など、国がお金を払う支援制度は、あまたあります。
過労死の問題で、国の支援を要求するなんて話もありました。
「弱者が国の支援を求める」そんなニュースを聞くことは、少なからずあります。助けを求めるのは間違いではないでしょう。
ですが、支援ばかりを要求するコメントを聞くと、不快に感じます。
社会の支援を求めるだけでなく、社会のために貢献することは大事なことです。金銭ばかりを要求する放蕩者ではいけないと思うのです。
ケネディ大統領の演説を思い返して、そんなことを考えたりしてます。
2018年6月3日日曜日
モンテスキューに敬意を込めて
ここのところ、国会では、官僚が文書を改ざんしたとか、政治家が失言したとか、といった話題が盛んに話されているようです。
聞いていて辟易します。「国会は法律を作る立法府」じゃなかったっけ？というところから、私はモンテスキューを思い出しました。
モンテスキューについては、小学生のときに習いました。「法の精神」を著した人物で、権力を立法、司法、行政に分ける三権分立を提唱した人と記憶しています。
小学生の私は、「まぁ、そんなものなのか」と思っていました。「学校で教えるのだから、きっと大事なことなのだろう」くらいに思っていました。今の子供も三権分立というのを習うのでしょうか？習ったとしても、国会が立法府であることを理解するのは難しいかもしれません。
かつてモンテスキューが考えていた事と、今の国会で言ったとか言ってないとかを延々と話している方々の考えている事は、まったく別物でしょう。
参考：Wikipedia 法の精神
聞いていて辟易します。「国会は法律を作る立法府」じゃなかったっけ？というところから、私はモンテスキューを思い出しました。
モンテスキューについては、小学生のときに習いました。「法の精神」を著した人物で、権力を立法、司法、行政に分ける三権分立を提唱した人と記憶しています。
小学生の私は、「まぁ、そんなものなのか」と思っていました。「学校で教えるのだから、きっと大事なことなのだろう」くらいに思っていました。今の子供も三権分立というのを習うのでしょうか？習ったとしても、国会が立法府であることを理解するのは難しいかもしれません。
かつてモンテスキューが考えていた事と、今の国会で言ったとか言ってないとかを延々と話している方々の考えている事は、まったく別物でしょう。
参考：Wikipedia 法の精神
2018年3月18日日曜日
Where my money at ?
珍しく東京で電車に乗った時のことですが、小学校5，6年生と思しき子供が本を読んでいるのを見かけました。読んでいた本は、「ピーター・リンチの株で勝つ」。
昨今は、子供も投資を考える時代みたいです。
(私はこの本を読んでいないので、詳しくは知りませんが。)
政府は投資を推奨しているみたいです。少額投資非課税制度 (NISA) や、確定拠出型年金 (Idecoなど) が色々なところで宣伝されています。
(正直なところ、確定拠出年金のように、半ば強制的に投資させられるのは、いい気分ではないです。)
みんなが投資すれば、市場にお金が供給されて、物価上昇率2%の目標も達成できるでしょう。
ワー、スバラシー (棒読み)。
投資は重要な経済活動です。投資で資金が集まる産業は発展します。つまり、将来的に発展させたい産業に投資が行われるようにすべきです。
どの産業を発展させるかの選択は、非常に難しい問題です。政治的な意図も絡んできます。将来を左右する問題である以上、あまり安易に投資を推奨されるのには違和感を覚えます。
ただ株価の数字だけ見て利益を追及するのはマネーゲームです。「利益のためなら、どんな犯罪組織に投資してもOK」ということになってしまいます。
残念ながら、将来の社会を見据えた投資と、ただのマネーゲームとの区別は難しいです。
政府が推奨しているのだから、これからは投資が盛んに行われる社会になるのかもしれません。
私の希望としては、「パソコンに向かっているだけのトレーダー」が得をして、「汗を流して働いている労働者」が損をする、そんな社会にはなって欲しくないです。
余談ですが、今回のタイトルは、Wyclef Jeanの"Sweetest Girl"という曲からとりました。"~work for the president"ってところの歌詞が面白いです。
昨今は、子供も投資を考える時代みたいです。
(私はこの本を読んでいないので、詳しくは知りませんが。)
政府は投資を推奨しているみたいです。少額投資非課税制度 (NISA) や、確定拠出型年金 (Idecoなど) が色々なところで宣伝されています。
(正直なところ、確定拠出年金のように、半ば強制的に投資させられるのは、いい気分ではないです。)
みんなが投資すれば、市場にお金が供給されて、物価上昇率2%の目標も達成できるでしょう。
ワー、スバラシー (棒読み)。
投資は重要な経済活動です。投資で資金が集まる産業は発展します。つまり、将来的に発展させたい産業に投資が行われるようにすべきです。
どの産業を発展させるかの選択は、非常に難しい問題です。政治的な意図も絡んできます。将来を左右する問題である以上、あまり安易に投資を推奨されるのには違和感を覚えます。
ただ株価の数字だけ見て利益を追及するのはマネーゲームです。「利益のためなら、どんな犯罪組織に投資してもOK」ということになってしまいます。
残念ながら、将来の社会を見据えた投資と、ただのマネーゲームとの区別は難しいです。
政府が推奨しているのだから、これからは投資が盛んに行われる社会になるのかもしれません。
私の希望としては、「パソコンに向かっているだけのトレーダー」が得をして、「汗を流して働いている労働者」が損をする、そんな社会にはなって欲しくないです。
余談ですが、今回のタイトルは、Wyclef Jeanの"Sweetest Girl"という曲からとりました。"~work for the president"ってところの歌詞が面白いです。
登録:
投稿 (Atom)