Excelで簡単な画像処理をしてみました。
Bitmapの読み込みは"もう一度、ExcelでBitmap"のソースコードを使っています。
グレースケール化、ガンマ値の補正、ウィンドウレベルの変更、フィルタ処理を作ってます。Bitmapが読み込めるのだから、各ピクセルの値をいじるのなんて簡単です。
ソースコードは、ご自由にご利用ください。ただし、趣味のプログラムなので、保証はありません。
Option Explicit
Public Sub PixelProcess_Init()
'------------------------------
Dim shp As Shape
For Each shp In Sheet1.Shapes
shp.Delete
Next
Sheet1.Cells.Delete
'------------------------------
Dim filename As String
filename = ThisWorkbook.Path + "\test.bmp"
'filename = Application.GetOpenFilename("Bitmap, *.bmp")
If filename = "False" Then Exit Sub
'------------------------------
Dim row As Long
row = 1
Sheet1.Cells(row, 1) = "Input File"
Sheet1.Cells(row, 2) = filename
Sheet1.Cells(row + 1, 1) = "Output File"
Sheet1.Cells(row + 1, 2) = ThisWorkbook.Path + "\output.bmp"
'------------------------------
row = row + 3
Sheet1.Cells(row, 6) = "Input Image"
Sheet1.Cells(row + 1, 6).Select
ShowImage filename
'------------------------------
Sheet1.Cells(row, 1) = "Type"
Sheet1.Cells(row, 2) = 0
'------------------------------
row = row + 2
Sheet1.Cells(row, 1) = 0
Sheet1.Cells(row, 2) = "Gray Scale"
'------------------------------
row = row + 1
Sheet1.Cells(row, 1) = 1
Sheet1.Cells(row, 2) = "Gamma Correction"
Sheet1.Cells(row, 3) = "gamma"
Sheet1.Cells(row, 4) = 0.4
'------------------------------
row = row + 1
Sheet1.Cells(row, 1) = 2
Sheet1.Cells(row, 2) = "Window Level"
Sheet1.Cells(row, 3) = "window_center"
Sheet1.Cells(row, 4) = 128
Sheet1.Cells(row + 1, 3) = "window_level"
Sheet1.Cells(row + 1, 4) = 64
'------------------------------
row = row + 2
Sheet1.Cells(row, 1) = 3
Sheet1.Cells(row, 2) = "Image Filter"
Sheet1.Cells(row + 0, 3) = "f0"
Sheet1.Cells(row + 1, 3) = "f1"
Sheet1.Cells(row + 2, 3) = "f2"
Sheet1.Cells(row + 3, 3) = "f3"
Sheet1.Cells(row + 4, 3) = "f4"
Sheet1.Cells(row + 5, 3) = "f5"
Sheet1.Cells(row + 6, 3) = "f6"
Sheet1.Cells(row + 7, 3) = "f7"
Sheet1.Cells(row + 8, 3) = "f8"
Sheet1.Cells(row + 0, 4) = 0
Sheet1.Cells(row + 1, 4) = -1
Sheet1.Cells(row + 2, 4) = 0
Sheet1.Cells(row + 3, 4) = -1
Sheet1.Cells(row + 4, 4) = 4
Sheet1.Cells(row + 5, 4) = -1
Sheet1.Cells(row + 6, 4) = 0
Sheet1.Cells(row + 7, 4) = -1
Sheet1.Cells(row + 8, 4) = 0
Sheet1.Cells(row + 0, 4) = 1 / 16
Sheet1.Cells(row + 1, 4) = 2 / 16
Sheet1.Cells(row + 2, 4) = 1 / 16
Sheet1.Cells(row + 3, 4) = 2 / 16
Sheet1.Cells(row + 4, 4) = 4 / 16
Sheet1.Cells(row + 5, 4) = 2 / 16
Sheet1.Cells(row + 6, 4) = 1 / 16
Sheet1.Cells(row + 7, 4) = 2 / 16
Sheet1.Cells(row + 8, 4) = 1 / 16
'------------------------------
End Sub
Private Sub ShowImage(filename As String)
Dim shp As Shape
Set shp = Sheet1.Shapes.AddPicture(filename, msoFalse, msoTrue, Selection.Left, Selection.Top, 0, 0)
shp.ScaleWidth 1, msoTrue
shp.ScaleHeight 1, msoTrue
shp.width = shp.width * 200 / shp.height
shp.height = 200
End Sub
Public Sub PixelProcess()
'------------------------------
Dim filename As String
filename = Sheet1.Cells(1, 2)
If filename = "" Or Dir(filename) = "" Then Exit Sub
'------------------------------
Dim row As Long
Dim gamma As Double
Dim window_center As Double
Dim window_level As Double
Dim f(8) As Double
row = 7
gamma = Sheet1.Cells(row, 4)
row = row + 1
window_center = Sheet1.Cells(row, 4)
window_level = Sheet1.Cells(row + 1, 4)
row = row + 2
f(0) = Sheet1.Cells(row, 4)
f(1) = Sheet1.Cells(row + 1, 4)
f(2) = Sheet1.Cells(row + 2, 4)
f(3) = Sheet1.Cells(row + 3, 4)
f(4) = Sheet1.Cells(row + 4, 4)
f(5) = Sheet1.Cells(row + 5, 4)
f(6) = Sheet1.Cells(row + 6, 4)
f(7) = Sheet1.Cells(row + 7, 4)
f(8) = Sheet1.Cells(row + 8, 4)
'------------------------------
Dim data() As Byte
Dim width As Long
Dim height As Long
readBitmap filename, data, width, height
If Sheet1.Cells(4, 2) = 0 Then
GrayScale data, width, height
ElseIf Sheet1.Cells(4, 2) = 1 Then
GammaCorrection data, width, height, gamma
ElseIf Sheet1.Cells(4, 2) = 2 Then
WindowLevel data, width, height, window_center, window_level
ElseIf Sheet1.Cells(4, 2) = 3 Then
ImageFilter data, width, height, f
End If
'------------------------------
filename = Sheet1.Cells(2, 2)
writeBitmap filename, data, width, height
Sheet1.Cells(4, 10) = "Output Image"
Sheet1.Cells(5, 10).Select
ShowImage filename
End Sub
Private Sub GrayScale(ByRef data() As Byte, ByRef width As Long, ByRef height As Long)
Dim i As Long
Dim j As Long
Dim k As Long
Dim lineSize As Long
Dim pos As Long
lineSize = 3 * width + width Mod 4
Dim temp As Double
For i = 0 To height - 1
For j = 0 To width - 1
pos = lineSize * i + j * 3
temp = 0.2989 * data(pos + 2) + 0.587 * data(pos + 1) + 0.114 * data(pos + 0)
If temp < 0 Then temp = 0
If 255 < temp Then temp = 255
For k = 0 To 2
data(pos + k) = CByte(temp)
Next k
Next j
Next i
End Sub
Private Sub GammaCorrection(ByRef data() As Byte, ByRef width As Long, ByRef height As Long, gamma As Double)
Dim i As Long
Dim j As Long
Dim k As Long
Dim lineSize As Long
Dim pos As Long
lineSize = 3 * width + width Mod 4
Dim temp As Double
For i = 0 To height - 1
For j = 0 To width - 1
pos = lineSize * i + j * 3
For k = 0 To 2
temp = 255 * (CDbl(data(pos + k)) / 255) ^ gamma
If temp < 0 Then temp = 0
If 255 < temp Then temp = 255
data(pos + k) = CByte(temp)
Next k
Next j
Next i
End Sub
Private Sub WindowLevel(ByRef data() As Byte, ByRef width As Long, ByRef height As Long, window_center As Double, window_level As Double)
Dim i As Long
Dim j As Long
Dim k As Long
Dim lineSize As Long
Dim pos As Long
lineSize = 3 * width + width Mod 4
Dim temp As Double
For i = 0 To height - 1
For j = 0 To width - 1
pos = lineSize * i + j * 3
For k = 0 To 2
temp = CDbl(255) / window_level * (CDbl(data(pos + k)) - window_center + window_level / 2)
If temp < 0 Then temp = 0
If 255 < temp Then temp = 255
data(pos + k) = CByte(temp)
Next k
Next j
Next i
End Sub
'f6 f7 f8
'f3 f4 f5
'f0 f1 f2
Private Sub ImageFilter(ByRef data() As Byte, ByRef width As Long, ByRef height As Long, f() As Double)
Dim i As Long
Dim j As Long
Dim k As Long
Dim lineSize As Long
Dim pos As Long
lineSize = 3 * width + width Mod 4
Dim buf() As Byte
ReDim buf(lineSize * height - 1) As Byte
For i = 0 To lineSize * height - 1
buf(i) = 0
Next i
Dim temp As Double
'------------------------------
For i = 1 To height - 2
For j = 1 To width - 2
pos = lineSize * i + j * 3
For k = 0 To 2
temp = f(0) * CDbl(data(pos + lineSize - 3 + k)) _
+ f(1) * CDbl(data(pos + lineSize + k)) _
+ f(2) * CDbl(data(pos + lineSize + 3 + k)) _
+ f(3) * CDbl(data(pos - 3 + k)) _
+ f(4) * CDbl(data(pos + k)) _
+ f(5) * CDbl(data(pos + 3 + k)) _
+ f(6) * CDbl(data(pos - lineSize - 3 + k)) _
+ f(7) * CDbl(data(pos - lineSize + k)) _
+ f(8) * CDbl(data(pos + lineSize + 3 + k))
If temp < 0 Then temp = 0
If 255 < temp Then temp = 255
buf(pos + k) = CByte(temp)
Next k
Next j
Next i
'------------------------------
Erase data
data = buf
End Sub
0 件のコメント:
コメントを投稿