non div.

つな缶が大好きな大学生。書き溜めたコードを載せていきます。

【Excel】VBAで画像処理。画像の色調補正をする

今回は、VBAで画像のコントラスト補正をおこないます。
Excel上へ画像の展開の詳細はこの記事↓を見てください!
tsunakan97.hatenablog.com

線形な色調補正とS字を描く非線形な色調補正を行います。

線形な色調補正

f:id:tsunakan97:20160702233142p:plain
a1=0.2, a2=0.8, a3=0.1, a4=0.9


横軸が元の画像の画素値で、縦軸が補正後の画素値になります。
f:id:tsunakan97:20160702232200p:plain

255×a1より小さい画素値はすべて255×a3にして、255×a2より大きい画素値はすべて255×a4にします。そしてa1とa2の間は、直線でつなげて画素値とします。

'画像の線形変換!!
Function ToneMapping(image() As Byte, a1 As Double, a2 As Double, a3 As Double, a4 As Double)
    Dim c As Long, r As Long, color As Long
    Dim rMax As Long, cMax As Long
    rMax = UBound(image, 2)
    cMax = UBound(image, 1)
    Dim image2() As Double
    ReDim image2(cMax, rMax, 2)
    For r = 0 To rMax
        For c = 0 To cMax
            For color = 0 To 2
                image2(c, r, color) = image(c, r, color) / 255
            Next
        Next
    Next
    Dim myScale As Double
    Dim x As Double, xNew As Double

    myScale = (a4 - a3) / (a2 - a1)
    For r = 0 To rMax
        For c = 0 To cMax
            For color = 0 To 2
                x = image(c, r, color) / 255
                
                If x < a1 Then
                    xNew = a3
                ElseIf a2 < x Then
                    xNew = a4
                Else
                    xNew = myScale * (x - a1) + a3
                End If
                
                image(c, r, color) = xNew * 255
            Next
        Next
    Next
End Function

非線形な色調補正

S字のカーブを作り、中心より暗い画素はより暗く、中心より明るい画素はより明るくします。メリハリがつき、はっきりとした画像になります。
f:id:tsunakan97:20160702234622p:plain

今回はS字をつくるのに、正規分布確率密度関数積分することで得た関数を使います。
f:id:tsunakan97:20160702235118p:plain

f:id:tsunakan97:20160702234332p:plain


補正前後のヒストグラム(画素値の出現頻度)です。補正後のほうが山が左右に広がっており、暗い部分はより暗く、明るい部分はより明るくなっています
f:id:tsunakan97:20160702235836p:plain


画素ごとに毎回計算を行っていると時間がかかるので、先に返還後の画素値を格納したルックアップテーブルを作成して、参照するようにします。

'S字のトーンカーブ(正規分布確率密度関数の積分)
'による非線形濃度変換
Function ToneMapping3(image() As Byte)
    Dim c As Long, r As Long, color As Long
    Dim x As Byte
    Dim rMax As Long, cMax As Long
    rMax = UBound(image, 2)
    cMax = UBound(image, 1)
    Dim table(255) As Double, tabledx(255) As Double, table255(255) As Byte
    Dim i As Long
    
    Dim a1 As Double, a2 As Double, a3 As Double, a4 As Double, myScale As Double
    
    'tableを-3から3で正規化
    '±3SDの正規分布を積分するため
    a1 = 0
    a2 = 255
    a3 = -3
    a4 = 3
    myScale = (a4 - a3) / (a2 - a1)
    For i = 0 To 255
        table(i) = myScale * (i - a1) + a3
    Next
    
    'tableを正規分布の確率密度関数で計算
    For i = 0 To 255
       table(i) = (1 / Sqr((2 * 3.1416))) * Exp(-(table(i) ^ 2 / 2))
    Next
    
    'tableを積分してtabledxに代入
    For i = 0 To 255
        If i = 0 Then
            tabledx(i) = 0
        Else
            tabledx(i) = tabledx(i - 1) + table(i)
        End If
    Next
    
    'tabledxから画素値置換用のルックアップテーブルtable255を求める
    a1 = 0
    a2 = tabledx(255)
    a3 = 0
    a4 = 255
    myScale = (a4 - a3) / (a2 - a1)
    For i = 0 To 255
        table255(i) = CByte(myScale * (tabledx(i) - a1) + a3)
    Next
    
    'image()をtable255で濃度変換
    For r = 0 To rMax
        For c = 0 To cMax
            For color = 0 To 2
                x = image(c, r, color)
                image(c, r, color) = table255(x)
            Next
        Next
    Next
