source: trunk/Packages/bgrabitmap/blurbox.inc

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 10.5 KB
Line 
1type
2 TVertical = record red,green,blue,alpha,count: TAccumulator; end;
3 PVertical = ^TVertical;
4var
5 verticals: PVertical;
6 left,right,width,height: NativeInt;
7 delta: PtrInt;
8 iRadiusX,iRadiusY: NativeInt;
9 factExtraX,factExtraY: NativeUInt;
10
11 procedure PrepareVerticals;
12 var
13 xb,yb: NativeInt;
14 psrc,p: PBGRAPixel;
15 pvert : PVertical;
16 a2: NativeUInt;
17 begin
18 fillchar(verticals^, width*sizeof(TVertical), 0);
19 psrc := FSource.ScanLine[FBounds.Top];
20 pvert := verticals;
21 if factExtraY = 0 then
22 begin
23 for xb := left to right-1 do
24 begin
25 p := psrc+xb;
26 for yb := 0 to iRadiusY-1 do
27 begin
28 if yb = height then break;
29 if p^.alpha <> 0 then
30 begin
31 a2 := p^.alpha;
32 {$HINTS OFF}
33 pvert^.red += p^.red * a2;
34 pvert^.green += p^.green * a2;
35 pvert^.blue += p^.blue * a2;
36 pvert^.alpha += a2;
37 {$HINTS ON}
38 end;
39 inc(pvert^.count);
40 PByte(p) += delta;
41 end;
42 inc(pvert);
43 end;
44 end else
45 begin
46 for xb := left to right-1 do
47 begin
48 p := psrc+xb;
49 for yb := 0 to iRadiusY-1 do
50 begin
51 if yb = height then break;
52 if p^.alpha <> 0 then
53 begin
54 a2 := p^.alpha * factMainY;
55 {$HINTS OFF}
56 pvert^.red += p^.red * a2;
57 pvert^.green += p^.green * a2;
58 pvert^.blue += p^.blue * a2;
59 pvert^.alpha += a2;
60 {$HINTS ON}
61 end;
62 inc(pvert^.count, factMainY);
63 PByte(p) += delta;
64 end;
65 if iRadiusY < height then
66 begin
67 if p^.alpha <> 0 then
68 begin
69 a2 := p^.alpha * factExtraY;
70 {$HINTS OFF}
71 pvert^.red += p^.red * a2;
72 pvert^.green += p^.green * a2;
73 pvert^.blue += p^.blue * a2;
74 pvert^.alpha += a2;
75 {$HINTS ON}
76 end;
77 inc(pvert^.count, factExtraY);
78 end;
79 inc(pvert);
80 end;
81 end;
82 end;
83
84 procedure NextVerticals(y: integer);
85 var
86 psrc0,psrc1,psrc2,psrc3: PBGRAPixel;
87 pvert : PVertical;
88 xb: NativeInt;
89 a2: NativeUInt;
90 begin
91 pvert := verticals;
92 if y-iRadiusY-1 >= FBounds.Top then
93 psrc1 := FSource.ScanLine[y-iRadiusY-1]+left
94 else
95 psrc1 := nil;
96 if y+iRadiusY < FBounds.Bottom then
97 psrc2 := FSource.ScanLine[y+iRadiusY]+left
98 else
99 psrc2 := nil;
100 if factExtraY = 0 then
101 begin
102 for xb := width-1 downto 0 do
103 begin
104 if psrc1 <> nil then
105 begin
106 if psrc1^.alpha <> 0 then
107 begin
108 {$HINTS OFF}
109 pvert^.red -= psrc1^.red * psrc1^.alpha;
110 pvert^.green -= psrc1^.green * psrc1^.alpha;
111 pvert^.blue -= psrc1^.blue * psrc1^.alpha;
112 pvert^.alpha -= psrc1^.alpha;
113 {$HINTS ON}
114 end;
115 dec(pvert^.count);
116 inc(psrc1);
117 end;
118 if psrc2 <> nil then
119 begin
120 if psrc2^.alpha <> 0 then
121 begin
122 {$HINTS OFF}
123 pvert^.red += psrc2^.red * psrc2^.alpha;
124 pvert^.green += psrc2^.green * psrc2^.alpha;
125 pvert^.blue += psrc2^.blue * psrc2^.alpha;
126 pvert^.alpha += psrc2^.alpha;
127 {$HINTS ON}
128 end;
129 inc(pvert^.count);
130 inc(psrc2);
131 end;
132 inc(pvert);
133 end;
134 end else
135 begin
136 if y-iRadiusY-2 >= FBounds.Top then
137 psrc0 := FSource.ScanLine[y-iRadiusY-2]+left
138 else
139 psrc0 := nil;
140 if y+iRadiusY+1 < FBounds.Bottom then
141 psrc3 := FSource.ScanLine[y+iRadiusY+1]+left
142 else
143 psrc3 := nil;
144 for xb := width-1 downto 0 do
145 begin
146 if psrc0 <> nil then
147 begin
148 if psrc0^.alpha <> 0 then
149 begin
150 a2 := psrc0^.alpha*factExtraY;
151 {$HINTS OFF}
152 pvert^.red -= psrc0^.red * a2;
153 pvert^.green -= psrc0^.green * a2;
154 pvert^.blue -= psrc0^.blue * a2;
155 pvert^.alpha -= a2;
156 {$HINTS ON}
157 end;
158 dec(pvert^.count,factExtraY);
159 inc(psrc0);
160 end;
161 if psrc1 <> nil then
162 begin
163 if psrc1^.alpha <> 0 then
164 begin
165 a2 := psrc1^.alpha*(factMainY - factExtraY);
166 {$HINTS OFF}
167 pvert^.red -= psrc1^.red * a2;
168 pvert^.green -= psrc1^.green * a2;
169 pvert^.blue -= psrc1^.blue * a2;
170 pvert^.alpha -= a2;
171 {$HINTS ON}
172 end;
173 dec(pvert^.count, factMainY - factExtraY);
174 inc(psrc1);
175 end;
176 if psrc2 <> nil then
177 begin
178 if psrc2^.alpha <> 0 then
179 begin
180 a2 := psrc2^.alpha*(factMainY - factExtraY);
181 {$HINTS OFF}
182 pvert^.red += psrc2^.red * a2;
183 pvert^.green += psrc2^.green * a2;
184 pvert^.blue += psrc2^.blue * a2;
185 pvert^.alpha += a2;
186 {$HINTS ON}
187 end;
188 inc(pvert^.count, factMainY - factExtraY);
189 inc(psrc2);
190 end;
191 if psrc3 <> nil then
192 begin
193 if psrc3^.alpha <> 0 then
194 begin
195 a2 := psrc3^.alpha*factExtraY;
196 {$HINTS OFF}
197 pvert^.red += psrc3^.red * a2;
198 pvert^.green += psrc3^.green * a2;
199 pvert^.blue += psrc3^.blue * a2;
200 pvert^.alpha += a2;
201 {$HINTS ON}
202 end;
203 inc(pvert^.count,factExtraY);
204 inc(psrc3);
205 end;
206 inc(pvert);
207 end;
208 end;
209 end;
210
211 procedure MainLoop;
212 var
213 xb,yb,xdest: NativeInt;
214 pdest: PBGRAPixel;
215 pvert : PVertical;
216 sumRed,sumGreen,sumBlue,sumAlpha,sumCount,
217 sumRed2,sumGreen2,sumBlue2,sumAlpha2,sumCount2,
218 sumRed3,sumGreen3,sumBlue3,sumAlpha3,sumCount3: TAccumulator;
219 begin
220 for yb := FBounds.Top to FBounds.Bottom-1 do
221 begin
222 NextVerticals(yb);
223 if GetShouldStop(yb) then exit;
224 pdest := Destination.ScanLine[yb]+left;
225 sumRed := 0;
226 sumGreen := 0;
227 sumBlue := 0;
228 sumAlpha := 0;
229 sumCount := 0;
230 pvert := verticals;
231 for xb := 0 to iRadiusX-1 do
232 begin
233 if xb = width then break;
234 sumRed += pvert^.red;
235 sumGreen += pvert^.green;
236 sumBlue += pvert^.blue;
237 sumAlpha += pvert^.alpha;
238 sumCount += pvert^.count;
239 inc(pvert);
240 end;
241 if factExtraX <> 0 then
242 begin
243 for xdest := 0 to width-1 do
244 begin
245 sumRed2 := 0;
246 sumGreen2 := 0;
247 sumBlue2 := 0;
248 sumAlpha2 := 0;
249 sumCount2 := 0;
250 if xdest-iRadiusX-1 >= 0 then
251 begin
252 pvert := verticals+(xdest-iRadiusX-1);
253 sumRed -= pvert^.red;
254 sumGreen -= pvert^.green;
255 sumBlue -= pvert^.blue;
256 sumAlpha -= pvert^.alpha;
257 sumCount -= pvert^.count;
258
259 sumRed2 += pvert^.red;
260 sumGreen2 += pvert^.green;
261 sumBlue2 += pvert^.blue;
262 sumAlpha2 += pvert^.alpha;
263 sumCount2 += pvert^.count;
264 end;
265 if xdest+iRadiusX < width then
266 begin
267 pvert := verticals+(xdest+iRadiusX);
268 sumRed += pvert^.red;
269 sumGreen += pvert^.green;
270 sumBlue += pvert^.blue;
271 sumAlpha += pvert^.alpha;
272 sumCount += pvert^.count;
273 end;
274 if xdest+iRadiusX+1 < width then
275 begin
276 pvert := verticals+(xdest+iRadiusX+1);
277 sumRed2 += pvert^.red;
278 sumGreen2 += pvert^.green;
279 sumBlue2 += pvert^.blue;
280 sumAlpha2 += pvert^.alpha;
281 sumCount2 += pvert^.count;
282 end;
283 sumAlpha3 := sumAlpha*factMainX + sumAlpha2*factExtraX;
284 sumCount3 := sumCount*factMainX + sumCount2*factExtraX;
285 if (sumAlpha3 >= (sumCount3+1) shr 1) and (sumCount3 > 0) then
286 begin
287 sumRed3 := sumRed*factMainX + sumRed2*factExtraX;
288 sumGreen3 := sumGreen*factMainX + sumGreen2*factExtraX;
289 sumBlue3 := sumBlue*factMainX + sumBlue2*factExtraX;
290 pdest^.red := (sumRed3+(sumAlpha3 shr 1)) div sumAlpha3;
291 pdest^.green := (sumGreen3+(sumAlpha3 shr 1)) div sumAlpha3;
292 pdest^.blue := (sumBlue3+(sumAlpha3 shr 1)) div sumAlpha3;
293 pdest^.alpha := (sumAlpha3+(sumCount3 shr 1)) div sumCount3;
294 end else
295 pdest^ := BGRAPixelTransparent;
296 inc(pdest);
297 end;
298 end else
299 begin
300 for xdest := 0 to width-1 do
301 begin
302 if xdest-iRadiusX-1 >= 0 then
303 begin
304 pvert := verticals+(xdest-iRadiusX-1);
305 sumRed -= pvert^.red;
306 sumGreen -= pvert^.green;
307 sumBlue -= pvert^.blue;
308 sumAlpha -= pvert^.alpha;
309 sumCount -= pvert^.count;
310 end;
311 if xdest+iRadiusX < width then
312 begin
313 pvert := verticals+(xdest+iRadiusX);
314 sumRed += pvert^.red;
315 sumGreen += pvert^.green;
316 sumBlue += pvert^.blue;
317 sumAlpha += pvert^.alpha;
318 sumCount += pvert^.count;
319 end;
320 if (sumAlpha >= (sumCount+1) shr 1) then
321 begin
322 pdest^.red := (sumRed+(sumAlpha shr 1)) div sumAlpha;
323 pdest^.green := (sumGreen+(sumAlpha shr 1)) div sumAlpha;
324 pdest^.blue := (sumBlue+(sumAlpha shr 1)) div sumAlpha;
325 pdest^.alpha := (sumAlpha+(sumCount shr 1)) div sumCount;
326 end else
327 pdest^ := BGRAPixelTransparent;
328 inc(pdest);
329 end;
330 end;
331 end;
332 end;
333
334begin
335 if (FBounds.Right <= FBounds.Left) or (FBounds.Bottom <= FBounds.Top) then exit;
336 iRadiusX := floor(FRadiusX+0.5/factMainX);
337 iRadiusY := floor(FRadiusY+0.5/factMainY);
338 factExtraX := trunc(frac(FRadiusX+0.5/factMainX)*factMainX);
339 factExtraY := trunc(frac(FRadiusY+0.5/factMainY)*factMainY);
340
341 if (iRadiusX <= 0) and (iRadiusY <= 0) and (factExtraX <= 0) and (factExtraY <= 0) then
342 begin
343 Destination.PutImagePart(FBounds.Left,FBounds.Top,FSource,FBounds,dmSet);
344 exit;
345 end;
346 left := FBounds.left;
347 right := FBounds.right;
348 width := right-left;
349 height := FBounds.bottom-FBounds.top;
350 delta := FSource.Width*SizeOf(TBGRAPixel);
351 if FSource.LineOrder = riloBottomToTop then delta := -delta;
352
353 getmem(verticals, width*sizeof(TVertical));
354 try
355 PrepareVerticals;
356 MainLoop;
357 finally
358 freemem(verticals);
359 end;
360end;
Note: See TracBrowser for help on using the repository browser.