ImageCompare.vb
''
'' このコードは、DioDocs for Imaging のサンプルの一部として提供されています。
'' © MESCIUS inc. All rights reserved.
''
Imports System.IO
Imports System.Drawing
Imports System.Collections.Generic
Imports System.Linq
Imports GrapeCity.Documents.Drawing
Imports GrapeCity.Documents.Text
Imports GrapeCity.Documents.Imaging
Imports GCTEXT = GrapeCity.Documents.Text
Imports GCDRAW = GrapeCity.Documents.Drawing
'' このサンプルでは、ピクセル単位での画像比較を実装しています。
''
'' 色の比較には CIE L*a*b* 色空間を使用し、
'' RGB と Lab 間の色変換には XYZ 色空間を使用しています。
'' 「差分」画像は、1枚目の画像を低コントラストのグレースケールで表現したものに、
'' 異なるピクセルをマゼンタ色で重ねて表示します。
'' マゼンタの濃さは、元の2つのピクセル間の差の大きさに比例します。
'' すべての出力形式に対応していますが、生成される TIFF の
'' 2ページ目および3ページ目に元画像2枚が表示されるため、
'' TIFF 形式の使用を推奨します。
''
'' @色計算は EasyRGB の情報を基にしています。
'' @色差の計算式は Identifying Color Differences Using L*a*b* または L*C*H* 座標による色差判定 を参考にしています。
Public Class ImageCompare
Function GenerateImageStream(
ByVal targetMime As String,
ByVal pixelSize As Size,
ByVal dpi As Single,
ByVal opaque As Boolean,
Optional sampleParams As String() = Nothing) As Stream
If sampleParams Is Nothing Then
sampleParams = GetSampleParamsList()(0)
End If
Dim path1 = sampleParams(3)
Dim path2 = sampleParams(4)
'' 比較の曖昧さ（0からMaxDeltaまで）を設定します。
Dim fuzz As Integer
If sampleParams Is Nothing Then
fuzz = 12
Else
fuzz = Integer.Parse(sampleParams(5))
End If
'' 異なるピクセルはこの色でハイライトされます。
Dim highlight = Color.Magenta.ToArgb()
'' どの画像にも占有されていない空の領域の塗りつぶし色です。
Dim fill = Color.White.ToArgb()
'' Qは差異の強度を高めるために使用されます。
'' fuzzに反比例させて行います（fuzzが0の場合、わずかな差異でも際立たせます）。
Dim Q = (255D / (fuzz + 1))
'' 参照画像の透明度です。
Const alphaBack = 55 << 24
Dim bmp1 = New GcBitmap(path1)
Dim bmp2 = New GcBitmap(path2)
'' 画像が大きすぎる場合、ターゲットの幅と高さに合わせてリサイズします。
Dim z1 = 1, z2 = 1
If bmp1.PixelWidth > pixelSize.Width Then
z1 = pixelSize.Width / bmp1.PixelWidth
End If
If bmp1.PixelHeight > pixelSize.Height Then
z1 = Math.Min(z1, pixelSize.Height / bmp1.PixelHeight)
End If
If (bmp2.PixelWidth > pixelSize.Width) Then
z2 = pixelSize.Width / bmp2.PixelWidth
End If
If (bmp2.PixelHeight > pixelSize.Height) Then
z2 = Math.Min(z2, pixelSize.Height / bmp2.PixelHeight)
End If
'' 画像を同じ（最小の）幅にリサイズします。
If (bmp1.PixelWidth * z1 > bmp2.PixelWidth * z2) Then
z1 = bmp2.PixelWidth / bmp1.PixelWidth
ElseIf (bmp2.PixelWidth * z2 > bmp1.PixelWidth * z1) Then
z2 = bmp1.PixelWidth / bmp2.PixelWidth
End If
If z1 < 1 Then
Dim t = bmp1.Resize(Math.Round(bmp1.PixelWidth * z1), Math.Round(bmp1.PixelHeight * z1),
If(z1 < 0.5, InterpolationMode.Downscale, InterpolationMode.Cubic))
bmp1.Dispose()
bmp1 = t
End If
If z2 < 1 Then
Dim t = bmp2.Resize(Math.Round(bmp2.PixelWidth * z2), Math.Round(bmp2.PixelHeight * z2),
If(z2 < 0.5, InterpolationMode.Downscale, InterpolationMode.Cubic))
bmp2.Dispose()
bmp2 = t
End If
'' 色の差異に関する計算は以下のURLに基づいています。
'' https://sensing.konicaminolta.us/us/blog/identifying-color-differences-using-l-a-b-or-l-c-h-coordinates/
'' RGB空間において、L*a*b*の範囲はL*が0〜100、a*およびb*が-128〜+127であると仮定します。詳細は以下を参照してください。
'' http://www.colourphil.co.uk/lab_lch_colour_space.shtml
'' そのため、RGB空間における任意の2色間の最大可能差異は以下の通りとなります。
'' MaxDelta = 374.23254802328461
Dim MaxDelta = LabDistance((0, -128, -128), (100, 127, 127))
Using bmp = New GcBitmap(pixelSize.Width, pixelSize.Height, False, dpi, dpi)
Using g = bmp.CreateGraphics(Color.FromArgb(fill))
'' 見つかった異なるピクセルの総数です。
Dim differences = 0
Dim w = bmp1.PixelWidth
Dim h = Math.Min(bmp1.PixelHeight, bmp2.PixelHeight)
For i = 0 To w - 1
For j = 0 To h - 1
Dim px1 As UInteger = bmp1(i, j)
Dim px2 As UInteger = bmp2(i, j)
'' 差異を計算するために、RGBをCIE L*a*b*空間に変換します。
Dim lab1 = ColorXYZ.FromRGB(px1).ToCIELab()
If px1 = px2 Then
'' 処理を高速化するため、同一ピクセルの場合は2つ目の色の計算をスキップします。
'' 同一ピクセルは、差異の参照用として半透明のグレーで描画されます。
Dim gray = Math.Round((lab1.L * 255D) / 100D)
bmp(i, j) = alphaBack Or (gray << 16) Or (gray << 8) Or gray
Else
'' それ以外の場合は、2色間の距離を計算します。
Dim lab2 = ColorXYZ.FromRGB(px2).ToCIELab()
Dim delta = LabDistance((lab1.L, lab1.a, lab1.b), (lab2.L, lab2.a, lab2.b))
If delta > fuzz Then
Dim alpha = Math.Min(255, ((255 * delta) / MaxDelta) * Q)
bmp(i, j) = (alpha << 24) Or highlight
differences += 1
Else
'' 上記の同一ピクセルのコメントを参照してください。
Dim gray = Math.Round((lab1.L * 255D) / 100D)
bmp(i, j) = alphaBack Or (gray << 16) Or (gray << 8) Or gray
End If
End If
Next
Next
'' 一貫性のため、差異を不透明に変換します。
bmp.ConvertToOpaque(Color.White)
'' 情報テキスト用のテキストレイアウトです。
Dim tl = New TextLayout(g.Resolution) With {.TextAlignment = TextAlignment.Trailing}
tl.DefaultFormat.Font = GCTEXT.Font.FromFile(Path.Combine("Resources", "Fonts", "NotoSans-Regular.ttf"))
tl.DefaultFormat.FontSize = 12
tl.DefaultFormat.ForeColor = Color.Blue
tl.MaxWidth = g.Width
tl.MarginAll = 4
'' ターゲット形式に保存します。
Dim ms = New MemoryStream()
If targetMime = MimeTypes.TIFF Then
'' TIFFの場合、差異画像と2つのソース画像を別々のページにレンダリングします。
tl.Append($"{differences} 個の異なるピクセル (fuzz {fuzz}) が見つかりました。")
g.DrawTextLayout(tl, PointF.Empty)
Using tw = New GcTiffWriter(ms)
tw.AppendFrame(bmp)
bmp1.ConvertToOpaque(Color.White)
Using g1 = bmp1.CreateGraphics()
tl.Clear()
tl.MaxWidth = g1.Width
tl.DefaultFormat.BackColor = Color.LightYellow
tl.Append(Path.GetFileName(path1))
g1.DrawTextLayout(tl, PointF.Empty)
End Using
tw.AppendFrame(bmp1)
bmp2.ConvertToOpaque(Color.White)
Using g2 = bmp2.CreateGraphics()
tl.Clear()
tl.MaxWidth = g2.Width
tl.Append(Path.GetFileName(path2))
g2.DrawTextLayout(tl, PointF.Empty)
End Using
tw.AppendFrame(bmp2)
End Using
bmp.SaveAsTiff(ms)
Else
'' その他の形式の場合、差異画像とソース画像をタイル状に並べます。
Using tbmp = TileImages(pixelSize, bmp, New Size(w, h), bmp1, bmp2, dpi, tl, Path.GetFileName(path1), Path.GetFileName(path2))
Using tg = tbmp.CreateGraphics()
tl.TextAlignment = TextAlignment.Trailing
tl.MaxWidth = tg.Width
tl.Clear()
tl.Append($"{differences} 個の異なるピクセル (fuzz {fuzz}) が見つかりました。")
tg.DrawTextLayout(tl, PointF.Empty)
End Using
Select Case targetMime
Case MimeTypes.JPEG
tbmp.SaveAsJpeg(ms)
Case MimeTypes.PNG
tbmp.SaveAsPng(ms)
Case MimeTypes.BMP
tbmp.SaveAsBmp(ms)
Case MimeTypes.GIF
tbmp.SaveAsGif(ms)
Case Else
Throw New Exception($"Encoding {targetMime} is not supported.")
End Select
End Using
End If
bmp1.Dispose()
bmp2.Dispose()
ms.Seek(0, SeekOrigin.Begin)
Return ms
End Using
End Using
End Function
Private Shared Function TileImages(ByVal targetSize As Size,
ByVal diff As GcBitmap,
ByVal diffSize As Size,
ByVal bmp1 As GcBitmap,
ByVal bmp2 As GcBitmap,
ByVal dpi As Single,
ByVal tl As TextLayout,
ByVal name1 As String,
ByVal name2 As String) As GcBitmap
Dim tSize = New Size(targetSize.Width / 2 - 1, targetSize.Width / 2 - 1)
Dim bmp = New GcBitmap(targetSize.Width, targetSize.Height, True, dpi, dpi)
Using diffClip = diff.Clip(New Rectangle(Point.Empty, diffSize))
bmp1.ConvertToOpaque(Color.White)
bmp2.ConvertToOpaque(Color.White)
Dim ts0 = FitSize(diffClip, tSize)
Dim ts1 = FitSize(bmp1, tSize)
Dim ts2 = FitSize(bmp2, tSize)
Using g = bmp.CreateGraphics(Color.White)
g.DrawLine(0, ts0.Height, g.Width, ts0.Height, Color.Yellow)
g.DrawLine(ts1.Width + 1, diffClip.Height, ts1.Width + 1, ts0.Height + ts1.Height, Color.Yellow)
End Using
Dim x As Integer
If (ts0.IsEmpty) Then
x = ts1.Width - diffClip.PixelWidth / 2
bmp.BitBlt(diffClip, x, 0)
Else
x = ts1.Width - ts0.Width / 2
Using tbmp = diffClip.Resize(ts0.Width, ts0.Height, InterpolationMode.Cubic)
bmp.BitBlt(tbmp, x, 0)
End Using
End If
If (ts1.IsEmpty) Then
bmp.BitBlt(bmp1, 0, ts0.Height + 1)
Else
Using tbmp = bmp1.Resize(ts1.Width, ts1.Height, InterpolationMode.Cubic)
bmp.BitBlt(tbmp, 0, ts0.Height + 1)
End Using
End If
If (ts2.IsEmpty) Then
bmp.BitBlt(bmp2, ts1.Width + 1, ts0.Height + 1)
Else
Using tbmp = bmp2.Resize(ts2.Width, ts2.Height, InterpolationMode.Cubic)
bmp.BitBlt(tbmp, ts1.Width + 1, ts0.Height + 1)
End Using
End If
Using g = bmp.CreateGraphics()
tl.TextAlignment = TextAlignment.Leading
tl.DefaultFormat.BackColor = Color.LightYellow
tl.Clear()
tl.MaxWidth = ts0.Width
tl.Append("比較結果")
g.DrawTextLayout(tl, New PointF(x, 0))
tl.Clear()
tl.MaxWidth = ts1.Width
tl.Append(name1)
g.DrawTextLayout(tl, New PointF(0, ts0.Height + 1))
tl.Clear()
tl.MaxWidth = ts2.Width
tl.Append(name2)
g.DrawTextLayout(tl, New PointF(ts1.Width + 1, ts0.Height + 1))
End Using
End Using
Return bmp
End Function
Private Shared Function FitSize(ByVal bmp As GcBitmap, ByVal size As Size) As Size
Dim z As Double = 1
If bmp.PixelWidth > size.Width Then
z = size.Width / bmp.PixelWidth
End If
If bmp.PixelHeight > size.Height Then
z = Math.Min(z, size.Height / bmp.PixelHeight)
End If
If z < 1 Then
Return New Size(Math.Round(bmp.PixelWidth * z), Math.Round(bmp.PixelHeight * z))
Else
Return Size.Empty '' サイズ変更の必要がないことを示します。
End If
End Function
Public Shared Function LabDistance(lab1 As (L As Double, a As Double, b As Double), lab2 As (L As Double, a As Double, b As Double)) As Double
Dim dL = lab1.L - lab2.L
Dim da = lab1.a - lab2.a
Dim db = lab1.b - lab2.b
Return Math.Sqrt(dL * dL + da * da + db * db)
End Function
Public ReadOnly Property DefaultMime() As String
Get
Return MimeTypes.TIFF
End Get
End Property
Public Shared Function GetSampleParamsList() As List(Of String())
'' 文字列の内容は、名前、説明、情報です。それ以外は任意の文字列であり、このサンプルでは以下の通りです。
'' - 比較する1つ目のファイル
'' - 比較する2つ目のファイル
'' - 比較の曖昧さ（整数）
Return New List(Of String()) From
{
New String() {"Find Differences", "Compare two similar images with few minor differences (fuzz 12)", Nothing,
Path.Combine("Resources", "Images", "newfoundland.jpg"), Path.Combine("Resources", "ImageCompare", "newfoundland-mod.jpg"), "12"},
New String() {"Invisible Text", "Compare an image with same image that has a semi-transparent text overlay (fuzz 0)", Nothing,
Path.Combine("Resources", "ImageCompare", "seville.png"), Path.Combine("Resources", "ImageCompare", "seville-text.png"), "0"},
New String() {"PNG vs JPEG", "Compare a PNG image with the same image saved as a 75% quality JPEG (fuzz 6)", Nothing,
Path.Combine("Resources", "ImageCompare", "toronto-lights.png"), Path.Combine("Resources", "ImageCompare", "toronto-lights-75.jpg"), "6"},
New String() {"Font Hinting", "Compare text rendered with TrueType font hinting on and off (fuzz 1)", Nothing,
Path.Combine("Resources", "ImageCompare", "TrueTypeHinting-on.png"), Path.Combine("Resources", "ImageCompare", "TrueTypeHinting-off.png"), "1"}
}
End Function
'' XYZ形式のカラー型です。以下のURLにある色の計算式に基づいています。
'' https://www.easyrgb.com/en/math.php
Public Class ColorXYZ
Implements IEquatable(Of ColorXYZ)
Private ReadOnly _x As Double, _y As Double, _z As Double
'' D65 CIE 1964 参照値（sRGB、AdobeRGB）
Const ReferenceX = 94.811
Const ReferenceY = 100.0
Const ReferenceZ = 107.304
Public ReadOnly Property X As Double
Get
Return _x
End Get
End Property
Public ReadOnly Property Y As Double
Get
Return _y
End Get
End Property
Public ReadOnly Property Z As Double
Get
Return _z
End Get
End Property
Private Sub New(x As Double, y As Double, z As Double)
_x = x
_y = y
_z = z
End Sub
Public Overloads Function Equals(other As ColorXYZ) As Boolean Implements IEquatable(Of ColorXYZ).Equals
If CType(other, Object) Is Nothing Then
Return False
End If
Return _x = other._x AndAlso _y = other._y AndAlso _z = other._z
End Function
Public Overrides Function Equals(obj As Object) As Boolean
Return Equals(CType(obj, ColorXYZ))
End Function
Public Shared Operator =(obj1 As ColorXYZ, obj2 As ColorXYZ) As Boolean
Return CType(obj1, Object) IsNot Nothing AndAlso obj1.Equals(obj2)
End Operator
Public Shared Operator <>(obj1 As ColorXYZ, obj2 As ColorXYZ) As Boolean
Return obj1 Is Nothing OrElse Not obj1.Equals(obj2)
End Operator
Public Overrides Function GetHashCode() As Integer
Return _x.GetHashCode() Xor _y.GetHashCode() Xor _z.GetHashCode()
End Function
Public Shared Function FromXYZ(x As Double, y As Double, z As Double) As ColorXYZ
Return New ColorXYZ(x, y, z)
End Function
Public Shared Function FromRGB(rgb As Color) As ColorXYZ
Return FromRGB(rgb.R, rgb.G, rgb.B)
End Function
Public Shared Function FromRGB(rgb As UInteger) As ColorXYZ
Return FromRGB((rgb And &HFF0000UI) >> 16, (rgb And &HFF00UI) >> 8, rgb And &HFFUI)
End Function
Public Shared Function FromRGB(r As Integer, g As Integer, b As Integer) As ColorXYZ
Dim var_R = (r / 255D)
Dim var_G = (g / 255D)
Dim var_B = (b / 255D)
If var_R > 0.04045 Then
var_R = Math.Pow((var_R + 0.055) / 1.055, 2.4)
Else
var_R = var_R / 12.92
End If
If var_G > 0.04045 Then
var_G = Math.Pow((var_G + 0.055) / 1.055, 2.4)
Else
var_G /= 12.92
End If
If var_B > 0.04045 Then
var_B = Math.Pow((var_B + 0.055) / 1.055, 2.4)
Else
var_B /= 12.92
End If
var_R *= 100
var_G *= 100
var_B *= 100
Return New ColorXYZ(
var_R * 0.4124 + var_G * 0.3576 + var_B * 0.1805,
var_R * 0.2126 + var_G * 0.7152 + var_B * 0.0722,
var_R * 0.0193 + var_G * 0.1192 + var_B * 0.9505
)
End Function
Public Shared Function FromCIELab(lab As (L As Double, a As Double, b As Double)) As ColorXYZ
Return FromCIELab(lab.L, lab.a, lab.b)
End Function
Public Shared Function FromCIELab(L As Double, a As Double, b As Double) As ColorXYZ
Dim var_Y = (L + 16) / 116D
Dim var_X = a / 500D + var_Y
Dim var_Z = var_Y - b / 200D
If Math.Pow(var_Y, 3) > 0.008856 Then
var_Y = Math.Pow(var_Y, 3)
Else
var_Y = (var_Y - 16D / 116D) / 7.787
End If
If Math.Pow(var_X, 3) > 0.008856 Then
var_X = Math.Pow(var_X, 3)
Else
var_X = (var_X - 16D / 116D) / 7.787
End If
If Math.Pow(var_Z, 3) > 0.008856 Then
var_Z = Math.Pow(var_Z, 3)
Else
var_Z = (var_Z - 16D / 116D) / 7.787
End If
Return New ColorXYZ(
var_X * ReferenceX,
var_Y * ReferenceY,
var_Z * ReferenceZ
)
End Function
Public Function ToRGB() As Color
Dim var_X = _x / 100
Dim var_Y = _y / 100
Dim var_Z = _z / 100
Dim var_R = var_X * 3.2406 + var_Y * -1.5372 + var_Z * -0.4986
Dim var_G = var_X * -0.9689 + var_Y * 1.8758 + var_Z * 0.0415
Dim var_B = var_X * 0.0557 + var_Y * -0.204 + var_Z * 1.057
If var_R > 0.0031308 Then
var_R = 1.055 * Math.Pow(var_R, (1 / 2.4)) - 0.055
Else
var_R = 12.92 * var_R
End If
If var_G > 0.0031308 Then
var_G = 1.055 * Math.Pow(var_G, (1 / 2.4)) - 0.055
Else
var_G = 12.92 * var_G
End If
If var_B > 0.0031308 Then
var_B = 1.055 * Math.Pow(var_B, (1 / 2.4)) - 0.055
Else
var_B = 12.92 * var_B
End If
Return Color.FromArgb(
Math.Round(var_R * 255),
Math.Round(var_G * 255),
Math.Round(var_B * 255)
)
End Function
Public Function ToCIELab() As (L As Double, a As Double, b As Double)
Dim var_X = _x / ReferenceX
Dim var_Y = _y / ReferenceY
Dim var_Z = _z / ReferenceZ
If (var_X > 0.008856) Then
var_X = Math.Pow(var_X, 1 / 3D)
Else
var_X = (7.787 * var_X) + (16D / 116D)
End If
If (var_Y > 0.008856) Then
var_Y = Math.Pow(var_Y, 1 / 3D)
Else
var_Y = (7.787 * var_Y) + (16D / 116D)
End If
If (var_Z > 0.008856) Then
var_Z = Math.Pow(var_Z, 1 / 3D)
Else
var_Z = (7.787 * var_Z) + (16D / 116D)
End If
Return (
(116 * var_Y) - 16,
500 * (var_X - var_Y),
200 * (var_Y - var_Z)
)
End Function
End Class
End Class