End Function


以下、全ソース。

Excelで画像の色調補正

2進化十進法を使った桁数制限のない加算器(正の整数に限る)

C言語で扱える桁数は、char型だと0~255、int型だと-32768~32767、long型だと-2147483648~2147483647までしかないです。割と少ない
2進化十進法、英語だとBCD(Binary-coded decimal)という数値の表現を使って、桁数制限のない加算器をC言語でつくったので紹介します。


2進化十進法

BCDは昔の電卓(数百万円とか時代)に用いられていた数値の表現方法です。2進数4ケタ16通りで1ケタの数値(0~9)を表現しています。16通りのうち10通りしか使わないので割と勿体なかったり...しかし、ひっ算のアルゴリズムをそのままプログラムにして数値計算ができるのでわかりやすい。

BCDで数値を表現すると次のようになります。1Byteで10進数2ケタ分格納し、配列の数だけ桁数を増やすことができます。

f:id:tsunakan97:20160629232419p:plain



BCDの加算は次のように計算します。人間がひっ算で足し算をするときと同じように、下の位から順に1桁ずつ足し算を行います。

f:id:tsunakan97:20160629235502j:plain



しかし、この計算には問題があって、最上位の桁が繰り上がった時に配列の外の値に書き込みをしてしまいます。

f:id:tsunakan97:20160630004847p:plain

そのため、今回は、リトルエンディアンにしてから加算を行います。
トルエンディアンは、数値をメモリに書き込む際の順番のルールです。一般的に配列の最初のほうが大きい桁で、配列の後のほうが小さい桁がになるようにイメージすることが多いと思います。リトルエンディアンはその逆で、配列の最初のほうに小さい桁、配列の後のほうに大きい桁が来るような順番で書き込みます。最上の桁が繰り上がっても配列の次の要素に書き込めばよいです。また、こうすることで配列の最初が1桁目になり、桁数のちがう数値同士の加算でも桁をそろえることができます。

f:id:tsunakan97:20160630005016p:plain


以下、C言語で書いたABCDのソースコードと実行結果です。
BCDの解説では1Byteを2つに分けて2ケタ入れていましたが、今はメモリで困ることはないので、1Byte1桁で計算しています。贅沢!!

最後に、
関係ないですがBCDって字面がすごくきれいじゃないですか?。BCDの足し算はAddBCDで、ABCDになります!美しい!

f:id:tsunakan97:20160630005801p:plain


桁数制限のない加算器(正の整数のみ)

【Excel】セル上にBMP画像を展開する。VBA

2週間くらい前?のホッテントリに、Excel上に画像を描く(セルを塗る)記事が載っていました。

qiita.com


これくらいなら自分でも作れそうだなと思ったので、VBAで実装してみます。

今回画像の展開をし、次回以降、画像処理をやる予定です(VBAで)。



はじめに

さて、VBAで画像を読み込んでセル上に展開するわけですが、VBで画像ファイルを配列化する関数を知りません。今回画像の読み込みは、BMPファイルのバイナリを読み込んで配列化しようと思います。そして、その配列をセル上に展開して画像を表示します。
バイナリで読み込めるようになれば、もうブラックボックスなんて存在しない!
BMPは、Jpegpngと違って圧縮されていないので簡単に扱えます。

  1. BMP(バイナリファイル)の読み込み
  2. 3次元(縦×横×RGB)に配列化
  3. セル上に配列を展開



最終的にこうなります。
f:id:tsunakan97:20160629003327p:plain


BMPファイルの読み込み


BMPファイルのフォーマットは以下を参照してください。

Bitmapファイルフォーマット


