GR32_Blurs.pas 64 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103
  1. unit GR32_Blurs;
  2. (* BEGIN LICENSE BLOCK *********************************************************
  3. * Version: MPL 1.1 *
  4. * *
  5. * The contents of this file are subject to the Mozilla Public License Version *
  6. * 1.1 (the "License"); you may not use this file except in compliance with *
  7. * the License. You may obtain a copy of the License at *
  8. * http://www.mozilla.org/MPL/ *
  9. * *
  10. * Software distributed under the License is distributed on an "AS IS" basis, *
  11. * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *
  12. * for the specific language governing rights and limitations under the *
  13. * License. *
  14. * *
  15. * Alternatively, the contents of this file may be used under the terms of the *
  16. * Free Pascal modified version of the GNU Lesser General Public License *
  17. * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions *
  18. * of this license are applicable instead of those above. *
  19. * Please see the file LICENSE.txt for additional information concerning this *
  20. * license. *
  21. * *
  22. * The Original Code is GR32_Blurs. The Gaussian blur algorithm was inspired *
  23. * by code published by Mario Klingemann and has been used with his permission. *
  24. * See also http://incubator.quasimondo.com *
  25. * *
  26. * Copyright 2012 - Angus Johnson *
  27. * *
  28. * Version 5.0 (Last updated 25-Sep-2012) *
  29. * *
  30. * END LICENSE BLOCK ***********************************************************)
  31. interface
  32. {$I GR32.inc}
  33. uses
  34. {$IFDEF FPC}
  35. LCLIntf,
  36. {$ELSE}
  37. Windows, Types,
  38. {$ENDIF}
  39. SysUtils, Classes, Math, GR32;
  40. type
  41. TBlurFunction = procedure(Bitmap32: TBitmap32; Radius: TFloat);
  42. TBlurFunctionBounds = procedure(Bitmap32: TBitmap32; Radius: TFloat;
  43. const Bounds: TRect);
  44. TBlurFunctionRegion = procedure(Bitmap32: TBitmap32; Radius: TFloat;
  45. const BlurRegion: TArrayOfFloatPoint);
  46. procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat); overload;
  47. procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect); overload;
  48. procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat;
  49. const BlurRegion: TArrayOfFloatPoint); overload;
  50. procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat); overload;
  51. procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect); overload;
  52. procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat;
  53. const BlurRegion: TArrayOfFloatPoint); overload;
  54. procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat); overload;
  55. procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect); overload;
  56. procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat;
  57. const BlurRegion: TArrayOfFloatPoint); overload;
  58. procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat); overload;
  59. procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect); overload;
  60. procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat;
  61. const BlurRegion: TArrayOfFloatPoint); overload;
  62. procedure MotionBlur(Bitmap32: TBitmap32;
  63. Dist, AngleDeg: TFloat; Bidirectional: Boolean = True); overload;
  64. procedure MotionBlur(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
  65. const Bounds: TRect; Bidirectional: Boolean = True); overload;
  66. procedure MotionBlur(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
  67. const BlurRegion: TArrayOfFloatPoint; Bidirectional: Boolean = True); overload;
  68. procedure MotionBlurGamma(Bitmap32: TBitmap32;
  69. Dist, AngleDeg: TFloat; Bidirectional: Boolean = True); overload;
  70. procedure MotionBlurGamma(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
  71. const Bounds: TRect; Bidirectional: Boolean = True); overload;
  72. procedure MotionBlurGamma(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
  73. const BlurRegion: TArrayOfFloatPoint; Bidirectional: Boolean = True); overload;
  74. const
  75. GaussianBlurSimple: array [Boolean] of TBlurFunction = (GaussianBlur, GaussianBlurGamma);
  76. GaussianBlurBounds: array [Boolean] of TBlurFunctionBounds = (GaussianBlur, GaussianBlurGamma);
  77. GaussianBlurRegion: array [Boolean] of TBlurFunctionRegion = (GaussianBlur, GaussianBlurGamma);
  78. FastBlurSimple: array [Boolean] of TBlurFunction = (FastBlur, FastBlurGamma);
  79. FastBlurBounds: array [Boolean] of TBlurFunctionBounds = (FastBlur, FastBlurGamma);
  80. FastBlurRegion: array [Boolean] of TBlurFunctionRegion = (FastBlur, FastBlurGamma);
  81. implementation
  82. uses
  83. GR32_Blend, GR32_Gamma, GR32_Resamplers, GR32_Polygons, GR32_LowLevel,
  84. GR32_VectorUtils, GR32_Transforms;
  85. type
  86. TSumRecInt64 = record
  87. B, G, R, A: Int64;
  88. Sum: Integer;
  89. end;
  90. TSumRecord = record
  91. B, G, R, A: Integer;
  92. Sum: Integer;
  93. end;
  94. const
  95. ChannelSize = 256; // ie 1 byte for each of A,R,G & B in TColor32
  96. ChannelSizeMin1 = ChannelSize - 1;
  97. procedure ResetSumRecord(var SumRecord: TSumRecInt64); overload;
  98. {$IFDEF USEINLINING} inline; {$ENDIF}
  99. begin
  100. FillChar(SumRecord, SizeOf(SumRecord), 0);
  101. end;
  102. procedure ResetSumRecord(var SumRecord: TSumRecord); overload;
  103. {$IFDEF USEINLINING} inline; {$ENDIF}
  104. begin
  105. FillChar(SumRecord, SizeOf(SumRecord), 0);
  106. end;
  107. function Divide(SumRecord: TSumRecInt64): TSumRecInt64; overload;
  108. {$IFDEF USEINLINING} inline; {$ENDIF}
  109. begin
  110. Result.A := SumRecord.A div SumRecord.Sum;
  111. Result.R := SumRecord.R div SumRecord.Sum;
  112. Result.G := SumRecord.G div SumRecord.Sum;
  113. Result.B := SumRecord.B div SumRecord.Sum;
  114. end;
  115. function Divide(SumRecord: TSumRecord): TSumRecord; overload;
  116. {$IFDEF USEINLINING} inline; {$ENDIF}
  117. begin
  118. Result.A := SumRecord.A div SumRecord.Sum;
  119. Result.R := SumRecord.R div SumRecord.Sum;
  120. Result.G := SumRecord.G div SumRecord.Sum;
  121. Result.B := SumRecord.B div SumRecord.Sum;
  122. end;
  123. function DivideToColor32(SumRecord: TSumRecInt64): TColor32Entry; overload;
  124. {$IFDEF USEINLINING} inline; {$ENDIF}
  125. begin
  126. Result.A := SumRecord.A div SumRecord.Sum;
  127. Result.R := SumRecord.R div SumRecord.Sum;
  128. Result.G := SumRecord.G div SumRecord.Sum;
  129. Result.B := SumRecord.B div SumRecord.Sum;
  130. end;
  131. function DivideToColor32(SumRecord: TSumRecord): TColor32Entry; overload;
  132. {$IFDEF USEINLINING} inline; {$ENDIF}
  133. begin
  134. Result.A := SumRecord.A div SumRecord.Sum;
  135. Result.R := SumRecord.R div SumRecord.Sum;
  136. Result.G := SumRecord.G div SumRecord.Sum;
  137. Result.B := SumRecord.B div SumRecord.Sum;
  138. end;
  139. { GaussianBlur }
  140. {$R-}
  141. procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat);
  142. begin
  143. GaussianBlur(Bitmap32, Radius, Bitmap32.BoundsRect);
  144. end;
  145. procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect);
  146. var
  147. Q, I, J, X, Y, ImageWidth, RowOffset, RadiusI: Integer;
  148. RecLeft, RecTop, RecRight, RecBottom: Integer;
  149. ImagePixels: PColor32EntryArray;
  150. RadiusSq, RadiusRevSq, KernelSize: Integer;
  151. SumRec: TSumRecInt64;
  152. PreMulArray: array of TColor32Entry;
  153. SumArray: array of TSumRecInt64;
  154. GaussLUT: array of array of Cardinal;
  155. begin
  156. RadiusI := Round(Radius);
  157. if RadiusI < 1 then
  158. Exit
  159. else if RadiusI > 128 then
  160. RadiusI := 128; // nb: performance degrades exponentially with >> Radius
  161. // initialize the look-up-table ...
  162. KernelSize := RadiusI * 2 + 1;
  163. SetLength(GaussLUT, KernelSize);
  164. for I := 0 to KernelSize - 1 do
  165. SetLength(GaussLUT[I], ChannelSize);
  166. for I := 1 to RadiusI do
  167. begin
  168. RadiusRevSq := Round((Radius + 1 - I) * (Radius + 1 - I));
  169. for J := 0 to ChannelSizeMin1 do
  170. begin
  171. GaussLUT[RadiusI - I][J] := RadiusRevSq * J;
  172. GaussLUT[RadiusI + I][J] := GaussLUT[RadiusI - I][J];
  173. end;
  174. end;
  175. RadiusSq := Round((Radius + 1) * (Radius + 1));
  176. for J := 0 to ChannelSizeMin1 do
  177. GaussLUT[RadiusI][J] := RadiusSq * J;
  178. ImageWidth := Bitmap32.Width;
  179. SetLength(SumArray, ImageWidth * Bitmap32.Height);
  180. ImagePixels := PColor32EntryArray(Bitmap32.Bits);
  181. RecLeft := Max(Bounds.Left, 0);
  182. RecTop := Max(Bounds.Top, 0);
  183. RecRight := Min(Bounds.Right, ImageWidth - 1);
  184. RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
  185. RowOffset := RecTop * ImageWidth;
  186. SetLength(PreMulArray, Bitmap32.Width);
  187. for Y := RecTop to RecBottom do
  188. begin
  189. // initialize PreMulArray for the row ...
  190. Q := (Y * ImageWidth) + RecLeft;
  191. for X := RecLeft to RecRight do
  192. with ImagePixels[Q] do
  193. begin
  194. PreMulArray[X].A := A;
  195. PreMulArray[X].R := DivTable[R, A];
  196. PreMulArray[X].G := DivTable[G, A];
  197. PreMulArray[X].B := DivTable[B, A];
  198. Inc(Q);
  199. end;
  200. for X := RecLeft to RecRight do
  201. begin
  202. ResetSumRecord(SumRec);
  203. I := Max(X - RadiusI, RecLeft);
  204. Q := I - (X - RadiusI);
  205. for I := I to Min(X + RadiusI, RecRight) do
  206. with PreMulArray[I] do
  207. begin
  208. Inc(SumRec.A, GaussLUT[Q][A]);
  209. Inc(SumRec.R, GaussLUT[Q][R]);
  210. Inc(SumRec.G, GaussLUT[Q][G]);
  211. Inc(SumRec.B, GaussLUT[Q][B]);
  212. Inc(SumRec.Sum, GaussLUT[Q][1]);
  213. Inc(Q);
  214. end;
  215. Q := RowOffset + X;
  216. SumArray[Q] := Divide(SumRec);
  217. end;
  218. Inc(RowOffset, ImageWidth);
  219. end;
  220. RowOffset := RecTop * ImageWidth;
  221. for Y := RecTop to RecBottom do
  222. begin
  223. for X := RecLeft to RecRight do
  224. begin
  225. ResetSumRecord(SumRec);
  226. I := Max(Y - RadiusI, RecTop);
  227. Q := I - (Y - RadiusI);
  228. for I := I to Min(Y + RadiusI, RecBottom) do
  229. with SumArray[X + I * ImageWidth] do
  230. begin
  231. Inc(SumRec.A, GaussLUT[Q][A]);
  232. Inc(SumRec.R, GaussLUT[Q][R]);
  233. Inc(SumRec.G, GaussLUT[Q][G]);
  234. Inc(SumRec.B, GaussLUT[Q][B]);
  235. Inc(SumRec.Sum, GaussLUT[Q][1]);
  236. Inc(Q);
  237. end;
  238. with ImagePixels[RowOffset + X] do
  239. begin
  240. A := (SumRec.A div SumRec.Sum);
  241. R := RcTable[A, (SumRec.R div SumRec.Sum)];
  242. G := RcTable[A, (SumRec.G div SumRec.Sum)];
  243. B := RcTable[A, (SumRec.B div SumRec.Sum)];
  244. end;
  245. end;
  246. Inc(RowOffset, ImageWidth);
  247. end;
  248. end;
  249. procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat;
  250. const BlurRegion: TArrayOfFloatPoint);
  251. var
  252. Q, I, J, X, Y, ImageWidth, RowOffset, RadiusI: Integer;
  253. RecLeft, RecTop, RecRight, RecBottom: Integer;
  254. ImagePixels: PColor32EntryArray;
  255. RadiusSq, RadiusRevSq, KernelSize: Integer;
  256. SumRec: TSumRecInt64;
  257. SumArray: array of TSumRecInt64;
  258. GaussLUT: array of array of Cardinal;
  259. PreMulArray: array of TColor32Entry;
  260. Alpha: Cardinal;
  261. Mask: TBitmap32;
  262. Clr, MaskClr: TColor32Entry;
  263. Pts: TArrayOfFloatPoint;
  264. Bounds: TRect;
  265. begin
  266. with PolygonBounds(BlurRegion) do
  267. Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
  268. if Bounds.Left < 0 then Bounds.Left := 0;
  269. if Bounds.Top < 0 then Bounds.Top := 0;
  270. if Bounds.Right >= Bitmap32.Width then Bounds.Right := Bitmap32.Width - 1;
  271. if Bounds.Bottom >= Bitmap32.Height then Bounds.Bottom := Bitmap32.Height - 1;
  272. RadiusI := round(Radius);
  273. if (RadiusI < 1) or (Bounds.Right <= Bounds.Left) or (Bounds.Bottom <= Bounds.Top) then
  274. Exit
  275. else if RadiusI > 128 then
  276. RadiusI := 128; // nb: performance degrades exponentially with >> Radius
  277. Mask := TBitmap32.Create;
  278. try
  279. Mask.SetSize(Bounds.Right - Bounds.Left + 1, Bounds.Bottom - Bounds.Top + 1);
  280. SetLength(Pts, Length(BlurRegion));
  281. for I := 0 to High(BlurRegion) do
  282. begin
  283. Pts[I].X := BlurRegion[I].X - Bounds.Left;
  284. Pts[I].Y := BlurRegion[I].Y - Bounds.Top;
  285. end;
  286. PolygonFS(Mask, Pts, clWhite32);
  287. // initialize the look-up-table ...
  288. KernelSize := RadiusI * 2 + 1;
  289. SetLength(GaussLUT, KernelSize);
  290. for I := 0 to KernelSize - 1 do
  291. SetLength(GaussLUT[I], ChannelSize);
  292. for I := 1 to RadiusI do
  293. begin
  294. RadiusRevSq := Round((Radius + 1 - I) * (Radius + 1 - I));
  295. for J := 0 to ChannelSizeMin1 do
  296. begin
  297. GaussLUT[RadiusI - I][J] := RadiusRevSq * J;
  298. GaussLUT[RadiusI + I][J] := GaussLUT[RadiusI - I][J];
  299. end;
  300. end;
  301. RadiusSq := Round((Radius + 1) * (Radius + 1));
  302. for J := 0 to ChannelSizeMin1 do
  303. GaussLUT[RadiusI][J] := RadiusSq * J;
  304. ImageWidth := Bitmap32.Width;
  305. SetLength(SumArray, ImageWidth * Bitmap32.Height);
  306. ImagePixels := PColor32EntryArray(Bitmap32.Bits);
  307. RecLeft := Max(Bounds.Left, 0);
  308. RecTop := Max(Bounds.Top, 0);
  309. RecRight := Min(Bounds.Right, ImageWidth - 1);
  310. RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
  311. RowOffset := RecTop * ImageWidth;
  312. SetLength(PreMulArray, Bitmap32.Width);
  313. for Y := RecTop to RecBottom do
  314. begin
  315. // initialize PreMulArray for the current row ...
  316. Q := (Y * ImageWidth) + RecLeft;
  317. for X := RecLeft to RecRight do
  318. with ImagePixels[Q] do
  319. begin
  320. PreMulArray[X].A := A;
  321. PreMulArray[X].R := DivTable[R, A];
  322. PreMulArray[X].G := DivTable[G, A];
  323. PreMulArray[X].B := DivTable[B, A];
  324. Inc(Q);
  325. end;
  326. for X := RecLeft to RecRight do
  327. begin
  328. ResetSumRecord(SumRec);
  329. I := Max(X - RadiusI, RecLeft);
  330. Q := I - (X - RadiusI);
  331. for I := I to Min(X + RadiusI, RecRight) do
  332. with PreMulArray[I] do
  333. begin
  334. Inc(SumRec.A, GaussLUT[Q][A]);
  335. Inc(SumRec.R, GaussLUT[Q][R]);
  336. Inc(SumRec.G, GaussLUT[Q][G]);
  337. Inc(SumRec.B, GaussLUT[Q][B]);
  338. Inc(SumRec.Sum, GaussLUT[Q][1]);
  339. Inc(Q);
  340. end;
  341. Q := RowOffset + X;
  342. SumArray[Q] := Divide(SumRec);
  343. end;
  344. Inc(RowOffset, ImageWidth);
  345. end;
  346. RowOffset := RecTop * ImageWidth;
  347. for Y := RecTop to RecBottom do
  348. begin
  349. for X := RecLeft to RecRight do
  350. begin
  351. MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
  352. if (MaskClr.A = 0) then Continue;
  353. ResetSumRecord(SumRec);
  354. I := Max(Y - RadiusI, RecTop);
  355. Q := I - (Y - RadiusI);
  356. for I := I to Min(Y + RadiusI, RecBottom) do
  357. with SumArray[X + I * ImageWidth] do
  358. begin
  359. Inc(SumRec.A, GaussLUT[Q][A]);
  360. Inc(SumRec.R, GaussLUT[Q][R]);
  361. Inc(SumRec.G, GaussLUT[Q][G]);
  362. Inc(SumRec.B, GaussLUT[Q][B]);
  363. Inc(SumRec.Sum, GaussLUT[Q][1]);
  364. Inc(Q);
  365. end;
  366. with ImagePixels[RowOffset + X] do
  367. if (MaskClr.A < 255) then
  368. begin
  369. Clr.A := SumRec.A div SumRec.Sum;
  370. Clr.R := RcTable[Clr.A, SumRec.R div SumRec.Sum];
  371. Clr.G := RcTable[Clr.A, SumRec.G div SumRec.Sum];
  372. Clr.B := RcTable[Clr.A, SumRec.B div SumRec.Sum];
  373. BlendMemEx(Clr.ARGB, ARGB, MaskClr.A);
  374. end else
  375. begin
  376. A := SumRec.A div SumRec.Sum;
  377. R := RcTable[A, SumRec.R div SumRec.Sum];
  378. G := RcTable[A, SumRec.G div SumRec.Sum];
  379. B := RcTable[A, SumRec.B div SumRec.Sum];
  380. end;
  381. end;
  382. Inc(RowOffset, ImageWidth);
  383. end;
  384. EMMS;
  385. finally
  386. Mask.Free;
  387. end;
  388. end;
  389. procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat);
  390. begin
  391. GaussianBlurGamma(Bitmap32, Radius, Bitmap32.BoundsRect);
  392. end;
  393. procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect);
  394. var
  395. Q, I, J, X, Y, ImageWidth, RowOffset, RadiusI: Integer;
  396. RecLeft, RecTop, RecRight, RecBottom: Integer;
  397. ImagePixels: PColor32EntryArray;
  398. RadiusSq, RadiusRevSq, KernelSize: Integer;
  399. SumRec: TSumRecInt64;
  400. PreMulArray: array of TColor32Entry;
  401. SumArray: array of TSumRecInt64;
  402. GaussLUT: array of array of Cardinal;
  403. begin
  404. RadiusI := Round(Radius);
  405. if RadiusI < 1 then
  406. Exit
  407. else if RadiusI > 128 then
  408. RadiusI := 128; // nb: performance degrades exponentially with >> Radius
  409. // initialize the look-up-table ...
  410. KernelSize := RadiusI * 2 + 1;
  411. SetLength(GaussLUT, KernelSize);
  412. for I := 0 to KernelSize - 1 do
  413. SetLength(GaussLUT[I], ChannelSize);
  414. for I := 1 to RadiusI do
  415. begin
  416. RadiusRevSq := Round((Radius + 1 - I) * (Radius + 1 - I));
  417. for J := 0 to ChannelSizeMin1 do
  418. begin
  419. GaussLUT[RadiusI - I][J] := RadiusRevSq * J;
  420. GaussLUT[RadiusI + I][J] := GaussLUT[RadiusI - I][J];
  421. end;
  422. end;
  423. RadiusSq := Round((Radius + 1) * (Radius + 1));
  424. for J := 0 to ChannelSizeMin1 do
  425. GaussLUT[RadiusI][J] := RadiusSq * J;
  426. ImageWidth := Bitmap32.Width;
  427. SetLength(SumArray, ImageWidth * Bitmap32.Height);
  428. ImagePixels := PColor32EntryArray(Bitmap32.Bits);
  429. RecLeft := Max(Bounds.Left, 0);
  430. RecTop := Max(Bounds.Top, 0);
  431. RecRight := Min(Bounds.Right, ImageWidth - 1);
  432. RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
  433. RowOffset := RecTop * ImageWidth;
  434. SetLength(PreMulArray, Bitmap32.Width);
  435. for Y := RecTop to RecBottom do
  436. begin
  437. // initialize PreMulArray for the row ...
  438. Q := (Y * ImageWidth) + RecLeft;
  439. for X := RecLeft to RecRight do
  440. with ImagePixels[Q] do
  441. begin
  442. PreMulArray[X].A := A;
  443. PreMulArray[X].R := DivTable[GAMMA_DECODING_TABLE[R], A];
  444. PreMulArray[X].G := DivTable[GAMMA_DECODING_TABLE[G], A];
  445. PreMulArray[X].B := DivTable[GAMMA_DECODING_TABLE[B], A];
  446. Inc(Q);
  447. end;
  448. for X := RecLeft to RecRight do
  449. begin
  450. ResetSumRecord(SumRec);
  451. I := Max(X - RadiusI, RecLeft);
  452. Q := I - (X - RadiusI);
  453. for I := I to Min(X + RadiusI, RecRight) do
  454. with PreMulArray[I] do
  455. begin
  456. Inc(SumRec.A, GaussLUT[Q][A]);
  457. Inc(SumRec.R, GaussLUT[Q][R]);
  458. Inc(SumRec.G, GaussLUT[Q][G]);
  459. Inc(SumRec.B, GaussLUT[Q][B]);
  460. Inc(SumRec.Sum, GaussLUT[Q][1]);
  461. Inc(Q);
  462. end;
  463. Q := RowOffset + X;
  464. SumArray[Q] := Divide(SumRec);
  465. end;
  466. Inc(RowOffset, ImageWidth);
  467. end;
  468. RowOffset := RecTop * ImageWidth;
  469. for Y := RecTop to RecBottom do
  470. begin
  471. for X := RecLeft to RecRight do
  472. begin
  473. ResetSumRecord(SumRec);
  474. I := Max(Y - RadiusI, RecTop);
  475. Q := I - (Y - RadiusI);
  476. for I := I to Min(Y + RadiusI, RecBottom) do
  477. with SumArray[X + I * ImageWidth] do
  478. begin
  479. Inc(SumRec.A, GaussLUT[Q][A]);
  480. Inc(SumRec.R, GaussLUT[Q][R]);
  481. Inc(SumRec.G, GaussLUT[Q][G]);
  482. Inc(SumRec.B, GaussLUT[Q][B]);
  483. Inc(SumRec.Sum, GaussLUT[Q][1]);
  484. Inc(Q);
  485. end;
  486. with ImagePixels[RowOffset + X] do
  487. begin
  488. A := (SumRec.A div SumRec.Sum);
  489. R := GAMMA_ENCODING_TABLE[RcTable[A, (SumRec.R div SumRec.Sum)]];
  490. G := GAMMA_ENCODING_TABLE[RcTable[A, (SumRec.G div SumRec.Sum)]];
  491. B := GAMMA_ENCODING_TABLE[RcTable[A, (SumRec.B div SumRec.Sum)]];
  492. end;
  493. end;
  494. Inc(RowOffset, ImageWidth);
  495. end;
  496. end;
  497. procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat;
  498. const BlurRegion: TArrayOfFloatPoint);
  499. var
  500. Q, I, J, X, Y, ImageWidth, RowOffset, RadiusI: Integer;
  501. RecLeft, RecTop, RecRight, RecBottom: Integer;
  502. ImagePixels: PColor32EntryArray;
  503. RadiusSq, RadiusRevSq, KernelSize: Integer;
  504. SumRec: TSumRecInt64;
  505. SumArray: array of TSumRecInt64;
  506. GaussLUT: array of array of Cardinal;
  507. PreMulArray: array of TColor32Entry;
  508. Alpha: Cardinal;
  509. Mask: TBitmap32;
  510. Clr, MaskClr: TColor32Entry;
  511. Pts: TArrayOfFloatPoint;
  512. Bounds: TRect;
  513. begin
  514. with PolygonBounds(BlurRegion) do
  515. Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
  516. if Bounds.Left < 0 then Bounds.Left := 0;
  517. if Bounds.Top < 0 then Bounds.Top := 0;
  518. if Bounds.Right >= Bitmap32.Width then Bounds.Right := Bitmap32.Width - 1;
  519. if Bounds.Bottom >= Bitmap32.Height then Bounds.Bottom := Bitmap32.Height - 1;
  520. RadiusI := round(Radius);
  521. if (RadiusI < 1) or (Bounds.Right <= Bounds.Left) or (Bounds.Bottom <= Bounds.Top) then
  522. Exit
  523. else if RadiusI > 128 then
  524. RadiusI := 128; // nb: performance degrades exponentially with >> Radius
  525. Mask := TBitmap32.Create;
  526. try
  527. Mask.SetSize(Bounds.Right - Bounds.Left + 1, Bounds.Bottom - Bounds.Top + 1);
  528. SetLength(Pts, Length(BlurRegion));
  529. for I := 0 to High(BlurRegion) do
  530. begin
  531. Pts[I].X := BlurRegion[I].X - Bounds.Left;
  532. Pts[I].Y := BlurRegion[I].Y - Bounds.Top;
  533. end;
  534. PolygonFS(Mask, Pts, clWhite32);
  535. // initialize the look-up-table ...
  536. KernelSize := RadiusI * 2 + 1;
  537. SetLength(GaussLUT, KernelSize);
  538. for I := 0 to KernelSize - 1 do
  539. SetLength(GaussLUT[I], ChannelSize);
  540. for I := 1 to RadiusI do
  541. begin
  542. RadiusRevSq := Round((Radius + 1 - I) * (Radius + 1 - I));
  543. for J := 0 to ChannelSizeMin1 do
  544. begin
  545. GaussLUT[RadiusI - I][J] := RadiusRevSq * J;
  546. GaussLUT[RadiusI + I][J] := GaussLUT[RadiusI - I][J];
  547. end;
  548. end;
  549. RadiusSq := Round((Radius + 1) * (Radius + 1));
  550. for J := 0 to ChannelSizeMin1 do
  551. GaussLUT[RadiusI][J] := RadiusSq * J;
  552. ImageWidth := Bitmap32.Width;
  553. SetLength(SumArray, ImageWidth * Bitmap32.Height);
  554. ImagePixels := PColor32EntryArray(Bitmap32.Bits);
  555. RecLeft := Max(Bounds.Left, 0);
  556. RecTop := Max(Bounds.Top, 0);
  557. RecRight := Min(Bounds.Right, ImageWidth - 1);
  558. RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
  559. RowOffset := RecTop * ImageWidth;
  560. SetLength(PreMulArray, Bitmap32.Width);
  561. for Y := RecTop to RecBottom do
  562. begin
  563. // initialize PreMulArray for the current row ...
  564. Q := (Y * ImageWidth) + RecLeft;
  565. for X := RecLeft to RecRight do
  566. with ImagePixels[Q] do
  567. begin
  568. PreMulArray[X].A := A;
  569. PreMulArray[X].R := DivTable[GAMMA_DECODING_TABLE[R], A];
  570. PreMulArray[X].G := DivTable[GAMMA_DECODING_TABLE[G], A];
  571. PreMulArray[X].B := DivTable[GAMMA_DECODING_TABLE[B], A];
  572. Inc(Q);
  573. end;
  574. for X := RecLeft to RecRight do
  575. begin
  576. ResetSumRecord(SumRec);
  577. I := Max(X - RadiusI, RecLeft);
  578. Q := I - (X - RadiusI);
  579. for I := I to Min(X + RadiusI, RecRight) do
  580. with PreMulArray[I] do
  581. begin
  582. Inc(SumRec.A, GaussLUT[Q][A]);
  583. Inc(SumRec.R, GaussLUT[Q][R]);
  584. Inc(SumRec.G, GaussLUT[Q][G]);
  585. Inc(SumRec.B, GaussLUT[Q][B]);
  586. Inc(SumRec.Sum, GaussLUT[Q][1]);
  587. Inc(Q);
  588. end;
  589. Q := RowOffset + X;
  590. SumArray[Q] := Divide(SumRec);
  591. end;
  592. Inc(RowOffset, ImageWidth);
  593. end;
  594. RowOffset := RecTop * ImageWidth;
  595. for Y := RecTop to RecBottom do
  596. begin
  597. for X := RecLeft to RecRight do
  598. begin
  599. MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
  600. if (MaskClr.A = 0) then Continue;
  601. ResetSumRecord(SumRec);
  602. I := Max(Y - RadiusI, RecTop);
  603. Q := I - (Y - RadiusI);
  604. for I := I to Min(Y + RadiusI, RecBottom) do
  605. with SumArray[X + I * ImageWidth] do
  606. begin
  607. Inc(SumRec.A, GaussLUT[Q][A]);
  608. Inc(SumRec.R, GaussLUT[Q][R]);
  609. Inc(SumRec.G, GaussLUT[Q][G]);
  610. Inc(SumRec.B, GaussLUT[Q][B]);
  611. Inc(SumRec.Sum, GaussLUT[Q][1]);
  612. Inc(Q);
  613. end;
  614. with ImagePixels[RowOffset + X] do
  615. if (MaskClr.A < 255) then
  616. begin
  617. Clr.A := SumRec.A div SumRec.Sum;
  618. Clr.R := GAMMA_ENCODING_TABLE[RcTable[Clr.A, SumRec.R div SumRec.Sum]];
  619. Clr.G := GAMMA_ENCODING_TABLE[RcTable[Clr.A, SumRec.G div SumRec.Sum]];
  620. Clr.B := GAMMA_ENCODING_TABLE[RcTable[Clr.A, SumRec.B div SumRec.Sum]];
  621. BlendMemEx(Clr.ARGB, ARGB, MaskClr.A);
  622. end else
  623. begin
  624. A := SumRec.A div SumRec.Sum;
  625. R := GAMMA_ENCODING_TABLE[RcTable[A, SumRec.R div SumRec.Sum]];
  626. G := GAMMA_ENCODING_TABLE[RcTable[A, SumRec.G div SumRec.Sum]];
  627. B := GAMMA_ENCODING_TABLE[RcTable[A, SumRec.B div SumRec.Sum]];
  628. end;
  629. end;
  630. Inc(RowOffset, ImageWidth);
  631. end;
  632. EMMS;
  633. finally
  634. Mask.Free;
  635. end;
  636. end;
  637. { FastBlur }
  638. procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat);
  639. begin
  640. FastBlur(Bitmap32, Radius, Bitmap32.BoundsRect);
  641. end;
  642. procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect);
  643. var
  644. LL, RR, TT, BB, XX, YY, I, J, X, Y, RadiusI, Passes: Integer;
  645. RecLeft, RecTop, RecRight, RecBottom: Integer;
  646. ImagePixel: PColor32Entry;
  647. SumRec: TSumRecord;
  648. ImgPixel: PColor32Entry;
  649. Pixels: array of TColor32Entry;
  650. begin
  651. if Radius < 1 then
  652. Exit
  653. else if Radius > 256 then
  654. Radius := 256;
  655. RadiusI := Round(Radius / Sqrt(-2 * Ln(COne255th)));
  656. if RadiusI < 2 then
  657. begin
  658. Passes := Round(Radius);
  659. RadiusI := 1;
  660. end else
  661. Passes := 3;
  662. RecLeft := Max(Bounds.Left, 0);
  663. RecTop := Max(Bounds.Top, 0);
  664. RecRight := Min(Bounds.Right, Bitmap32.Width - 1);
  665. RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
  666. SetLength(Pixels, Max(Bitmap32.Width, Bitmap32.Height) + 1);
  667. // pre-multiply alphas ...
  668. for Y := RecTop to RecBottom do
  669. begin
  670. ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
  671. Inc(ImgPixel, RecLeft);
  672. for X := RecLeft to RecRight do
  673. with ImgPixel^ do
  674. begin
  675. R := DivTable[R, A];
  676. G := DivTable[G, A];
  677. B := DivTable[B, A];
  678. Inc(ImgPixel);
  679. end;
  680. end;
  681. for I := 1 to Passes do
  682. begin
  683. // horizontal pass...
  684. for Y := RecTop to RecBottom do
  685. begin
  686. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
  687. // fill the Pixels buffer with a copy of the row's pixels ...
  688. MoveLongword(ImagePixel^, Pixels[RecLeft], RecRight - RecLeft + 1);
  689. ResetSumRecord(SumRec);
  690. LL := RecLeft;
  691. RR := RecLeft + RadiusI;
  692. if RR > RecRight then RR := RecRight;
  693. // update first in row ...
  694. for XX := LL to RR do
  695. with Pixels[XX] do
  696. begin
  697. Inc(SumRec.A, A);
  698. Inc(SumRec.R, R);
  699. Inc(SumRec.G, G);
  700. Inc(SumRec.B, B);
  701. Inc(SumRec.Sum);
  702. end;
  703. ImagePixel^ := DivideToColor32(SumRec);
  704. // update the remaining pixels in the row ...
  705. for X := RecLeft + 1 to RecRight do
  706. begin
  707. Inc(ImagePixel);
  708. LL := X - RadiusI - 1;
  709. RR := X + RadiusI;
  710. if LL >= RecLeft then
  711. with Pixels[LL] do
  712. begin
  713. Dec(SumRec.A, A);
  714. Dec(SumRec.R, R);
  715. Dec(SumRec.G, G);
  716. Dec(SumRec.B, B);
  717. Dec(SumRec.Sum);
  718. end;
  719. if RR <= RecRight then
  720. with Pixels[RR] do
  721. begin
  722. Inc(SumRec.A, A);
  723. Inc(SumRec.R, R);
  724. Inc(SumRec.G, G);
  725. Inc(SumRec.B, B);
  726. Inc(SumRec.Sum);
  727. end;
  728. ImagePixel^ := DivideToColor32(SumRec);
  729. end;
  730. end;
  731. // vertical pass...
  732. for X := RecLeft to RecRight do
  733. begin
  734. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
  735. for J := RecTop to RecBottom do
  736. begin
  737. Pixels[J] := ImagePixel^;
  738. Inc(ImagePixel, Bitmap32.Width);
  739. end;
  740. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
  741. TT := RecTop;
  742. BB := RecTop + RadiusI;
  743. if BB > RecBottom then BB := RecBottom;
  744. ResetSumRecord(SumRec);
  745. // update first in col ...
  746. for YY := TT to BB do
  747. with Pixels[YY] do
  748. begin
  749. Inc(SumRec.A, A);
  750. Inc(SumRec.R, R);
  751. Inc(SumRec.G, G);
  752. Inc(SumRec.B, B);
  753. Inc(SumRec.Sum);
  754. end;
  755. ImagePixel^ := DivideToColor32(SumRec);
  756. // update remainder in col ...
  757. for Y := RecTop + 1 to RecBottom do
  758. begin
  759. Inc(ImagePixel, Bitmap32.Width);
  760. TT := Y - RadiusI - 1;
  761. BB := Y + RadiusI;
  762. if TT >= RecTop then
  763. with Pixels[TT] do
  764. begin
  765. Dec(SumRec.A, A);
  766. Dec(SumRec.R, R);
  767. Dec(SumRec.G, G);
  768. Dec(SumRec.B, B);
  769. Dec(SumRec.Sum);
  770. end;
  771. if BB <= RecBottom then
  772. with Pixels[BB] do
  773. begin
  774. Inc(SumRec.A, A);
  775. Inc(SumRec.R, R);
  776. Inc(SumRec.G, G);
  777. Inc(SumRec.B, B);
  778. Inc(SumRec.Sum);
  779. end;
  780. ImagePixel^ := DivideToColor32(SumRec);
  781. end;
  782. end;
  783. end;
  784. // extract alphas ...
  785. for Y := RecTop to RecBottom do
  786. begin
  787. ImgPixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
  788. for X := RecLeft to RecRight do
  789. begin
  790. ImgPixel.R := RcTable[ImgPixel.A, ImgPixel.R];
  791. ImgPixel.G := RcTable[ImgPixel.A, ImgPixel.G];
  792. ImgPixel.B := RcTable[ImgPixel.A, ImgPixel.B];
  793. Inc(ImgPixel);
  794. end;
  795. end;
  796. end;
  797. procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat; const BlurRegion: TArrayOfFloatPoint);
  798. var
  799. LL, RR, TT, BB, XX, YY, I, J, X, Y, RadiusI, Passes: Integer;
  800. RecLeft, RecTop, RecRight, RecBottom: Integer;
  801. ImagePixel: PColor32Entry;
  802. SumRec: TSumRecord;
  803. ImgPixel: PColor32Entry;
  804. Pixels: array of TSumRecord;
  805. Mask: TBitmap32;
  806. Clr, MaskClr: TColor32Entry;
  807. Pts: TArrayOfFloatPoint;
  808. Bounds: TRect;
  809. begin
  810. if Radius < 1 then
  811. Exit
  812. else if Radius > 256 then
  813. Radius := 256;
  814. RadiusI := Round(Radius / Sqrt(-2 * Ln(COne255th)));
  815. if RadiusI < 2 then
  816. begin
  817. Passes := Round(Radius);
  818. RadiusI := 1;
  819. end else
  820. Passes := 3;
  821. with PolygonBounds(BlurRegion) do
  822. Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
  823. if Bounds.Left < 0 then Bounds.Left := 0;
  824. if Bounds.Top < 0 then Bounds.Top := 0;
  825. if Bounds.Right >= Bitmap32.Width then Bounds.Right := Bitmap32.Width - 1;
  826. if Bounds.Bottom >= Bitmap32.Height then Bounds.Bottom := Bitmap32.Height - 1;
  827. RecLeft := Max(Bounds.Left, 0);
  828. RecTop := Max(Bounds.Top, 0);
  829. RecRight := Min(Bounds.Right, Bitmap32.Width - 1);
  830. RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
  831. SetLength(Pixels, Max(Bitmap32.Width, Bitmap32.Height) + 1);
  832. // pre-multiply alphas ...
  833. for Y := RecTop to RecBottom do
  834. begin
  835. ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
  836. Inc(ImgPixel, RecLeft);
  837. for X := RecLeft to RecRight do
  838. begin
  839. ImgPixel.R := DivTable[ImgPixel.R, ImgPixel.A];
  840. ImgPixel.G := DivTable[ImgPixel.G, ImgPixel.A];
  841. ImgPixel.B := DivTable[ImgPixel.B, ImgPixel.A];
  842. Inc(ImgPixel);
  843. end;
  844. end;
  845. Mask := TBitmap32.Create;
  846. try
  847. Mask.SetSize(Bounds.Right - Bounds.Left + 1, Bounds.Bottom - Bounds.Top + 1);
  848. SetLength(Pts, Length(BlurRegion));
  849. for I := 0 to High(BlurRegion) do
  850. begin
  851. Pts[I].X := BlurRegion[I].X - Bounds.Left;
  852. Pts[I].Y := BlurRegion[I].Y - Bounds.Top;
  853. end;
  854. PolygonFS(Mask, Pts, clWhite32);
  855. for I := 1 to Passes do
  856. begin
  857. // horizontal pass...
  858. for Y := RecTop to RecBottom do
  859. begin
  860. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
  861. // fill the Pixels buffer with a copy of the row's pixels ...
  862. for J := RecLeft to RecRight do
  863. begin
  864. MaskClr.ARGB := Mask.Pixel[J - RecLeft, Y - RecTop];
  865. if (MaskClr.A = 0) then
  866. begin
  867. Pixels[J].A := 0;
  868. Pixels[J].R := 0;
  869. Pixels[J].G := 0;
  870. Pixels[J].B := 0;
  871. Pixels[J].Sum := 0;
  872. end else
  873. with ImagePixel^ do
  874. begin
  875. Pixels[J].A := A;
  876. Pixels[J].R := R;
  877. Pixels[J].G := G;
  878. Pixels[J].B := B;
  879. Pixels[J].Sum := 1;
  880. end;
  881. Inc(ImagePixel);
  882. end;
  883. LL := RecLeft;
  884. RR := RecLeft + RadiusI;
  885. if RR > RecRight then RR := RecRight;
  886. ResetSumRecord(SumRec);
  887. // update first in row ...
  888. for XX := LL to RR do
  889. with Pixels[XX] do
  890. begin
  891. Inc(SumRec.A, A);
  892. Inc(SumRec.R, R);
  893. Inc(SumRec.G, G);
  894. Inc(SumRec.B, B);
  895. Inc(SumRec.Sum, Sum);
  896. end;
  897. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
  898. MaskClr.ARGB := Mask.Pixel[0, Y - RecTop];
  899. if (MaskClr.A > 0) and (SumRec.Sum > 0) then
  900. ImagePixel^ := DivideToColor32(SumRec);
  901. // update the remaining pixels in the row ...
  902. for X := RecLeft + 1 to RecRight do
  903. begin
  904. Inc(ImagePixel);
  905. LL := X - RadiusI - 1;
  906. RR := X + RadiusI;
  907. if LL >= RecLeft then
  908. with Pixels[LL] do
  909. begin
  910. Dec(SumRec.A, A);
  911. Dec(SumRec.R, R);
  912. Dec(SumRec.G, G);
  913. Dec(SumRec.B, B);
  914. Dec(SumRec.Sum, Sum);
  915. end;
  916. if RR <= RecRight then
  917. with Pixels[RR] do
  918. begin
  919. Inc(SumRec.A, A);
  920. Inc(SumRec.R, R);
  921. Inc(SumRec.G, G);
  922. Inc(SumRec.B, B);
  923. Inc(SumRec.Sum, Sum);
  924. end;
  925. MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
  926. if (SumRec.Sum > 0) and (MaskClr.A = 255) then
  927. ImagePixel^ := DivideToColor32(SumRec);
  928. end;
  929. end;
  930. // vertical pass...
  931. for X := RecLeft to RecRight do
  932. begin
  933. // fill the Pixels buffer with a copy of the col's pixels ...
  934. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
  935. for J := RecTop to RecBottom do
  936. begin
  937. MaskClr.ARGB := Mask.Pixel[X - RecLeft, J - RecTop];
  938. if (MaskClr.A = 0) then
  939. begin
  940. Pixels[J].A := 0;
  941. Pixels[J].R := 0;
  942. Pixels[J].G := 0;
  943. Pixels[J].B := 0;
  944. Pixels[J].Sum := 0;
  945. end else
  946. with ImagePixel^ do
  947. begin
  948. Pixels[J].A := A;
  949. Pixels[J].R := R;
  950. Pixels[J].G := G;
  951. Pixels[J].B := B;
  952. Pixels[J].Sum := 1;
  953. end;
  954. Inc(ImagePixel, Bitmap32.Width);
  955. end;
  956. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
  957. TT := RecTop;
  958. BB := RecTop + RadiusI;
  959. if BB > RecBottom then BB := RecBottom;
  960. ResetSumRecord(SumRec);
  961. // update first in col ...
  962. for YY := TT to BB do
  963. with Pixels[YY] do
  964. begin
  965. Inc(SumRec.A, A);
  966. Inc(SumRec.R, R);
  967. Inc(SumRec.G, G);
  968. Inc(SumRec.B, B);
  969. Inc(SumRec.Sum, Sum);
  970. end;
  971. MaskClr.ARGB := Mask.Pixel[X - RecLeft, 0];
  972. if (MaskClr.A > 0) and (SumRec.Sum > 0) then
  973. ImagePixel^ := DivideToColor32(SumRec);
  974. // update remainder in col ...
  975. for Y := RecTop + 1 to RecBottom do
  976. begin
  977. Inc(ImagePixel, Bitmap32.Width);
  978. TT := Y - RadiusI - 1;
  979. BB := Y + RadiusI;
  980. if TT >= RecTop then
  981. with Pixels[TT] do
  982. begin
  983. Dec(SumRec.A, A);
  984. Dec(SumRec.R, R);
  985. Dec(SumRec.G, G);
  986. Dec(SumRec.B, B);
  987. Dec(SumRec.Sum, Sum);
  988. end;
  989. if BB <= RecBottom then
  990. with Pixels[BB] do
  991. begin
  992. Inc(SumRec.A, A);
  993. Inc(SumRec.R, R);
  994. Inc(SumRec.G, G);
  995. Inc(SumRec.B, B);
  996. Inc(SumRec.Sum, Sum);
  997. end;
  998. MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
  999. if (SumRec.Sum = 0) or (MaskClr.A = 0) then
  1000. // do nothing
  1001. else if (I = Passes) then
  1002. begin
  1003. Clr := DivideToColor32(SumRec);
  1004. BlendMemEx(Clr.ARGB, ImagePixel^.ARGB, MaskClr.A);
  1005. end
  1006. else if (MaskClr.A = 255) then
  1007. ImagePixel^ := DivideToColor32(SumRec);
  1008. end;
  1009. EMMS;
  1010. end;
  1011. end;
  1012. // extract alphas ...
  1013. for Y := RecTop to RecBottom do
  1014. begin
  1015. ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
  1016. Inc(ImgPixel, RecLeft);
  1017. for X := RecLeft to RecRight do
  1018. begin
  1019. ImgPixel.R := RcTable[ImgPixel.A, ImgPixel.R];
  1020. ImgPixel.G := RcTable[ImgPixel.A, ImgPixel.G];
  1021. ImgPixel.B := RcTable[ImgPixel.A, ImgPixel.B];
  1022. Inc(ImgPixel);
  1023. end;
  1024. end;
  1025. finally
  1026. Mask.Free;
  1027. end;
  1028. end;
  1029. procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat);
  1030. begin
  1031. FastBlurGamma(Bitmap32, Radius, Bitmap32.BoundsRect);
  1032. end;
  1033. procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect);
  1034. var
  1035. LL, RR, TT, BB, XX, YY, I, J, X, Y, RadiusI, Passes: Integer;
  1036. RecLeft, RecTop, RecRight, RecBottom: Integer;
  1037. ImagePixel: PColor32Entry;
  1038. SumRec: TSumRecord;
  1039. ImgPixel: PColor32Entry;
  1040. Pixels: array of TColor32Entry;
  1041. begin
  1042. if Radius < 1 then
  1043. Exit
  1044. else if Radius > 256 then
  1045. Radius := 256;
  1046. RadiusI := Round(Radius / Sqrt(-2 * Ln(COne255th)));
  1047. if RadiusI < 2 then
  1048. begin
  1049. Passes := Round(Radius);
  1050. RadiusI := 1;
  1051. end else
  1052. Passes := 3;
  1053. RecLeft := Max(Bounds.Left, 0);
  1054. RecTop := Max(Bounds.Top, 0);
  1055. RecRight := Min(Bounds.Right, Bitmap32.Width - 1);
  1056. RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
  1057. SetLength(Pixels, Max(Bitmap32.Width, Bitmap32.Height) + 1);
  1058. // pre-multiply alphas ...
  1059. for Y := RecTop to RecBottom do
  1060. begin
  1061. ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
  1062. Inc(ImgPixel, RecLeft);
  1063. for X := RecLeft to RecRight do
  1064. with ImgPixel^ do
  1065. begin
  1066. R := DivTable[GAMMA_DECODING_TABLE[R], A];
  1067. G := DivTable[GAMMA_DECODING_TABLE[G], A];
  1068. B := DivTable[GAMMA_DECODING_TABLE[B], A];
  1069. Inc(ImgPixel);
  1070. end;
  1071. end;
  1072. for I := 1 to Passes do
  1073. begin
  1074. // horizontal pass...
  1075. for Y := RecTop to RecBottom do
  1076. begin
  1077. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
  1078. // fill the Pixels buffer with a copy of the row's pixels ...
  1079. MoveLongword(ImagePixel^, Pixels[RecLeft], RecRight - RecLeft + 1);
  1080. ResetSumRecord(SumRec);
  1081. LL := RecLeft;
  1082. RR := RecLeft + RadiusI;
  1083. if RR > RecRight then RR := RecRight;
  1084. // update first in row ...
  1085. for XX := LL to RR do
  1086. with Pixels[XX] do
  1087. begin
  1088. Inc(SumRec.A, A);
  1089. Inc(SumRec.R, R);
  1090. Inc(SumRec.G, G);
  1091. Inc(SumRec.B, B);
  1092. Inc(SumRec.Sum);
  1093. end;
  1094. ImagePixel^ := DivideToColor32(SumRec);
  1095. // update the remaining pixels in the row ...
  1096. for X := RecLeft + 1 to RecRight do
  1097. begin
  1098. Inc(ImagePixel);
  1099. LL := X - RadiusI - 1;
  1100. RR := X + RadiusI;
  1101. if LL >= RecLeft then
  1102. with Pixels[LL] do
  1103. begin
  1104. Dec(SumRec.A, A);
  1105. Dec(SumRec.R, R);
  1106. Dec(SumRec.G, G);
  1107. Dec(SumRec.B, B);
  1108. Dec(SumRec.Sum);
  1109. end;
  1110. if RR <= RecRight then
  1111. with Pixels[RR] do
  1112. begin
  1113. Inc(SumRec.A, A);
  1114. Inc(SumRec.R, R);
  1115. Inc(SumRec.G, G);
  1116. Inc(SumRec.B, B);
  1117. Inc(SumRec.Sum);
  1118. end;
  1119. ImagePixel^ := DivideToColor32(SumRec);
  1120. end;
  1121. end;
  1122. // vertical pass...
  1123. for X := RecLeft to RecRight do
  1124. begin
  1125. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
  1126. for J := RecTop to RecBottom do
  1127. begin
  1128. Pixels[J] := ImagePixel^;
  1129. Inc(ImagePixel, Bitmap32.Width);
  1130. end;
  1131. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
  1132. TT := RecTop;
  1133. BB := RecTop + RadiusI;
  1134. if BB > RecBottom then BB := RecBottom;
  1135. ResetSumRecord(SumRec);
  1136. // update first in col ...
  1137. for YY := TT to BB do
  1138. with Pixels[YY] do
  1139. begin
  1140. Inc(SumRec.A, A);
  1141. Inc(SumRec.R, R);
  1142. Inc(SumRec.G, G);
  1143. Inc(SumRec.B, B);
  1144. Inc(SumRec.Sum);
  1145. end;
  1146. ImagePixel^ := DivideToColor32(SumRec);
  1147. // update remainder in col ...
  1148. for Y := RecTop + 1 to RecBottom do
  1149. begin
  1150. Inc(ImagePixel, Bitmap32.Width);
  1151. TT := Y - RadiusI - 1;
  1152. BB := Y + RadiusI;
  1153. if TT >= RecTop then
  1154. with Pixels[TT] do
  1155. begin
  1156. Dec(SumRec.A, A);
  1157. Dec(SumRec.R, R);
  1158. Dec(SumRec.G, G);
  1159. Dec(SumRec.B, B);
  1160. Dec(SumRec.Sum);
  1161. end;
  1162. if BB <= RecBottom then
  1163. with Pixels[BB] do
  1164. begin
  1165. Inc(SumRec.A, A);
  1166. Inc(SumRec.R, R);
  1167. Inc(SumRec.G, G);
  1168. Inc(SumRec.B, B);
  1169. Inc(SumRec.Sum);
  1170. end;
  1171. ImagePixel^ := DivideToColor32(SumRec);
  1172. end;
  1173. end;
  1174. end;
  1175. // extract alphas ...
  1176. for Y := RecTop to RecBottom do
  1177. begin
  1178. ImgPixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
  1179. for X := RecLeft to RecRight do
  1180. begin
  1181. ImgPixel.R := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.R]];
  1182. ImgPixel.G := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.G]];
  1183. ImgPixel.B := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.B]];
  1184. Inc(ImgPixel);
  1185. end;
  1186. end;
  1187. end;
  1188. procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat; const BlurRegion: TArrayOfFloatPoint);
  1189. var
  1190. LL, RR, TT, BB, XX, YY, I, J, X, Y, RadiusI, Passes: Integer;
  1191. RecLeft, RecTop, RecRight, RecBottom: Integer;
  1192. ImagePixel: PColor32Entry;
  1193. SumRec: TSumRecord;
  1194. ImgPixel: PColor32Entry;
  1195. Pixels: array of TSumRecord;
  1196. Mask: TBitmap32;
  1197. Clr, MaskClr: TColor32Entry;
  1198. Pts: TArrayOfFloatPoint;
  1199. Bounds: TRect;
  1200. begin
  1201. if Radius < 1 then
  1202. Exit
  1203. else if Radius > 256 then
  1204. Radius := 256;
  1205. RadiusI := Round(Radius / Sqrt(-2 * Ln(COne255th)));
  1206. if RadiusI < 2 then
  1207. begin
  1208. Passes := Round(Radius);
  1209. RadiusI := 1;
  1210. end else
  1211. Passes := 3;
  1212. with PolygonBounds(BlurRegion) do
  1213. Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
  1214. if Bounds.Left < 0 then Bounds.Left := 0;
  1215. if Bounds.Top < 0 then Bounds.Top := 0;
  1216. if Bounds.Right >= Bitmap32.Width then Bounds.Right := Bitmap32.Width - 1;
  1217. if Bounds.Bottom >= Bitmap32.Height then Bounds.Bottom := Bitmap32.Height - 1;
  1218. RecLeft := Max(Bounds.Left, 0);
  1219. RecTop := Max(Bounds.Top, 0);
  1220. RecRight := Min(Bounds.Right, Bitmap32.Width - 1);
  1221. RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
  1222. SetLength(Pixels, Max(Bitmap32.Width, Bitmap32.Height) + 1);
  1223. // pre-multiply alphas ...
  1224. for Y := RecTop to RecBottom do
  1225. begin
  1226. ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
  1227. Inc(ImgPixel, RecLeft);
  1228. for X := RecLeft to RecRight do
  1229. begin
  1230. ImgPixel.R := DivTable[GAMMA_DECODING_TABLE[ImgPixel.R], ImgPixel.A];
  1231. ImgPixel.G := DivTable[GAMMA_DECODING_TABLE[ImgPixel.G], ImgPixel.A];
  1232. ImgPixel.B := DivTable[GAMMA_DECODING_TABLE[ImgPixel.B], ImgPixel.A];
  1233. Inc(ImgPixel);
  1234. end;
  1235. end;
  1236. Mask := TBitmap32.Create;
  1237. try
  1238. Mask.SetSize(Bounds.Right - Bounds.Left + 1, Bounds.Bottom - Bounds.Top + 1);
  1239. SetLength(Pts, Length(BlurRegion));
  1240. for I := 0 to High(BlurRegion) do
  1241. begin
  1242. Pts[I].X := BlurRegion[I].X - Bounds.Left;
  1243. Pts[I].Y := BlurRegion[I].Y - Bounds.Top;
  1244. end;
  1245. PolygonFS(Mask, Pts, clWhite32);
  1246. for I := 1 to Passes do
  1247. begin
  1248. // horizontal pass...
  1249. for Y := RecTop to RecBottom do
  1250. begin
  1251. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
  1252. // fill the Pixels buffer with a copy of the row's pixels ...
  1253. for J := RecLeft to RecRight do
  1254. begin
  1255. MaskClr.ARGB := Mask.Pixel[J - RecLeft, Y - RecTop];
  1256. if (MaskClr.A = 0) then
  1257. begin
  1258. Pixels[J].A := 0;
  1259. Pixels[J].R := 0;
  1260. Pixels[J].G := 0;
  1261. Pixels[J].B := 0;
  1262. Pixels[J].Sum := 0;
  1263. end else
  1264. with ImagePixel^ do
  1265. begin
  1266. Pixels[J].A := A;
  1267. Pixels[J].R := R;
  1268. Pixels[J].G := G;
  1269. Pixels[J].B := B;
  1270. Pixels[J].Sum := 1;
  1271. end;
  1272. Inc(ImagePixel);
  1273. end;
  1274. LL := RecLeft;
  1275. RR := RecLeft + RadiusI;
  1276. if RR > RecRight then RR := RecRight;
  1277. ResetSumRecord(SumRec);
  1278. // update first in row ...
  1279. for XX := LL to RR do
  1280. with Pixels[XX] do
  1281. begin
  1282. Inc(SumRec.A, A);
  1283. Inc(SumRec.R, R);
  1284. Inc(SumRec.G, G);
  1285. Inc(SumRec.B, B);
  1286. Inc(SumRec.Sum, Sum);
  1287. end;
  1288. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
  1289. MaskClr.ARGB := Mask.Pixel[0, Y - RecTop];
  1290. if (MaskClr.A > 0) and (SumRec.Sum > 0) then
  1291. ImagePixel^ := DivideToColor32(SumRec);
  1292. // update the remaining pixels in the row ...
  1293. for X := RecLeft + 1 to RecRight do
  1294. begin
  1295. Inc(ImagePixel);
  1296. LL := X - RadiusI - 1;
  1297. RR := X + RadiusI;
  1298. if LL >= RecLeft then
  1299. with Pixels[LL] do
  1300. begin
  1301. Dec(SumRec.A, A);
  1302. Dec(SumRec.R, R);
  1303. Dec(SumRec.G, G);
  1304. Dec(SumRec.B, B);
  1305. Dec(SumRec.Sum, Sum);
  1306. end;
  1307. if RR <= RecRight then
  1308. with Pixels[RR] do
  1309. begin
  1310. Inc(SumRec.A, A);
  1311. Inc(SumRec.R, R);
  1312. Inc(SumRec.G, G);
  1313. Inc(SumRec.B, B);
  1314. Inc(SumRec.Sum, Sum);
  1315. end;
  1316. MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
  1317. if (SumRec.Sum > 0) and (MaskClr.A = 255) then
  1318. ImagePixel^ := DivideToColor32(SumRec);
  1319. end;
  1320. end;
  1321. // vertical pass...
  1322. for X := RecLeft to RecRight do
  1323. begin
  1324. // fill the Pixels buffer with a copy of the col's pixels ...
  1325. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
  1326. for J := RecTop to RecBottom do
  1327. begin
  1328. MaskClr.ARGB := Mask.Pixel[X - RecLeft, J - RecTop];
  1329. if (MaskClr.A = 0) then
  1330. begin
  1331. Pixels[J].A := 0;
  1332. Pixels[J].R := 0;
  1333. Pixels[J].G := 0;
  1334. Pixels[J].B := 0;
  1335. Pixels[J].Sum := 0;
  1336. end else
  1337. with ImagePixel^ do
  1338. begin
  1339. Pixels[J].A := A;
  1340. Pixels[J].R := R;
  1341. Pixels[J].G := G;
  1342. Pixels[J].B := B;
  1343. Pixels[J].Sum := 1;
  1344. end;
  1345. Inc(ImagePixel, Bitmap32.Width);
  1346. end;
  1347. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
  1348. TT := RecTop;
  1349. BB := RecTop + RadiusI;
  1350. if BB > RecBottom then BB := RecBottom;
  1351. ResetSumRecord(SumRec);
  1352. // update first in col ...
  1353. for YY := TT to BB do
  1354. with Pixels[YY] do
  1355. begin
  1356. Inc(SumRec.A, A);
  1357. Inc(SumRec.R, R);
  1358. Inc(SumRec.G, G);
  1359. Inc(SumRec.B, B);
  1360. Inc(SumRec.Sum, Sum);
  1361. end;
  1362. MaskClr.ARGB := Mask.Pixel[X - RecLeft, 0];
  1363. if (MaskClr.A > 0) and (SumRec.Sum > 0) then
  1364. ImagePixel^ := DivideToColor32(SumRec);
  1365. // update remainder in col ...
  1366. for Y := RecTop + 1 to RecBottom do
  1367. begin
  1368. Inc(ImagePixel, Bitmap32.Width);
  1369. TT := Y - RadiusI - 1;
  1370. BB := Y + RadiusI;
  1371. if TT >= RecTop then
  1372. with Pixels[TT] do
  1373. begin
  1374. Dec(SumRec.A, A);
  1375. Dec(SumRec.R, R);
  1376. Dec(SumRec.G, G);
  1377. Dec(SumRec.B, B);
  1378. Dec(SumRec.Sum, Sum);
  1379. end;
  1380. if BB <= RecBottom then
  1381. with Pixels[BB] do
  1382. begin
  1383. Inc(SumRec.A, A);
  1384. Inc(SumRec.R, R);
  1385. Inc(SumRec.G, G);
  1386. Inc(SumRec.B, B);
  1387. Inc(SumRec.Sum, Sum);
  1388. end;
  1389. MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
  1390. if (SumRec.Sum = 0) or (MaskClr.A = 0) then
  1391. // do nothing
  1392. else if (I = Passes) then
  1393. begin
  1394. Clr := DivideToColor32(SumRec);
  1395. BlendMemEx(Clr.ARGB, ImagePixel^.ARGB, MaskClr.A);
  1396. end
  1397. else if (MaskClr.A = 255) then
  1398. ImagePixel^ := DivideToColor32(SumRec);
  1399. end;
  1400. EMMS;
  1401. end;
  1402. end;
  1403. // extract alphas ...
  1404. for Y := RecTop to RecBottom do
  1405. begin
  1406. ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
  1407. Inc(ImgPixel, RecLeft);
  1408. for X := RecLeft to RecRight do
  1409. begin
  1410. ImgPixel.R := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.R]];
  1411. ImgPixel.G := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.G]];
  1412. ImgPixel.B := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.B]];
  1413. Inc(ImgPixel);
  1414. end;
  1415. end;
  1416. finally
  1417. Mask.Free;
  1418. end;
  1419. end;
  1420. { MotionBlur }
  1421. procedure MotionBlur(Bitmap32: TBitmap32;
  1422. Dist, AngleDeg: TFloat; Bidirectional: Boolean = True);
  1423. var
  1424. Pts: TArrayOfFloatPoint;
  1425. begin
  1426. SetLength(Pts, 4);
  1427. with Bitmap32.BoundsRect do
  1428. begin
  1429. Pts[0] := FloatPoint(Left, Top);
  1430. Pts[1] := FloatPoint(Right, Top);
  1431. Pts[2] := FloatPoint(Right, Bottom);
  1432. Pts[3] := FloatPoint(Left, Bottom);
  1433. end;
  1434. MotionBlur(Bitmap32, Dist, AngleDeg, Pts, Bidirectional);
  1435. end;
  1436. procedure MotionBlur(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
  1437. const Bounds: TRect; Bidirectional: Boolean = True);
  1438. var
  1439. Pts: TArrayOfFloatPoint;
  1440. begin
  1441. SetLength(Pts, 4);
  1442. with Bounds do
  1443. begin
  1444. Pts[0] := FloatPoint(Left, Top);
  1445. Pts[1] := FloatPoint(Right, Top);
  1446. Pts[2] := FloatPoint(Right, Bottom);
  1447. Pts[3] := FloatPoint(Left, Bottom);
  1448. end;
  1449. MotionBlur(Bitmap32, Dist, AngleDeg, Pts, Bidirectional);
  1450. end;
  1451. procedure MotionBlur(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
  1452. const BlurRegion: TArrayOfFloatPoint; Bidirectional: Boolean = True);
  1453. var
  1454. LL, RR, XX, I, X, Y, RadiusI, Passes: Integer;
  1455. ImagePixel, ImagePixel2, ImagePixel3: PColor32Entry;
  1456. ImagePixels, ImagePixels2: PColor32EntryArray;
  1457. SumRec: TSumRecord;
  1458. Pixels: array of TSumRecord;
  1459. Mask: TBitmap32;
  1460. Clr, MaskClr: TColor32Entry;
  1461. Pts: TArrayOfFloatPoint;
  1462. Bounds: TRect;
  1463. Dx, Dy: Double;
  1464. Affine: TAffineTransformation;
  1465. BmpCutout: TBitmap32;
  1466. BmpRotated: TBitmap32;
  1467. PrevIsBlank, ThisIsBlank: boolean;
  1468. begin
  1469. if Dist < 1 then
  1470. Exit
  1471. else if Dist > 256 then
  1472. Dist := 256;
  1473. RadiusI := Round(Sqrt(-Dist * Dist / (2 * Ln(COne255th))));
  1474. if RadiusI < 2 then
  1475. begin
  1476. Passes := Round(Dist);
  1477. RadiusI := 1;
  1478. end else
  1479. Passes := 3;
  1480. with PolygonBounds(BlurRegion) do
  1481. Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
  1482. Bounds.Left := Max(Bounds.Left, 0);
  1483. Bounds.Top := Max(Bounds.Top, 0);
  1484. Bounds.Right := Min(Bounds.Right, Bitmap32.Width - 1);
  1485. Bounds.Bottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
  1486. Affine := TAffineTransformation.Create;
  1487. BmpCutout := TBitmap32.Create;
  1488. BmpRotated := TBitmap32.Create;
  1489. BmpRotated.Resampler := TLinearResampler.Create(BmpRotated);
  1490. Mask := TBitmap32.Create;
  1491. try
  1492. // copy the region to be blurred into the BmpCutout image buffer ...
  1493. BmpCutout.SetSize(Bounds.Right - Bounds.Left, Bounds.Bottom - Bounds.Top);
  1494. for Y := 0 to BmpCutout.Height - 1 do
  1495. begin
  1496. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y + Bounds.Top][Bounds.Left]);
  1497. ImagePixel2 := PColor32Entry(BmpCutout.ScanLine[Y]);
  1498. MoveLongword(ImagePixel^, ImagePixel2^, BmpCutout.Width);
  1499. end;
  1500. // pre-multiply alphas in BmpCutout ...
  1501. for Y := 0 to BmpCutout.Height - 1 do
  1502. begin
  1503. ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
  1504. for X := 0 to BmpCutout.Width - 1 do
  1505. begin
  1506. ImagePixel.R := DivTable[ImagePixel.R, ImagePixel.A];
  1507. ImagePixel.G := DivTable[ImagePixel.G, ImagePixel.A];
  1508. ImagePixel.B := DivTable[ImagePixel.B, ImagePixel.A];
  1509. Inc(ImagePixel);
  1510. end;
  1511. end;
  1512. // Rotate BmpCutout into BmpRotated ...
  1513. Affine.SrcRect := FloatRect(BmpCutout.BoundsRect);
  1514. Affine.Rotate(180 - AngleDeg);
  1515. with Affine.GetTransformedBounds do
  1516. begin
  1517. Mask.SetSize(Round(Right - Left) + 1, Round(Bottom - Top) + 1);
  1518. BmpRotated.SetSize(Mask.Width, Mask.Height);
  1519. Dx := Left; Dy := Top;
  1520. Affine.Translate(-Dx, -Dy);
  1521. end;
  1522. Transform(BmpRotated, BmpCutout, Affine);
  1523. // Create a rotated mask ...
  1524. Affine.Clear;
  1525. Affine.Translate(-Bounds.Left, -Bounds.Top);
  1526. Affine.SrcRect := FloatRect(BmpCutout.BoundsRect);
  1527. Affine.Rotate(180 - AngleDeg);
  1528. Affine.Translate(-Dx, -Dy);
  1529. Pts := TransformPolygon(BlurRegion, Affine);
  1530. PolygonFS(Mask, Pts, clWhite32);
  1531. SetLength(Pixels, BmpRotated.Width);
  1532. // Now blur horizontally the rotated image ...
  1533. for I := 1 to Passes do
  1534. // Horizontal blur only ...
  1535. for Y := 0 to BmpRotated.Height - 1 do
  1536. begin
  1537. ImagePixel := PColor32Entry(BmpRotated.ScanLine[Y]);
  1538. // fill the Pixels buffer with a copy of the row's pixels ...
  1539. for X := 0 to BmpRotated.Width - 1 do
  1540. begin
  1541. MaskClr.ARGB := Mask.Pixel[X, Y];
  1542. if (MaskClr.A = 0) then
  1543. begin
  1544. Pixels[X].A := 0;
  1545. Pixels[X].R := 0;
  1546. Pixels[X].G := 0;
  1547. Pixels[X].B := 0;
  1548. Pixels[X].Sum := 0;
  1549. end else
  1550. with ImagePixel^ do
  1551. begin
  1552. Pixels[X].A := A;
  1553. Pixels[X].R := R;
  1554. Pixels[X].G := G;
  1555. Pixels[X].B := B;
  1556. Pixels[X].Sum := 1;
  1557. end;
  1558. Inc(ImagePixel);
  1559. end;
  1560. LL := 0;
  1561. RR := RadiusI;
  1562. if RR >= BmpRotated.Width then RR := BmpRotated.Width - 1;
  1563. ResetSumRecord(SumRec);
  1564. // update first in row ...
  1565. for XX := LL to RR do
  1566. with Pixels[XX] do
  1567. begin
  1568. Inc(SumRec.A, A);
  1569. Inc(SumRec.R, R);
  1570. Inc(SumRec.G, G);
  1571. Inc(SumRec.B, B);
  1572. Inc(SumRec.Sum, Sum);
  1573. end;
  1574. ImagePixel := PColor32Entry(BmpRotated.ScanLine[Y]);
  1575. MaskClr.ARGB := Mask.Pixel[0, Y];
  1576. if (MaskClr.A > 0) and (SumRec.Sum > 0) then
  1577. ImagePixel^ := DivideToColor32(SumRec);
  1578. // update the remaining pixels in the row ...
  1579. for X := 1 to BmpRotated.Width - 1 do
  1580. begin
  1581. Inc(ImagePixel);
  1582. if Bidirectional then
  1583. LL := X - RadiusI - 1
  1584. else
  1585. LL := X - 1;
  1586. RR := X + RadiusI;
  1587. if LL >= 0 then
  1588. with Pixels[LL] do
  1589. begin
  1590. Dec(SumRec.A, A);
  1591. Dec(SumRec.R, R);
  1592. Dec(SumRec.G, G);
  1593. Dec(SumRec.B, B);
  1594. Dec(SumRec.Sum, Sum);
  1595. end;
  1596. if RR < BmpRotated.Width then
  1597. with Pixels[RR] do
  1598. begin
  1599. Inc(SumRec.A, A);
  1600. Inc(SumRec.R, R);
  1601. Inc(SumRec.G, G);
  1602. Inc(SumRec.B, B);
  1603. Inc(SumRec.Sum, Sum);
  1604. end;
  1605. MaskClr.ARGB := Mask.Pixel[X, Y];
  1606. if (SumRec.Sum = 0) or (MaskClr.A = 0) then
  1607. Continue
  1608. else if (I = Passes) then
  1609. begin
  1610. Clr := DivideToColor32(SumRec);
  1611. BlendMemEx(Clr.ARGB, ImagePixel^.ARGB, MaskClr.A);
  1612. end
  1613. else if (MaskClr.A = 255) then
  1614. ImagePixel^ := DivideToColor32(SumRec);
  1615. end;
  1616. EMMS;
  1617. end;
  1618. // un-rotate the now blurred image back into BmpCutout ...
  1619. Affine.Clear;
  1620. Affine.SrcRect := FloatRect(BmpRotated.BoundsRect);
  1621. Affine.Translate(Dx, Dy);
  1622. Affine.Rotate(AngleDeg + 180);
  1623. Transform(BmpCutout, BmpRotated, Affine);
  1624. // extract alphas ...
  1625. for Y := 0 to BmpCutout.Height - 1 do
  1626. begin
  1627. ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
  1628. for X := 0 to BmpCutout.Width - 1 do
  1629. begin
  1630. ImagePixel.R := RcTable[ImagePixel.A, ImagePixel.R];
  1631. ImagePixel.G := RcTable[ImagePixel.A, ImagePixel.G];
  1632. ImagePixel.B := RcTable[ImagePixel.A, ImagePixel.B];
  1633. Inc(ImagePixel);
  1634. end;
  1635. end;
  1636. // Create an un-rotated mask and copy masked pixels from BmpCutout
  1637. // back to the original image (Bitmap32) ...
  1638. Mask.SetSize(BmpCutout.Width, BmpCutout.Height);
  1639. Pts := TranslatePolygon(BlurRegion, -Bounds.Left, -Bounds.Top);
  1640. PolygonFS(Mask, Pts, clWhite32);
  1641. for Y := 0 to BmpCutout.Height - 1 do
  1642. begin
  1643. ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
  1644. ImagePixel2 := PColor32Entry(Mask.ScanLine[Y]);
  1645. ImagePixel3 := PColor32Entry(@Bitmap32.ScanLine[Y + Bounds.Top][Bounds.Left]);
  1646. for X := 0 to BmpCutout.Width - 1 do
  1647. begin
  1648. if ImagePixel2.A > 0 then
  1649. ImagePixel3.ARGB := ImagePixel.ARGB;
  1650. Inc(ImagePixel);
  1651. Inc(ImagePixel2);
  1652. Inc(ImagePixel3);
  1653. end;
  1654. end;
  1655. finally
  1656. Affine.Free;
  1657. BmpCutout.Free;
  1658. BmpRotated.Free;
  1659. Mask.Free;
  1660. end;
  1661. end;
  1662. procedure MotionBlurGamma(Bitmap32: TBitmap32;
  1663. Dist, AngleDeg: TFloat; Bidirectional: Boolean = True);
  1664. var
  1665. Pts: TArrayOfFloatPoint;
  1666. begin
  1667. SetLength(Pts, 4);
  1668. with Bitmap32.BoundsRect do
  1669. begin
  1670. Pts[0] := FloatPoint(Left, Top);
  1671. Pts[1] := FloatPoint(Right, Top);
  1672. Pts[2] := FloatPoint(Right, Bottom);
  1673. Pts[3] := FloatPoint(Left, Bottom);
  1674. end;
  1675. MotionBlurGamma(Bitmap32, Dist, AngleDeg, Pts, Bidirectional);
  1676. end;
  1677. procedure MotionBlurGamma(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
  1678. const Bounds: TRect; Bidirectional: Boolean = True);
  1679. var
  1680. Pts: TArrayOfFloatPoint;
  1681. begin
  1682. SetLength(Pts, 4);
  1683. with Bounds do
  1684. begin
  1685. Pts[0] := FloatPoint(Left, Top);
  1686. Pts[1] := FloatPoint(Right, Top);
  1687. Pts[2] := FloatPoint(Right, Bottom);
  1688. Pts[3] := FloatPoint(Left, Bottom);
  1689. end;
  1690. MotionBlurGamma(Bitmap32, Dist, AngleDeg, Pts, Bidirectional);
  1691. end;
  1692. procedure MotionBlurGamma(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
  1693. const BlurRegion: TArrayOfFloatPoint; Bidirectional: Boolean = True);
  1694. var
  1695. LL, RR, XX, I, X, Y, RadiusI, Passes: Integer;
  1696. ImagePixel, ImagePixel2, ImagePixel3: PColor32Entry;
  1697. ImagePixels, ImagePixels2: PColor32EntryArray;
  1698. SumRec: TSumRecord;
  1699. Pixels: array of TSumRecord;
  1700. Mask: TBitmap32;
  1701. Clr, MaskClr: TColor32Entry;
  1702. Pts: TArrayOfFloatPoint;
  1703. Bounds: TRect;
  1704. Dx, Dy: Double;
  1705. Affine: TAffineTransformation;
  1706. BmpCutout: TBitmap32;
  1707. BmpRotated: TBitmap32;
  1708. PrevIsBlank, ThisIsBlank: boolean;
  1709. begin
  1710. if Dist < 1 then
  1711. Exit
  1712. else if Dist > 256 then
  1713. Dist := 256;
  1714. RadiusI := Round(Sqrt(-Dist * Dist / (2 * Ln(COne255th))));
  1715. if RadiusI < 2 then
  1716. begin
  1717. Passes := Round(Dist);
  1718. RadiusI := 1;
  1719. end else
  1720. Passes := 3;
  1721. with PolygonBounds(BlurRegion) do
  1722. Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
  1723. Bounds.Left := Max(Bounds.Left, 0);
  1724. Bounds.Top := Max(Bounds.Top, 0);
  1725. Bounds.Right := Min(Bounds.Right, Bitmap32.Width - 1);
  1726. Bounds.Bottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
  1727. Affine := TAffineTransformation.Create;
  1728. BmpCutout := TBitmap32.Create;
  1729. BmpRotated := TBitmap32.Create;
  1730. BmpRotated.Resampler := TLinearResampler.Create(BmpRotated);
  1731. Mask := TBitmap32.Create;
  1732. try
  1733. // copy the region to be blurred into the BmpCutout image buffer ...
  1734. BmpCutout.SetSize(Bounds.Right - Bounds.Left, Bounds.Bottom - Bounds.Top);
  1735. for Y := 0 to BmpCutout.Height - 1 do
  1736. begin
  1737. ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y + Bounds.Top][Bounds.Left]);
  1738. ImagePixel2 := PColor32Entry(BmpCutout.ScanLine[Y]);
  1739. MoveLongword(ImagePixel^, ImagePixel2^, BmpCutout.Width);
  1740. end;
  1741. // pre-multiply alphas in BmpCutout ...
  1742. for Y := 0 to BmpCutout.Height - 1 do
  1743. begin
  1744. ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
  1745. for X := 0 to BmpCutout.Width - 1 do
  1746. begin
  1747. ImagePixel.R := DivTable[GAMMA_DECODING_TABLE[ImagePixel.R], ImagePixel.A];
  1748. ImagePixel.G := DivTable[GAMMA_DECODING_TABLE[ImagePixel.G], ImagePixel.A];
  1749. ImagePixel.B := DivTable[GAMMA_DECODING_TABLE[ImagePixel.B], ImagePixel.A];
  1750. Inc(ImagePixel);
  1751. end;
  1752. end;
  1753. // Rotate BmpCutout into BmpRotated ...
  1754. Affine.SrcRect := FloatRect(BmpCutout.BoundsRect);
  1755. Affine.Rotate(180 - AngleDeg);
  1756. with Affine.GetTransformedBounds do
  1757. begin
  1758. Mask.SetSize(Round(Right - Left) + 1, Round(Bottom - Top) + 1);
  1759. BmpRotated.SetSize(Mask.Width, Mask.Height);
  1760. Dx := Left; Dy := Top;
  1761. Affine.Translate(-Dx, -Dy);
  1762. end;
  1763. Transform(BmpRotated, BmpCutout, Affine);
  1764. // Create a rotated mask ...
  1765. Affine.Clear;
  1766. Affine.Translate(-Bounds.Left, -Bounds.Top);
  1767. Affine.SrcRect := FloatRect(BmpCutout.BoundsRect);
  1768. Affine.Rotate(180 - AngleDeg);
  1769. Affine.Translate(-Dx, -Dy);
  1770. Pts := TransformPolygon(BlurRegion, Affine);
  1771. PolygonFS(Mask, Pts, clWhite32);
  1772. SetLength(Pixels, BmpRotated.Width);
  1773. // Now blur horizontally the rotated image ...
  1774. for I := 1 to Passes do
  1775. // Horizontal blur only ...
  1776. for Y := 0 to BmpRotated.Height - 1 do
  1777. begin
  1778. ImagePixel := PColor32Entry(BmpRotated.ScanLine[Y]);
  1779. // fill the Pixels buffer with a copy of the row's pixels ...
  1780. for X := 0 to BmpRotated.Width - 1 do
  1781. begin
  1782. MaskClr.ARGB := Mask.Pixel[X, Y];
  1783. if (MaskClr.A = 0) then
  1784. begin
  1785. Pixels[X].A := 0;
  1786. Pixels[X].R := 0;
  1787. Pixels[X].G := 0;
  1788. Pixels[X].B := 0;
  1789. Pixels[X].Sum := 0;
  1790. end else
  1791. with ImagePixel^ do
  1792. begin
  1793. Pixels[X].A := A;
  1794. Pixels[X].R := R;
  1795. Pixels[X].G := G;
  1796. Pixels[X].B := B;
  1797. Pixels[X].Sum := 1;
  1798. end;
  1799. Inc(ImagePixel);
  1800. end;
  1801. LL := 0;
  1802. RR := RadiusI;
  1803. if RR >= BmpRotated.Width then RR := BmpRotated.Width - 1;
  1804. ResetSumRecord(SumRec);
  1805. // update first in row ...
  1806. for XX := LL to RR do
  1807. with Pixels[XX] do
  1808. begin
  1809. Inc(SumRec.A, A);
  1810. Inc(SumRec.R, R);
  1811. Inc(SumRec.G, G);
  1812. Inc(SumRec.B, B);
  1813. Inc(SumRec.Sum, Sum);
  1814. end;
  1815. ImagePixel := PColor32Entry(BmpRotated.ScanLine[Y]);
  1816. MaskClr.ARGB := Mask.Pixel[0, Y];
  1817. if (MaskClr.A > 0) and (SumRec.Sum > 0) then
  1818. ImagePixel^ := DivideToColor32(SumRec);
  1819. // update the remaining pixels in the row ...
  1820. for X := 1 to BmpRotated.Width - 1 do
  1821. begin
  1822. Inc(ImagePixel);
  1823. if Bidirectional then
  1824. LL := X - RadiusI - 1
  1825. else
  1826. LL := X - 1;
  1827. RR := X + RadiusI;
  1828. if LL >= 0 then
  1829. with Pixels[LL] do
  1830. begin
  1831. Dec(SumRec.A, A);
  1832. Dec(SumRec.R, R);
  1833. Dec(SumRec.G, G);
  1834. Dec(SumRec.B, B);
  1835. Dec(SumRec.Sum, Sum);
  1836. end;
  1837. if RR < BmpRotated.Width then
  1838. with Pixels[RR] do
  1839. begin
  1840. Inc(SumRec.A, A);
  1841. Inc(SumRec.R, R);
  1842. Inc(SumRec.G, G);
  1843. Inc(SumRec.B, B);
  1844. Inc(SumRec.Sum, Sum);
  1845. end;
  1846. MaskClr.ARGB := Mask.Pixel[X, Y];
  1847. if (SumRec.Sum = 0) or (MaskClr.A = 0) then
  1848. Continue
  1849. else if (I = Passes) then
  1850. begin
  1851. Clr := DivideToColor32(SumRec);
  1852. BlendMemEx(Clr.ARGB, ImagePixel^.ARGB, MaskClr.A);
  1853. end
  1854. else if (MaskClr.A = 255) then
  1855. ImagePixel^ := DivideToColor32(SumRec);
  1856. end;
  1857. EMMS;
  1858. end;
  1859. // un-rotate the now blurred image back into BmpCutout ...
  1860. Affine.Clear;
  1861. Affine.SrcRect := FloatRect(BmpRotated.BoundsRect);
  1862. Affine.Translate(Dx, Dy);
  1863. Affine.Rotate(AngleDeg + 180);
  1864. Transform(BmpCutout, BmpRotated, Affine);
  1865. // extract alphas ...
  1866. for Y := 0 to BmpCutout.Height - 1 do
  1867. begin
  1868. ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
  1869. for X := 0 to BmpCutout.Width - 1 do
  1870. begin
  1871. ImagePixel.R := GAMMA_ENCODING_TABLE[RcTable[ImagePixel.A, ImagePixel.R]];
  1872. ImagePixel.G := GAMMA_ENCODING_TABLE[RcTable[ImagePixel.A, ImagePixel.G]];
  1873. ImagePixel.B := GAMMA_ENCODING_TABLE[RcTable[ImagePixel.A, ImagePixel.B]];
  1874. Inc(ImagePixel);
  1875. end;
  1876. end;
  1877. // Create an un-rotated mask and copy masked pixels from BmpCutout
  1878. // back to the original image (Bitmap32) ...
  1879. Mask.SetSize(BmpCutout.Width, BmpCutout.Height);
  1880. Pts := TranslatePolygon(BlurRegion, -Bounds.Left, -Bounds.Top);
  1881. PolygonFS(Mask, Pts, clWhite32);
  1882. for Y := 0 to BmpCutout.Height - 1 do
  1883. begin
  1884. ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
  1885. ImagePixel2 := PColor32Entry(Mask.ScanLine[Y]);
  1886. ImagePixel3 := PColor32Entry(@Bitmap32.ScanLine[Y + Bounds.Top][Bounds.Left]);
  1887. for X := 0 to BmpCutout.Width - 1 do
  1888. begin
  1889. if ImagePixel2.A > 0 then
  1890. ImagePixel3.ARGB := ImagePixel.ARGB;
  1891. Inc(ImagePixel);
  1892. Inc(ImagePixel2);
  1893. Inc(ImagePixel3);
  1894. end;
  1895. end;
  1896. finally
  1897. Affine.Free;
  1898. BmpCutout.Free;
  1899. BmpRotated.Free;
  1900. Mask.Free;
  1901. end;
  1902. end;
  1903. end.