├── .gitignore ├── Convolve.pas ├── Copyright.txt ├── CubicSSIM.res ├── Decimate.pas ├── GitHub.url ├── Home.url ├── LightSSIM.dpk ├── LightSSIM.dproj ├── LightSSIM.res ├── LightSaber_SSIM.res ├── MeanSquaredError.pas ├── PeakSignalNoiseRatio.pas ├── ReadMe.txt ├── SsimDef.pas └── StructuralSimilarity.pas /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | C code/C code.rar 3 | /Documentation/ 4 | /22.0_Win32_Debug/ 5 | /__history/ 6 | *.local 7 | *.dsk 8 | *.~dsk 9 | *.identcache 10 | GitHub.url 11 | A Comparison of JPEG Compression Levels and Recompression.url 12 | -------------------------------------------------------------------------------- /Convolve.pas: -------------------------------------------------------------------------------- 1 | UNIT Convolve; 2 | 3 | {============================================================================================================= 4 | Gabriel Moraru 5 | 2024.05 6 | 7 | This is a port (but contains also major reworks) from C to Delphi. 8 | The original C code can be downloaded from http://tdistler.com/iqa 9 | -------------------------------------------------------------------------------------------------------------- 10 | UnitTested: ok 11 | -------------------------------------------------------------------------------------------------------------} 12 | 13 | INTERFACE 14 | 15 | USES 16 | System.SysUtils, SsimDef; 17 | 18 | // Applies the specified kernel to the image. The kernel will be applied to all areas where it fits completely within the image. 19 | procedure ConvolveImage(img: RealImage; ImgWidth, ImgHeigth: integer; k: TKernelAttrib; Rez: RealImage; OUT rw,rh: integer); 20 | 21 | // Returns the filtered version of the specified pixel. If no kernel is given, the raw pixel value is returned. 22 | function FilterPixel (img: RealImage; ImgWidth, ImgHeigth: integer; PixelX, PixelY: integer; k: TKernelAttrib; kscale: single): Single; 23 | 24 | // Predicate functions to process "Out of bound" 25 | function KBND_SYMMETRIC(img: RealImage; ImgWidth, ImgHeigth: integer; x, y: integer; bnd_const: single): Single; 26 | 27 | IMPLEMENTATION 28 | 29 | 30 | 31 | 32 | // Out-of-bounds array values are a mirrored reflection of the border values 33 | function KBND_SYMMETRIC(img: RealImage; ImgWidth, ImgHeigth: integer; x, y: integer; bnd_const: single): single; 34 | begin 35 | if x < 0 36 | then x:= -1-x 37 | else 38 | if x >= ImgWidth 39 | then x:= (ImgWidth-(x-ImgWidth))-1; 40 | 41 | if y < 0 42 | then y:= -1-y 43 | else 44 | if y >= ImgHeigth 45 | then y:= (ImgHeigth-(y-ImgHeigth))-1; 46 | 47 | Result:= img[y*ImgWidth+x]; 48 | end; 49 | 50 | 51 | // Out-of-bounds array values are set to the nearest border value 52 | function KBND_REPLICATE(img: RealImage; w, ImgHeigth: integer; x, y: integer; bnd_const: single): single; // unused 53 | begin 54 | if x < 0 then x:= 0; 55 | if x >= w then x:= w-1; 56 | if y < 0 then y:= 0; 57 | if y >= ImgHeigth then y:= ImgHeigth-1; 58 | 59 | Result:= img[y*w+x]; 60 | end; 61 | 62 | 63 | // Out-of-bounds array values are set to 'bnd_const' 64 | function KBND_CONSTANT(img: RealImage; w, ImgHeigth: integer; x, y: integer; bnd_const: single): single; // unused 65 | begin 66 | if x < 0 then x:= 0; 67 | if y < 0 then y:= 0; 68 | 69 | if (x>=w) OR (y>=ImgHeigth) 70 | then Result:= bnd_const 71 | else Result:= img[y*w+x]; 72 | end; 73 | 74 | 75 | function ComputeScale(k: TKernelAttrib): single; 76 | VAR 77 | ii: integer; 78 | k_len: integer; 79 | sum: single; 80 | begin 81 | sum:=0; 82 | if k.normalized 83 | then Result:= 1 84 | else 85 | begin 86 | k_len:= k.Width * k.Height; 87 | for ii:=0 to Pred(k_len) 88 | DO sum:= sum + k.KernelW[ii]; 89 | 90 | if sum<> 0 91 | then Result:= 1 / sum 92 | else Result:= 1 93 | end; 94 | end; 95 | 96 | 97 | 98 | { Applies the specified kernel to the image. 99 | The kernel will be applied to all areas where it fits completely within the image. 100 | The resulting image will be smaller by half the kernel width and height (w - kw/2 and ImgHeigth - kh/2). 101 | 102 | Params: 103 | img Image to modify 104 | k The kernel to apply 105 | result 106 | Buffer to hold the resulting image ((w-kw)*(ImgHeigth-kh), where kw 107 | and kh are the kernel width and height). If 0, the result 108 | will be written to the original image buffer. 109 | rw Optional. The width of the resulting image will be stored here. 110 | rh Optional. The height of the resulting image will be stored here. } 111 | procedure ConvolveImage(img: RealImage; ImgWidth, ImgHeigth: integer; k: TKernelAttrib; Rez: RealImage; OUT rw, rh: integer); 112 | VAR 113 | PixelX, PixelY: integer; 114 | kx, ky: integer; 115 | u, v: integer; 116 | uc, vc: integer; 117 | kw_even, kh_even: integer; 118 | dst_w, dst_h: integer; 119 | ImgOffset: integer; 120 | KernOffset: integer; 121 | sum: Single; 122 | scale: Single; 123 | dst: RealImage; 124 | begin 125 | if Length(k.KernelW)= 0 //todo 5: make it an Assert 126 | then RAISE Exception.Create('KernelW is empty!'); 127 | 128 | uc:= k.Width DIV 2; 129 | vc:= k.Height DIV 2; 130 | 131 | if Odd(k.width) //was kw_even = (k->w&1)?0:1; 132 | then kw_even:= 0 133 | else kw_even:= 1; 134 | if Odd(k.Height) 135 | then kh_even:= 0 136 | else kh_even:= 1; 137 | 138 | dst_w:= ImgWidth -k.width +1; 139 | dst_h:= ImgHeigth -k.Height +1; 140 | dst:= Rez; //todo 2: get rid of 'dst' and work directly with Rez 141 | 142 | if dst = NIL 143 | then dst:= img; // Convolve in-place 144 | 145 | { Kernel is applied to all positions where the kernel is fully contained in the image } 146 | scale:= ComputeScale(k); 147 | 148 | for PixelY:= 0 to dst_h-1 do 149 | for PixelX:= 0 to dst_w-1 do 150 | begin 151 | sum:= 0; 152 | KernOffset:= 0; 153 | ky:= PixelY+ vc; 154 | kx:= PixelX+ uc; 155 | for v:=-vc to vc-kh_even do 156 | begin 157 | ImgOffset:= (ky + v)* ImgWidth + kx; 158 | 159 | for u := -uc to uc-kw_even do 160 | begin 161 | if ImgOffset + u < 0 //todo 5: make it an Assert 162 | then Exception.Create('Invalid ImgOffset!'); 163 | 164 | if KernOffset >= Length(k.KernelW) //todo 5: make it an Assert 165 | then raise Exception.Create('Invalid KernOffset!'); 166 | 167 | sum:= sum + ( img[ImgOffset + u] * k.KernelW[KernOffset] ); 168 | Inc(KernOffset); 169 | end; 170 | end; 171 | dst[PixelY * dst_w + PixelX]:= sum*scale; 172 | end; 173 | 174 | rw:= dst_w; 175 | rh:= dst_h; 176 | end; 177 | 178 | // _iqa_img_filter 179 | // not implemented 180 | 181 | 182 | { Returns the filtered version of the specified pixel. If no kernel is given, the raw pixel value is returned. 183 | Params: 184 | img Source image 185 | w Image width 186 | ImgHeigth Image height 187 | x The x location of the pixel to filter 188 | y The y location of the pixel to filter 189 | k Optional. The convolution kernel to apply to the pixel. 190 | kscale The scale of the kernel (for normalization). 1 for normalized kernels. Required if 'k' is not null. 191 | 192 | returns: The filtered pixel value. } 193 | function FilterPixel(img: RealImage; ImgWidth, ImgHeigth: integer; PixelX, PixelY: integer; k: TKernelAttrib; kscale: single): single; 194 | var 195 | u,v: integer; 196 | uc,vc: integer; 197 | kx, ky: integer; 198 | kw_even, kh_even: integer; 199 | x_edge_left : integer; 200 | x_edge_right: integer; 201 | y_edge_top : integer; 202 | y_edge_bottom: integer; 203 | edge: boolean; 204 | ImgOffset: integer; 205 | KernOffset: integer; // Kernel offset 206 | sum: Single; 207 | begin 208 | if Length(k.KernelW)= 0 209 | then Exit(img[PixelY* ImgWidth + PixelX]); 210 | 211 | uc:= k.Width DIV 2; 212 | vc:= k.Height DIV 2; 213 | 214 | if Odd(k.width) // kw_even = (k->w&1)?0:1; 215 | then kw_even:= 0 216 | else kw_even:= 1; 217 | if Odd(k.Height) 218 | then kh_even:= 0 219 | else kh_even:= 1; 220 | 221 | x_edge_left := uc; 222 | x_edge_right := ImgWidth-uc; 223 | y_edge_top := vc; 224 | y_edge_bottom:= ImgHeigth-vc; 225 | edge:= (PixelX < x_edge_left) OR (Pixely < y_edge_top) OR (PixelX >= x_edge_right) OR (Pixely >= y_edge_bottom); 226 | 227 | sum:= 0; 228 | KernOffset:= 0; 229 | ky:= PixelY+ vc; 230 | kx:= PixelX+ uc; 231 | for v:= -vc to vc-kh_even do 232 | begin 233 | ImgOffset:= (ky + v)*ImgWidth + kx; 234 | for u := -uc to uc-kw_even DO 235 | begin 236 | Assert(KernOffset <= Length(k.KernelW), 'k_offset not < Length(k.kernel)!'); 237 | 238 | if ImgOffset + u < 0 //todo 4: convert it to Assertion to make it faster 239 | then Exception.Create('Invalid ImgOffset!'); 240 | 241 | if KernOffset >= Length(k.KernelW) //todo 4: convert it to Assertion to make it faster 242 | then raise Exception.Create('Invalid KernOffset!'); 243 | 244 | if NOT edge 245 | then sum:= sum + (img[ImgOffset + u] * k.KernelW[KernOffset]) 246 | else sum:= sum + (k.bnd_opt(img, ImgWidth, ImgHeigth, Pixelx+u, Pixely+v, k.bnd_const) * k.KernelW[KernOffset]); 247 | Inc(KernOffset); 248 | end; 249 | end; 250 | 251 | Result := sum * kscale; 252 | end; 253 | 254 | end. 255 | -------------------------------------------------------------------------------- /Copyright.txt: -------------------------------------------------------------------------------- 1 | Copyright/Conditions 2 | 3 | Library provided by Gabriel Moraru 4 | 5 | 1. You can use this library for free in your personal/commercial applications as long as you don't modify it. 6 | If you modify/update/extend/change/improve this library you MUST share your modifications with the rest of the world. 7 | The only place where you can share the changes to the library, is here, on GitHub ( https://github.com/AdminUser0/Delphi-LightSaber/ ) 8 | 2. Keep this original copyright notice so people would know that the library is free. 9 | 3. This library cannot be used in applications/platforms that promote illegal/immoral activities such as (but not limited to) hate/piracy/racism/pseudo-science (including anti-vaccine and flat earth). 10 | 4. The owner of the library reserves the right to update/change these conditions at any time. 11 | 5. This library cannot be used in Russia. The ban applies 25 years after the Russia-Ukraine war ends. 12 | 6. The library name cannot be changed. 13 | 14 | Note: 15 | Most parts of this library were written by myself. Some other parts (small snippets) were inspired or simply copied from miscellaneous Internet sources (mostly StackOverflow). A link to the original source was provided in this case. 16 | -------------------------------------------------------------------------------- /CubicSSIM.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-SSIM-ImageQuality/f1e0e31cf9b928f59fb2bb4ef4efaf83a811e4a5/CubicSSIM.res -------------------------------------------------------------------------------- /Decimate.pas: -------------------------------------------------------------------------------- 1 | UNIT Decimate; 2 | 3 | {============================================================================================================= 4 | Gabriel Moraru 5 | 2024.05 6 | 7 | This is a port (but contains also major reworks) from C to Delphi. 8 | The original C code can be downloaded from http://tdistler.com/iqa 9 | -------------------------------------------------------------------------------------------------------------- 10 | Downsamples (decimates) an image. 11 | 12 | Params: 13 | img Image to modify 14 | ImgWidth Image width 15 | ImgHeigth Image height 16 | factor Decimation factor 17 | k The kernel to apply (e.g. low-pass filter). Can be 0. 18 | Rez Buffer to hold the resulting image (w/factor*ImgHeigth/factor). If 0, the result will be written to the original image buffer. 19 | rw rh Optional. The width/height of the resulting image will be stored here. 20 | -------------------------------------------------------------------------------------------------------------} 21 | 22 | INTERFACE 23 | 24 | USES System.SysUtils, SsimDef; 25 | 26 | procedure DecimateImage(img: RealImage; ImgWidth, ImgHeigth: integer; factor: integer; k: TKernelAttrib; Rez: RealImage; OUT rw, rh: Integer); 27 | 28 | IMPLEMENTATION 29 | 30 | USES Convolve; 31 | 32 | 33 | procedure DecimateImage(img: RealImage; ImgWidth, ImgHeigth: integer; factor: integer; k: TKernelAttrib; Rez: RealImage; OUT rw, rh: Integer); 34 | var 35 | x, y: integer; 36 | sw, sh: Integer; 37 | dst_offset: integer; 38 | dst: RealImage; 39 | begin 40 | // test oddity 41 | sw:= ImgWidth DIV factor; 42 | if Odd(sw) then Inc(sw); 43 | 44 | sh:= ImgHeigth DIV factor; 45 | if Odd(sh) then Inc(sh); 46 | 47 | dst:= img; 48 | if rez <> NIL 49 | then dst:= Rez; 50 | 51 | // Downsample 52 | for y:= 0 to sh-1 do 53 | begin 54 | dst_offset:= y * sw; 55 | Assert(dst_offset < Length(dst), 'Invalid dst!'); 56 | 57 | for x:= 0 to sw-1 do 58 | begin 59 | Assert(x*factor < {=} ImgWidth, 'x:'+ IntToStr(x)+ '. factor:'+ IntToStr(factor)+ '. w:'+ IntToStr(ImgWidth)); // here was: x*factor < w 60 | 61 | dst[dst_offset]:= FilterPixel(img, ImgWidth, ImgHeigth, x*factor, y*factor, k, 1); 62 | Inc(dst_offset); 63 | end; 64 | end; 65 | 66 | rw:= sw; 67 | rh:= sh; 68 | end; 69 | 70 | end. 71 | -------------------------------------------------------------------------------- /GitHub.url: -------------------------------------------------------------------------------- 1 | [InternetShortcut] 2 | URL=https://gabrielmoraru.com/my-delphi-code/ssim-image-quality-assessment-delphi-library/?preview_id=1128&preview_nonce=29a32598fc&_thumbnail_id=-1&preview=true 3 | IDList= 4 | HotKey=0 5 | IconFile=C:\Users\trei\AppData\Local\Mozilla\Firefox\Profiles\daecy5hr.default-release\shortcutCache\ThUq0w3mVEEDO1snk_bpMg==.ico 6 | IconIndex=0 7 | -------------------------------------------------------------------------------- /Home.url: -------------------------------------------------------------------------------- 1 | [InternetShortcut] 2 | URL=https://gabrielmoraru.com/my-delphi-code/ssim-image-quality-assessment-delphi-library/ 3 | IDList= 4 | HotKey=0 5 | IconFile=C:\Users\trei\AppData\Local\Mozilla\Firefox\Profiles\daecy5hr.default-release\shortcutCache\+qDzlVgKZUDqYK5rLpXXfg==.ico 6 | IconIndex=0 7 | -------------------------------------------------------------------------------- /LightSSIM.dpk: -------------------------------------------------------------------------------- 1 | package LightSSIM; 2 | 3 | 4 | {$R *.res} 5 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 6 | {$ALIGN 2} 7 | {$ASSERTIONS ON} 8 | {$BOOLEVAL OFF} 9 | {$DEBUGINFO OFF} 10 | {$EXTENDEDSYNTAX ON} 11 | {$IMPORTEDDATA ON} 12 | {$IOCHECKS ON} 13 | {$LOCALSYMBOLS ON} 14 | {$LONGSTRINGS ON} 15 | {$OPENSTRINGS ON} 16 | {$OPTIMIZATION OFF} 17 | {$OVERFLOWCHECKS ON} 18 | {$RANGECHECKS ON} 19 | {$REFERENCEINFO ON} 20 | {$SAFEDIVIDE OFF} 21 | {$STACKFRAMES ON} 22 | {$TYPEDADDRESS OFF} 23 | {$VARSTRINGCHECKS ON} 24 | {$WRITEABLECONST OFF} 25 | {$MINENUMSIZE 1} 26 | {$IMAGEBASE $400000} 27 | {$DEFINE DEBUG} 28 | {$ENDIF IMPLICITBUILDING} 29 | {$DESCRIPTION 'LightSaber - Image Video Quality Comparison'} 30 | {$LIBSUFFIX AUTO} 31 | {$RUNONLY} 32 | {$IMPLICITBUILD ON} 33 | 34 | requires 35 | rtl, 36 | vclimg, 37 | vcl; 38 | 39 | contains 40 | Convolve in 'Convolve.pas', 41 | Decimate in 'Decimate.pas', 42 | MeanSquaredError in 'MeanSquaredError.pas', 43 | PeakSignalNoiseRatio in 'PeakSignalNoiseRatio.pas', 44 | SsimDef in 'SsimDef.pas', 45 | StructuralSimilarity in 'StructuralSimilarity.pas'; 46 | 47 | end. 48 | 49 | -------------------------------------------------------------------------------- /LightSSIM.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | True 4 | Package 5 | Debug 6 | VCL 7 | LightSSIM.dpk 8 | Win32 9 | {8CFAD253-E88E-4276-BE73-15A25DD5CBF8} 10 | 19.5 11 | 1 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | LightSSIM 33 | All 34 | .\$(ProductVersion)_$(Platform)_$(Config) 35 | LightSaber - Image Video Quality Comparison 36 | true 37 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 38 | true 39 | true 40 | 2 41 | $(Auto) 42 | true 43 | CompanyName=Gabriel Moraru;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 44 | 1033 45 | 46 | 47 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 48 | xmlrtl;rtl;vclimg;vcl;vclx;IndySystem;CubicCore;ThirdPartyPack_XE7;vclie;soaprtl;GR32_R;$(DCC_UsePackage) 49 | 50 | 51 | DEBUG;$(DCC_Define) 52 | false 53 | true 54 | true 55 | 56 | 57 | RELEASE;$(DCC_Define) 58 | true 59 | false 60 | 61 | 62 | 63 | MainSource 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | Base 76 | 77 | 78 | Cfg_1 79 | Base 80 | 81 | 82 | Cfg_2 83 | Base 84 | 85 | 86 | 87 | Delphi.Personality.12 88 | Package 89 | 90 | 91 | 92 | LightSSIM.dpk 93 | 94 | 95 | LightSaber - Common tools 96 | LightSaber - Core library 97 | File C:\Users\Public\Documents\Embarcadero\Studio\22.0\Bpl\CubicProteus280.bpl not found 98 | Microsoft Office 2000 Sample Automation Server Wrapper Components 99 | Microsoft Office XP Sample Automation Server Wrapper Components 100 | 101 | 102 | 103 | 104 | 105 | LightSSIM.bpl 106 | true 107 | 108 | 109 | 110 | 111 | 0 112 | 113 | 114 | 115 | 116 | 0 117 | 118 | 119 | 120 | 121 | 0 122 | 123 | 124 | 125 | 126 | 0 127 | .dll;.bpl 128 | 129 | 130 | 131 | 132 | 0 133 | .bpl 134 | 135 | 136 | 137 | 138 | 0 139 | 140 | 141 | 142 | 143 | 0 144 | 145 | 146 | 147 | 148 | 1 149 | 150 | 151 | 152 | 153 | Assets 154 | 1 155 | 156 | 157 | 158 | 159 | Assets 160 | 1 161 | 162 | 163 | 164 | 165 | 166 | True 167 | False 168 | False 169 | False 170 | False 171 | False 172 | False 173 | False 174 | False 175 | 176 | 177 | 12 178 | 179 | 180 | 181 | 182 | 183 | -------------------------------------------------------------------------------- /LightSSIM.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-SSIM-ImageQuality/f1e0e31cf9b928f59fb2bb4ef4efaf83a811e4a5/LightSSIM.res -------------------------------------------------------------------------------- /LightSaber_SSIM.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-SSIM-ImageQuality/f1e0e31cf9b928f59fb2bb4ef4efaf83a811e4a5/LightSaber_SSIM.res -------------------------------------------------------------------------------- /MeanSquaredError.pas: -------------------------------------------------------------------------------- 1 | UNIT MeanSquaredError; 2 | 3 | {============================================================================================================= 4 | Gabriel Moraru 5 | 2024.05 6 | 7 | This is a port (but contains also major reworks) from C to Delphi. 8 | The original C code can be downloaded from http://tdistler.com/iqa 9 | -------------------------------------------------------------------------------------------------------------- 10 | Mean Squared Error 11 | 12 | Calculates the Mean Squared Error between 2 equal-sized 8-bit images. 13 | note The images must have the same width, height, and stride. 14 | 15 | Params: 16 | ReferenceImg Original image 17 | CompareImage Distorted image 18 | 19 | Mean Squared Error 20 | is the average squared difference between a reference image and a distorted image. 21 | It is computed pixel-by-pixel by adding up the squared differences of all the pixels and dividing by the total pixel count. 22 | MSE(a,b) = 1/N * SUM((a-b)^2) 23 | 24 | For images A = [a1 .. aM] and B = [b1 .. bM], where M is the number of pixels: 25 | The squaring of the differences dampens small differences between the 2 pixels but penalizes large ones. 26 | 27 | More info: 28 | http://en.wikipedia.org/wiki/Mean_squared_error 29 | -------------------------------------------------------------------------------------------------------------} 30 | 31 | INTERFACE 32 | 33 | USES SsimDef; 34 | 35 | function mse(ReferenceImg, CompareImg: ByteImage; ImgWidth, ImgHeigth, stride: integer): Single; 36 | 37 | 38 | IMPLEMENTATION 39 | 40 | 41 | function mse(ReferenceImg, CompareImg: ByteImage; ImgWidth, ImgHeigth, stride: integer): Single; // Returns: MSE 42 | var 43 | error: Single; 44 | offset: integer; 45 | sum: Int64; 46 | ww: integer; 47 | hh: integer; 48 | begin 49 | sum:= 0; 50 | Assert(Length(ReferenceImg) = Length(CompareImg), 'The images must have the same width, height, and stride!'); 51 | for hh:= 0 to ImgHeigth-1 do 52 | begin 53 | offset:= hh*stride; 54 | for ww:= 0 to ImgWidth-1 DO 55 | begin 56 | error:= ReferenceImg[offset] - CompareImg[offset]; 57 | sum:= sum + round(error*error); 58 | inc(offset); 59 | end; 60 | end; 61 | 62 | result:= sum / (ImgWidth*ImgHeigth); 63 | end; 64 | 65 | end. 66 | -------------------------------------------------------------------------------- /PeakSignalNoiseRatio.pas: -------------------------------------------------------------------------------- 1 | UNIT PeakSignalNoiseRatio; 2 | 3 | {============================================================================================================= 4 | Gabriel Moraru 5 | 2024.05 6 | 7 | This is a port (but contains also major reworks) from C to Delphi. 8 | The original C code can be downloaded from http://tdistler.com/iqa 9 | -------------------------------------------------------------------------------------------------------------- 10 | Peak Signal-to-Noise Ratio 11 | (UNUSED) 12 | 13 | Calculates the Peak Signal-to-Noise-Ratio between 2 equal-sized 8-bit images. 14 | 15 | Params: 16 | ReferenceImage: Original image 17 | CompareImage : Distorted image 18 | stride : The length (in bytes) of each horizontal line in the image. 19 | This may be different from the image width. 20 | PSNR 21 | PSNR(a,b) = 10*log10(L^2 / MSE(a,b)), where L=2^b - 1 (8bit = 255) 22 | Peak Signal-to-Noise Ratio is the ratio between the reference signal and the distortion signal in an image, given in decibels. 23 | The higher the PSNR, the closer the distorted image is to the original. 24 | In general, a higher PSNR value should correlate to a higher quality image, but tests have shown that this isn't always the case. 25 | However, PSNR is a popular quality metric because it's easy and fast to calculate while still giving okay results. 26 | For images A = [a1 .. aM], B = [b1 .. bM], and MAX equal to the maximum possible pixel value (2^8 - 1 = 255 for 8-bit images): 27 | More info: http://en.wikipedia.org/wiki/PSNR 28 | -------------------------------------------------------------------------------------------------------------} 29 | 30 | INTERFACE 31 | 32 | USES 33 | System.Math, SsimDef, MeanSquaredError; 34 | 35 | function psnr(ReferenceImage, CompareImage: ByteImage; ImgWidth, ImgHeigth, stride: integer): Single; // Returns: PSNR 36 | 37 | 38 | IMPLEMENTATION 39 | 40 | function psnr(ReferenceImage, CompareImage: ByteImage; ImgWidth, ImgHeigth, stride: integer): Single; 41 | CONST 42 | L_sqd: integer = 255*255; 43 | begin 44 | Assert(Length(ReferenceImage) = Length(CompareImage), 'The images must have the same width, height, and stride.'); 45 | Result:= 10 * log10(L_sqd / mse(ReferenceImage, CompareImage, ImgWidth, ImgHeigth, stride)); 46 | end; 47 | 48 | end. 49 | -------------------------------------------------------------------------------- /ReadMe.txt: -------------------------------------------------------------------------------- 1 | Delphi Structural similarity index measure (SSIM) 2 | 3 | Home: 4 | www.gabrielmoraru.com/my-delphi-code/ssim-image-quality-assessment-delphi-library/ 5 | 6 | 7 | 8 | 9 | Description 10 | 11 | A library for objectively measuring image/video quality. 12 | It implements many popular algorithms, such as MS-SSIM, MS-SSIM*, SIMM, MSE, and PSNR. 13 | It is designed to be fast, accurate, and reliable. 14 | 15 | 16 | Delphi port 17 | 18 | This is a port (major rework) from C to Delphi. 19 | The original C code can be downloaded from http://tdistler.com/iqa 20 | I also translated some unit tests, but I HAVEN'T IMPLEMENTED _iqa_img_filter. 21 | 22 | 23 | Compilation 24 | 25 | It can be compiled directly and requires no additional libraries. 26 | The code should be compilable also on Lazarus/FPC. 27 | It also fixes two bugs found in the original C code. 28 | 29 | 30 | Copyright/Conditions 31 | 32 | The copyright conditions are quite relaxed. See Copyright.txt 33 | 34 | Have fun. 35 | Long live Pascal :) 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /SsimDef.pas: -------------------------------------------------------------------------------- 1 | UNIT SsimDef; 2 | 3 | {============================================================================================================= 4 | Gabriel Moraru 5 | 2024.05 6 | 7 | This is a port (but contains also major reworks) from C to Delphi. 8 | The original C code can be downloaded from http://tdistler.com/iqa 9 | -------------------------------------------------------------------------------------------------------------- 10 | TYPE DEFINITIONS AND UTIL FUNCTIONS 11 | -------------------------------------------------------------------------------------------------------------} 12 | 13 | {About 'static' in C: 14 | Static defined local variables do not lose their value between function calls. In other words they are global variables, but scoped to the local function they are defined in. 15 | Static global variables are not visible outside of the C file they are defined in. 16 | Static functions are not visible outside of the C file they are defined in. } 17 | 18 | 19 | INTERFACE 20 | USES 21 | System.SysUtils, Vcl.Graphics; 22 | 23 | CONST 24 | GAUSSIAN_LEN = 11; 25 | SQUARE_LEN = 8; { Equal weight square window. Each pixel is equally weighted (1/64) so that SUM(x) = 1.0 } 26 | 27 | TYPE 28 | ByteImage = array of Byte; // Unidimensional array (of size Width*Height) that holds the pixels of an image. Only gray images allowed on input. 29 | RealImage = array of Single; 30 | 31 | TYPE 32 | TKernelWndType = (gwGaussian, gwSquare); // gwSquare aka Linear. in orig code, gwGaussian is passed as 1 and gwSquare as 0 as parameters. 33 | 34 | TYPE 35 | // Defines a convolution kernel 36 | TOutOfBoundsPredicate = reference to function (img: RealImage; w, ImgHeigth: integer; x, y: integer; bnd_const: single): Single; 37 | 38 | TKernelWindow= array of Single; 39 | 40 | TKernelAttrib = record // was _kernel 41 | KernelW: TKernelWindow; // Pointer to the kernel values 42 | Width, Height: integer; // The kernel width/height 43 | Normalized: Boolean; // true if the kernel values add up to 1 44 | bnd_opt: TOutOfBoundsPredicate; // Defines how out-of-bounds image values are handled _get_pixel 45 | bnd_const: single; // If 'bnd_opt' is KBND_CONSTANT, this specifies the out-of-bounds value 46 | end; 47 | 48 | TYPE 49 | TScaleFactor = (sfAuto, sfNone); 50 | TSsimArgs = record // Allows fine-grain control of the SSIM algorithm. 51 | ScaleFactor: TScaleFactor; // was: 0=default scaling, 1=no scaling 52 | CustomParams: Boolean; // If true, use custom alpha, beta, gamma, L, K1, K2. Otherwise, ignore then and use defaults 53 | Alpha: Single; // luminance exponent 54 | Beta : single; // contrast exponent 55 | Gamma: single; // structure exponent 56 | L : integer; // dynamic range (2^8 - 1) 57 | K1: single; // stabilization constant 1 58 | K2: single; // stabilization constant 2 59 | public 60 | procedure Init; 61 | end; 62 | 63 | 64 | 65 | procedure SetKernelWindow(VAR KernelAttrib: TKernelAttrib; KernelWnd: TKernelWndType); 66 | function TransferPixels (BMP: TBitmap): ByteImage; 67 | procedure SetLengthAndZeroFill(VAR SomeArray: RealImage; Size: Integer); 68 | function GetStride(BMP: TBitmap): Integer; 69 | function RoundEx(CONST X: Extended): Longint; 70 | procedure EmptyDummy; 71 | 72 | 73 | 74 | IMPLEMENTATION 75 | 76 | 77 | procedure TSsimArgs.Init; { I tried 'constructor TSsimArgs.Create' but it doesn't work in XE7 } 78 | begin 79 | CustomParams:= FALSE; 80 | ScaleFactor:= sfAuto; 81 | alpha := 1; 82 | beta := 1; 83 | gamma := 1; 84 | L := 255; 85 | K1 := 0.01; 86 | K2 := 0.03; 87 | end; 88 | 89 | 90 | 91 | { If fractional part is >= 0.5 then the number is rounded up, else down. "Bank" algorithm example: Round(25.5) = 26 but Round(26.5) = 26 } 92 | function RoundEx(CONST X: Extended): LongInt; 93 | begin 94 | Result:= Trunc(x); 95 | if Frac(x) >= 0.50 96 | then Result:= Result+ 1; 97 | end; 98 | 99 | 100 | procedure SetKernelWindow(VAR KernelAttrib: TKernelAttrib; KernelWnd: TKernelWndType); 101 | CONST 102 | { Circular-symmetric Gaussian weighting. 103 | h (x,y) = hg(x,y)/SUM(SUM(hg)), for normalization to 1 104 | hg(x,y) = e^( -0.5*( (x^2+y^2)/sigma^2 ) ), where sigma was 1.5 } 105 | g_gaussian_window: array [0..pred(GAUSSIAN_LEN*GAUSSIAN_LEN)] of single = 106 | (0.000001, 0.000008, 0.000037, 0.000112, 0.000219, 0.000274, 0.000219, 0.000112, 0.000037, 0.000008, 0.000001, 107 | 0.000008, 0.000058, 0.000274, 0.000831, 0.001619, 0.002021, 0.001619, 0.000831, 0.000274, 0.000058, 0.000008, 108 | 0.000037, 0.000274, 0.001296, 0.003937, 0.007668, 0.009577, 0.007668, 0.003937, 0.001296, 0.000274, 0.000037, 109 | 0.000112, 0.000831, 0.003937, 0.011960, 0.023294, 0.029091, 0.023294, 0.011960, 0.003937, 0.000831, 0.000112, 110 | 0.000219, 0.001619, 0.007668, 0.023294, 0.045371, 0.056662, 0.045371, 0.023294, 0.007668, 0.001619, 0.000219, 111 | 0.000274, 0.002021, 0.009577, 0.029091, 0.056662, 0.070762, 0.056662, 0.029091, 0.009577, 0.002021, 0.000274, 112 | 0.000219, 0.001619, 0.007668, 0.023294, 0.045371, 0.056662, 0.045371, 0.023294, 0.007668, 0.001619, 0.000219, 113 | 0.000112, 0.000831, 0.003937, 0.011960, 0.023294, 0.029091, 0.023294, 0.011960, 0.003937, 0.000831, 0.000112, 114 | 0.000037, 0.000274, 0.001296, 0.003937, 0.007668, 0.009577, 0.007668, 0.003937, 0.001296, 0.000274, 0.000037, 115 | 0.000008, 0.000058, 0.000274, 0.000831, 0.001619, 0.002021, 0.001619, 0.000831, 0.000274, 0.000058, 0.000008, 116 | 0.000001, 0.000008, 0.000037, 0.000112, 0.000219, 0.000274, 0.000219, 0.000112, 0.000037, 0.000008, 0.000001); 117 | VAR i: Integer; 118 | begin 119 | case KernelWnd of 120 | gwSquare: 121 | begin 122 | //square window 123 | SetLength(KernelAttrib.KernelW, SQUARE_LEN * SQUARE_LEN); 124 | KernelAttrib.width := SQUARE_LEN; 125 | KernelAttrib.Height := SQUARE_LEN; 126 | for i:= 0 to High(KernelAttrib.KernelW) 127 | DO KernelAttrib.KernelW[i]:= 0.015625; 128 | end; 129 | gwGaussian: 130 | begin 131 | // gaussian window; 132 | SetLength(KernelAttrib.KernelW, GAUSSIAN_LEN * GAUSSIAN_LEN); 133 | KernelAttrib.width := GAUSSIAN_LEN; 134 | KernelAttrib.Height := GAUSSIAN_LEN; 135 | for i:= 0 to High(KernelAttrib.KernelW) 136 | DO KernelAttrib.KernelW[i]:= g_gaussian_window[i]; 137 | end; 138 | end; 139 | end; 140 | 141 | 142 | 143 | { Convert pixels to gray and transfer them from a TBitmap to a unidimensional array (of size Width*Height) 144 | x + 0 = Blue, x + 1 = Green, x + 2 = Red } 145 | function TransferPixels(BMP: TBitmap): ByteImage; 146 | TYPE 147 | { Scan line for pf32 images } 148 | TRGB32 = packed record 149 | B, G, R, A: Byte; 150 | end; 151 | TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32; // some use MaxInt instead of MaxWord 152 | PRGB32Array = ^TRGB32Array; 153 | VAR 154 | Target, cur, x, y: Integer; 155 | Line: PRGB32Array; 156 | begin 157 | cur:= 0; 158 | BMP.PixelFormat:= pf32bit; 159 | SetLength(Result, BMP.Width * BMP.Height); 160 | for y := 0 to BMP.Height - 1 do 161 | begin 162 | Line := BMP.ScanLine[y]; 163 | for x := 0 to BMP.Width - 1 do 164 | begin 165 | // Calculate a 'human-like' shade of gray 166 | Target:= RoundEx( 167 | (0.30 * Line[x].r) + 168 | (0.59 * Line[x].g) + 169 | (0.11 * Line[x].b)); 170 | Result[cur]:= Target; // Fill gray pixels in the array 171 | Inc(cur); 172 | end; 173 | end; 174 | end; 175 | 176 | 177 | { Stride is the length (in bytes) of each horizontal line in the image. 178 | This may be different from the image Width. 179 | http://paulbourke.net/dataformats/bitmaps/ } 180 | function GetStride(BMP: TBitmap): integer; 181 | VAR BytesPerPix: Integer; 182 | begin 183 | //BytesPerPix := cGraphLoader.Resolution.GetBitsPerPixel(BMP); // bits per pix 184 | //BytesPerPix := BytesPerPix DIV 8; // bytes per pix 185 | BytesPerPix := 1; // because I aways use gray! 186 | Result:= BMP.Width * BytesPerPix; 187 | end; 188 | 189 | 190 | procedure SetLengthAndZeroFill(VAR SomeArray: RealImage; Size: Integer); 191 | begin 192 | SetLength(SomeArray, Size); 193 | FillChar(SomeArray[0], SizeOf(SomeArray), 0); 194 | end; 195 | 196 | 197 | 198 | procedure EmptyDummy; 199 | begin 200 | //Sleep(1); 201 | end; 202 | 203 | 204 | end. 205 | 206 | -------------------------------------------------------------------------------- /StructuralSimilarity.pas: -------------------------------------------------------------------------------- 1 | UNIT StructuralSimilarity; 2 | 3 | {============================================================================================================= 4 | Gabriel Moraru 5 | 2024.05 6 | 7 | This is a port (but contains also major reworks) from C to Delphi. 8 | The original C code can be downloaded from http://tdistler.com/iqa 9 | -------------------------------------------------------------------------------------------------------------- 10 | Calculates the structural similarity between 2 images. 11 | MAIN FILE 12 | -------------------------------------------------------------------------------------------------------------- 13 | 14 | Note: The images must be equal as size and gray scale. 15 | See https://ece.uwaterloo.ca/~z70wang/publications/ssim.html 16 | 17 | ALGO: 18 | SSIM(x,y) = (2*ux*uy + C1)*(2sxy + C2) / (ux^2 + uy^2 + C1)*(sx^2 + sy^2 + C2) where: 19 | ux = SUM(w*x) 20 | sx = (SUM(w*(x-ux)^2)^0.5 21 | sxy = SUM(w*(x-ux)*(y-uy)) 22 | Returns mean SSIM. MSSIM(X,Y) = 1/M * SUM(SSIM(x,y)) 23 | 24 | SSIM 25 | Structural SIMilarity is based on the idea that the human visual system is highly adapted to process 26 | structural information, and the algorithm attepts to measure the change in this information between and 27 | reference and distorted image. 28 | 29 | Based on numberous tests, SSIM does a much better job at quantifying subjective image quality than MSE or PSNR. 30 | 31 | At a high level, SSIM attempts to measure the change in luminance, contrast, and structure in an image. 32 | Luminance is modeled as average pixel intensity, 33 | constrast by the variance between the reference and distorted image, and 34 | structure by the cross-correlation between the 2 images. 35 | 36 | The resulting values are combined (using exponents referred to as alpha, beta, and gamma) and 37 | averaged to generate a final SSIM index value. 38 | 39 | The original paper defined 2 methods for calculating each local SSIM value: 40 | an 8x8 linear 41 | or 11x11 circular Gaussian sliding window. 42 | 43 | This library uses the Gaussian window that the paper suggests to give the best results. 44 | However, the window type, stabilization constants, and exponents can all be set adjusted by the application. 45 | 46 | Here's an interesting article by the authors discussing the limitations of MSE and PSNR as compared to SSIM: 47 | https://ece.uwaterloo.ca/~z70wang/publications/SPM09.pdf 48 | 49 | -------------------------------------------------------------------------------------------------------------} 50 | 51 | //todo 3: rename 'ref' to 'RefBitmap' 52 | //bug: there is a bug that makes the first computation to return a very low value. the subsequent computations seem ok. probably some bad initialization 53 | 54 | INTERFACE 55 | USES 56 | System.SysUtils, Vcl.Graphics, SsimDef; 57 | 58 | // Main functions 59 | function SsimCompare(refBMP, cmpBMP: TBitmap; WndType: TKernelWndType): Single; overload; 60 | function SsimCompare(refBMP, cmp: ByteImage; ImgWidth, ImgHeigth, stride: Integer; KernelWndType: TKernelWndType; args: TSsimArgs): Single; overload; 61 | 62 | IMPLEMENTATION 63 | 64 | USES 65 | Math, Decimate, Convolve; 66 | 67 | 68 | 69 | {--------------------------------------------------------------------------- 70 | UTIL FUNCTIONS FOR _ssim 71 | ---------------------------------------------------------------------------} 72 | function computeLuminance(mu1, mu2: single; C1: single; alpha: single): single; 73 | VAR 74 | Rez: single; 75 | begin 76 | // For MS-SSIM 77 | if (C1 = 0) and (mu1 = 0) and (mu2 = 0) 78 | then EXIT(1); 79 | 80 | Rez := (2 * mu1 * mu2 + C1) / (mu1 * mu1 + mu2 * mu2 + C1); 81 | if alpha = 1 then Exit(rez); 82 | 83 | if Rez < 0 84 | then Result := -Power(Abs(Rez), alpha) 85 | else Result := Power(Abs(Rez), alpha); 86 | end; 87 | 88 | 89 | function computeContrast(sigma_comb_12, sigma1_sqd, sigma2_sqd: single; C2: single; beta: single): single; 90 | var 91 | Rez: single; 92 | begin 93 | // For MS-SSIM 94 | if (C2 = 0) AND (sigma1_sqd + sigma2_sqd = 0) 95 | then EXIT(1); 96 | 97 | Rez := (2 * sigma_comb_12 + C2) / (sigma1_sqd + sigma2_sqd + C2); 98 | if beta = 1 then Exit(rez); 99 | 100 | if Rez < 0 101 | then Result:= -Power(Abs(Rez), beta) 102 | else Result:= Power(Abs(Rez), beta); 103 | end; 104 | 105 | 106 | function computeStructure(sigma_12, sigma_comb_12, sigma1, sigma2: single; C3: single; gamma: single): single; 107 | var 108 | Rez: single; 109 | begin 110 | // For MS-SSIM 111 | if (C3 = 0) and (sigma_comb_12 = 0) then 112 | begin 113 | if (sigma1 = 0) and (sigma2 = 0) 114 | then exit(1) 115 | else 116 | if (sigma1 = 0) or (sigma2 = 0) 117 | then EXIT(0); 118 | end; 119 | 120 | Rez := (sigma_12 + C3) / (sigma_comb_12 + C3); 121 | if gamma = 1 then Exit(rez); 122 | 123 | if Rez < 0 124 | then Result := -Power(Abs(Rez), gamma) 125 | else Result := Power(Abs(Rez), gamma); 126 | end; 127 | 128 | 129 | 130 | 131 | {--------------------------------------------------------------------------- 132 | Calculates the SSIM value on a pre-processed image. 133 | The input images must have stride=width. This method does not scale. 134 | Note: Image buffers are modified. 135 | 136 | Map-reduce is used for doing the final SSIM calculation. 137 | The map function is called for every pixel, and the reduce is called at the end. 138 | The context is caller-defined and *not* modified by this method. 139 | 140 | Parameters: 141 | ref : Original reference image 142 | cmp : Distorted image 143 | ImgWidth : Width of the images 144 | ImgHeigth : Height of the images 145 | k : The kernel used as the window function 146 | mr : Optional map-reduce functions to use to calculate SSIM. 147 | Required if 'args' is not null. Ignored if 'args' is null. 148 | args: Optional SSIM arguments for fine control of the algorithm. 0 for defaults. 149 | Defaults are a=b=g=1.0, L=255, K1=0.01, K2=0.03 150 | 151 | Returns: The mean SSIM over the entire image (MSSIM) } 152 | 153 | 154 | function _ssim(ref, cmp: RealImage; ImgWidth, ImgHeigth: integer; k: TKernelAttrib; args: TSsimArgs): single; 155 | VAR 156 | C1, C2, C3 : Single; 157 | x, y : integer; 158 | dummy, offset : integer; 159 | ref_mu : RealImage; 160 | cmp_mu : RealImage; 161 | ref_sigma_sqd : RealImage; 162 | cmp_sigma_sqd : RealImage; 163 | sigma_both : RealImage; 164 | ssim_sum : single; 165 | numerator : single; 166 | denominator : single; 167 | luminance_comp, contrast_comp, structure_comp : single; 168 | sigma_root : single; 169 | begin 170 | C1 := (args.K1 * args.L) * (args.K1 * args.L); 171 | C2 := (args.K2 * args.L) * (args.K2 * args.L); 172 | C3 := C2 / 2; 173 | 174 | // Calculate mean 175 | SetLength(ref_mu, ImgWidth * ImgHeigth); 176 | SetLength(cmp_mu, ImgWidth * ImgHeigth); 177 | SetLength(ref_sigma_sqd, ImgWidth * ImgHeigth); 178 | SetLength(cmp_sigma_sqd, ImgWidth * ImgHeigth); 179 | SetLength(sigma_both, ImgWidth * ImgHeigth); 180 | 181 | ConvolveImage(ref, ImgWidth, ImgHeigth, k, ref_mu, dummy, dummy); 182 | ConvolveImage(cmp, ImgWidth, ImgHeigth, k, cmp_mu, dummy, dummy); 183 | for y := 0 to ImgHeigth-1 do 184 | begin 185 | offset := y * ImgWidth; 186 | for x := 0 to ImgWidth-1 do 187 | begin 188 | ref_sigma_sqd[offset] := ref[offset] * ref[offset]; 189 | cmp_sigma_sqd[offset] := cmp[offset] * cmp[offset]; 190 | sigma_both[offset] := ref[offset] * cmp[offset]; 191 | Inc(offset); 192 | end; 193 | end; 194 | 195 | // Calculate sigma 196 | ConvolveImage(ref_sigma_sqd, ImgWidth, ImgHeigth, k, NIL, dummy, dummy); 197 | ConvolveImage(cmp_sigma_sqd, ImgWidth, ImgHeigth, k, NIL, dummy, dummy); 198 | ConvolveImage(sigma_both, ImgWidth, ImgHeigth, k, NIL, ImgWidth, ImgHeigth); // was convolve(sigma_both, w, h, k, 0, &w, &h); 199 | 200 | (* Update the width and height *) 201 | // The convolution results are smaller by the kernel width and height 202 | for y := 0 to ImgHeigth-1 do 203 | begin 204 | offset := y * ImgWidth; 205 | for x := 0 to ImgWidth-1 do 206 | begin 207 | ref_sigma_sqd[offset] := ref_sigma_sqd[offset] - (ref_mu[offset] * ref_mu[offset]); 208 | cmp_sigma_sqd[offset] := cmp_sigma_sqd[offset] - (cmp_mu[offset] * cmp_mu[offset]); 209 | sigma_both[offset] := sigma_both[offset] - (ref_mu[offset] * cmp_mu[offset]); 210 | Inc(offset); 211 | end; 212 | end; 213 | 214 | ssim_sum := 0; 215 | for y := 0 to ImgHeigth-1 do 216 | begin 217 | offset := y * ImgWidth; 218 | for x := 0 to ImgWidth-1 DO 219 | begin 220 | if NOT args.CustomParams then 221 | begin 222 | // The default case 223 | numerator := (2.0 * ref_mu[offset] * cmp_mu[offset] + C1) * (2.0 * sigma_both[offset] + C2); 224 | denominator := (ref_mu[offset] * ref_mu[offset] + cmp_mu[offset] * cmp_mu[offset] + C1) * (ref_sigma_sqd[offset] + cmp_sigma_sqd[offset] + C2); 225 | ssim_sum := ssim_sum + (numerator / denominator); 226 | end 227 | else 228 | begin 229 | // User defined alpha, beta, or gamma 230 | 231 | // Prevent passing negative numbers to sqrt 232 | if ref_sigma_sqd[offset] < 0 233 | then ref_sigma_sqd[offset] := 0; 234 | if cmp_sigma_sqd[offset] < 0 235 | then cmp_sigma_sqd[offset] := 0; 236 | 237 | sigma_root := sqrt(ref_sigma_sqd[offset] * cmp_sigma_sqd[offset]); 238 | 239 | // Hold intermediate SSIM values for map-reduce operation 240 | luminance_comp := computeluminance(ref_mu[offset], cmp_mu[offset], C1, args.alpha); 241 | contrast_comp := computecontrast (sigma_root, ref_sigma_sqd[offset], cmp_sigma_sqd[offset], C2, args.beta); 242 | structure_comp := computestructure(sigma_both[offset], sigma_root, ref_sigma_sqd[offset], cmp_sigma_sqd[offset], C3, args.gamma); 243 | 244 | // Holds intermediate SSIM values for map-reduce operation. 245 | ssim_sum := ssim_sum + luminance_comp * contrast_comp * structure_comp; 246 | end; 247 | 248 | Inc(offset); 249 | end; 250 | end; 251 | 252 | Result := ssim_sum / (ImgWidth * ImgHeigth); // mr->reduce(w, h, mr->context); 253 | end; 254 | 255 | 256 | 257 | 258 | 259 | { Calculates the Structural SIMilarity between 2 equal-sized 8-bit images. 260 | Params: 261 | ref Original reference image 262 | cmp Distorted image 263 | ImgWidth Width of the images 264 | ImgHeigth Height of the images 265 | stride The length (in bytes) of each horizontal line in the image. 266 | This may be different from the image width. 267 | gaussian 0 = 8x8 square window, 268 | 1 = 11x11 circular-symmetric Gaussian weighting. 269 | args Optional SSIM arguments for fine control of the algorithm. 0 for defaults. 270 | Defaults are: a=b=g=1, L=255, K1=0.01, K2=0.03 271 | 272 | return: The mean SSIM over the entire image (MSSIM), or INFINITY if error. 273 | note: The images must have the same width, height, and stride. } 274 | 275 | function SsimCompare(refBMP, cmpBMP: TBitmap; WndType: TKernelWndType): Single; 276 | CONST 277 | Components = 1; 278 | VAR 279 | ref, cmp: ByteImage; 280 | Stride: integer; 281 | args: TSsimArgs; 282 | begin 283 | { Convert pixels to gray and transfer them from a TBitmap to a unidimensional array (of size Width*Height) } 284 | ref:= TransferPixels(refBMP); 285 | cmp:= TransferPixels(cmpBMP); 286 | stride:= GetStride(refBMP); //del: refBMP.Width * Components; 287 | 288 | args.Init; 289 | args.ScaleFactor := sfAuto; 290 | 291 | Result:= SsimCompare(ref, cmp, refBMP.Width, refBMP.Height, Stride, WndType, args); 292 | end; 293 | 294 | 295 | function SsimCompare(refBMP, cmp: ByteImage; ImgWidth, ImgHeigth, stride: Integer; KernelWndType: TKernelWndType; args: TSsimArgs): single; 296 | VAR 297 | scale, offset: integer; 298 | x, y : integer; 299 | src_offset : Integer; 300 | ref_f, cmp_f : RealImage; 301 | low_pass : TKernelAttrib; 302 | window : TKernelAttrib; 303 | dummy, SqrScale : Integer; 304 | begin 305 | // Initialization 306 | case args.ScaleFactor of 307 | sfNone: scale := 1; 308 | sfAuto: scale := max(1, roundEx(min(ImgWidth, ImgHeigth) / 256)); 309 | else 310 | RAISE Exception.Create('Invalid scale factor!'); 311 | end; 312 | 313 | //if args.CustomParams then mr.context := ssim_sum; 314 | window.normalized := TRUE; 315 | window.bnd_opt := KBND_SYMMETRIC; 316 | SetKernelWindow(window, KernelWndType); 317 | 318 | // Convert image pixels to floats. We force stride = width. 319 | SetLength(ref_f, ImgWidth * ImgHeigth); 320 | SetLength(cmp_f, ImgWidth * ImgHeigth); 321 | 322 | for y := 0 to ImgHeigth-1 do 323 | begin 324 | src_offset := y * stride; 325 | offset := y * ImgWidth; 326 | for x := 0 to ImgWidth-1 DO 327 | begin 328 | ref_f[offset] := refBMP[src_offset]; // Range check error HERE 329 | cmp_f[offset] := cmp[src_offset]; 330 | Inc(offset); 331 | Inc(src_offset); 332 | end; 333 | end; 334 | 335 | { Scale the images down IF required } 336 | if scale > 1 then 337 | begin 338 | // Generate simple low-pass filter 339 | SetLength(low_pass.KernelW, scale * scale); 340 | low_pass.width := scale; 341 | low_pass.Height := scale; 342 | low_pass.normalized := FALSE; 343 | low_pass.bnd_opt := KBND_SYMMETRIC; 344 | 345 | SqrScale:= scale * scale; 346 | for offset := 0 to SqrScale-1 347 | DO low_pass.KernelW[offset] := 1 / SqrScale; 348 | 349 | // Resample both images. Takes too long without this 350 | DecimateImage(ref_f, ImgWidth, ImgHeigth, scale, low_pass, NIL, dummy, dummy); 351 | DecimateImage(cmp_f, ImgWidth, ImgHeigth, scale, low_pass, NIL, ImgWidth, ImgHeigth); 352 | end; 353 | 354 | result := _ssim(ref_f, cmp_f, ImgWidth, ImgHeigth, window, args); 355 | end; 356 | 357 | 358 | 359 | 360 | 361 | {function ssimReduce(w, h: integer; ctx: Single): Single; 362 | begin 363 | Result := ctx / (w*h); 364 | end;} 365 | 366 | 367 | end. 368 | 369 | 370 | --------------------------------------------------------------------------------