ぶっちゃけ読み込みだけを考えたときに重要となるのは、

  • [10] bfOffBits 4byte
    • ファイル先頭から画像データまでのオフセット[byte]
  • [18] biWidth 4byte
  • [22] biHeight 4byte
  • ファイル末尾に画像上部の画素値がある。
    • 画像がひっくり返ってファイルに入っている
  • 画像の行単位で、byte数が4の倍数になるように、0が追加されている
    • 例えば横ピクセル数が198だったら0byteが2つ足されている


の5点です。[数値]はファイル先頭から何Byte目かを表しています。

怒られそうですが、簡単にするため、読み込むBMPファイルは、24Bit1677万色のビットマップだけとします(MSペイントで保存した場合、これになります)。

バイナリモードでファイルを読み込みます。

ChDir ThisWorkbook.Path & "\"
    openFileName = Application.GetOpenFilename("BMP画像,*.bmp")
    If openFileName = "False" Then
        MsgBox "BMPファイルを選択してください"
        Exit Sub
    End If
    'ファイルをバイナリーモードで開き、1次元配列a()に入れる
    Open openFileName For Binary As #1
    File_Size = LOF(1)
    ReDim a(File_Size)
    Get #1, , a()
    Close #1



3次元(縦×横×RGB)に配列化

ファイルの読み込みが終わったら、扱いやすいように3次元(縦×横×RGB)の配列にしていきます。

ピクセル数が[18]から4byte、縦ピクセル数を[22]から4byteに書いてあるのでそれを取り出し、3次元(縦ピクセル×横ピクセル×3)配列image()を作成する。
そして、BMPファイルの入った1次元配列a()の末尾から順に、3次元配列image()に入れていく。

Image_Width_Pixel = myHex2Dec(a(), WIDTH_POS, WIDTH_POS + 3)
    Image_Height_Pixel = myHex2Dec(a(), HEIGHT_POS, HEIGHT_POS + 3)
    Line_Width_Size = myCalcLineSize(Image_Width_Pixel)
    Line_Last_Size = Line_Width_Size - Image_Width_Pixel * 3
    Image_Data_Pos = myHex2Dec(a(), 10, 13)
    ReDim image(Image_Width_Pixel - 1, Image_Height_Pixel - 1, 3 - 1)

    Call WriteImage2Array(image(), a(), File_Size)
'byte列(a())を3次元配列(image(x,y,color))にいれる
Function WriteImage2Array(image() As Byte,a() As Byte,fileSize As Long)
    Dim r As Long
    Dim c As Long
    Dim color As Long
    Dim rMax As Long
    Dim cMax As Long
    Dim i As Long
    rMax = UBound(image, 2)
    cMax = UBound(image, 1)
    i = fileSize - 1

    For r = 0 To rMax
        For c = cMax To 0 Step -1
            For color = 0 To 2
                image(c, r, color) = a(i)
                i = i - 1
            Next
        Next
    Next
        
End Function

セル上に配列を展開

セルの幅を自動調節し、
3次元(縦ピクセル×横ピクセル×3)配列image()をA1,A2,...,B1,B2,......と順番に塗っていくことで完成!!

Function WriteArray2Cells(a() As Byte)
    Dim r As Long
    Dim c As Long
    Dim color As Long
    Dim rMax As Long
    Dim cMax As Long
    rMax = UBound(a, 2)
    cMax = UBound(a, 1)
    Application.ScreenUpdating = False
    For r = 0 To rMax
        For c = 0 To cMax
            Cells(r + 1, c + 1).Interior.color = RGB(a(c, r, 0), a(c, r, 1), a(c, r, 2))
        Next
    Next
    Application.ScreenUpdating = True
End Function

画像の保存

バイナリをいじって画像を保存するのは自信がないため、画像が展開されたセルをコピーし、MSペイントに貼り付けることで画像の保存に対応しました!!荒業

Function WriteImage2Jpeg(image() As Byte)
    Dim r As Long
    Dim c As Long
    r = UBound(image, 2) + 1
    c = UBound(image, 1) + 1
    Dim rc As Long
    
    Range(Cells(1, 1), Cells(r, c)).CopyPicture
        
    rc = Shell("mspaint", vbNormalFocus)
    Application.Wait Now + TimeValue("00:00:01")
    SendKeys "^v", True
    SendKeys "^s", True
End Function

以下、全ソースコード

Excel上にBMPファイルの画像を展開する