source: trunk/Packages/bgrabitmap/bgrafilterscanner.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 25.1 KB
Line 
1unit BGRAFilterScanner;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8 Classes, BGRABitmapTypes, BGRAFilterType;
9
10type
11 { TBGRAFilterScannerGrayscale }
12 { Grayscale converts colored pixel into grayscale with same luminosity }
13 TBGRAFilterScannerGrayscale = class(TBGRAFilterScannerPixelwise)
14 class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel;
15 ACount: integer; AGammaCorrection: boolean); override;
16 end;
17
18 { TBGRAFilterScannerNegative }
19
20 TBGRAFilterScannerNegative = class(TBGRAFilterScannerPixelwise)
21 class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel;
22 ACount: integer; AGammaCorrection: boolean); override;
23 end;
24
25 { TBGRAFilterScannerSwapRedBlue }
26
27 TBGRAFilterScannerSwapRedBlue = class(TBGRAFilterScannerPixelwise)
28 class procedure ComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel;
29 ACount: integer; {%H-}AGammaCorrection: boolean); override;
30 end;
31
32 { TBGRAFilterScannerNormalize }
33 { Normalize compute min-max of specified channel and apply an affine transformation
34 to make it use the full range of values }
35 TBGRAFilterScannerNormalize = class(TBGRAFilterScannerPixelwise)
36 private
37 minValRed, maxValRed, minValGreen, maxValGreen,
38 minValBlue, maxValBlue, minAlpha, maxAlpha: word;
39 addValRed, addValGreen, addValBlue, addAlpha: word;
40 factorValRed, factorValGreen, factorValBlue, factorAlpha: int32or64;
41 procedure DetermineNormalizationFactors(ABounds: TRect; AEachChannel: boolean);
42 protected
43 procedure DoComputeFilterAt(ASource: PBGRAPixel; ADest: PBGRAPixel;
44 ACount: integer; {%H-}AGammaCorrection: boolean); override;
45 public
46 constructor Create(ASource: IBGRAScanner; AOffset: TPoint; ABounds: TRect;
47 AEachChannel: boolean);
48 class procedure ComputeFilterAt({%H-}ASource: PBGRAPixel; {%H-}ADest: PBGRAPixel;
49 {%H-}ACount: integer; {%H-}AGammaCorrection: boolean); override;
50 end;
51
52 { TBGRA3X3FilterScanner }
53
54 TBGRA3X3FilterScanner = class(TBGRAFilterScannerMultipixel)
55 protected
56 FSourceBorderColor,FDestinationBorderColor: TBGRAPixel;
57 FAutoSourceBorderColor: boolean;
58 function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; virtual; abstract;
59 procedure DoComputeFilter(BufferX: Integer;
60 const Buffers: array of PBGRAPixel; BufferWidth: integer;
61 ADest: PBGRAPixel; ACount: integer); override;
62 public
63 constructor Create(ASource: IBGRAScanner; ABounds: TRect); overload;
64 constructor Create(ASource: TBGRACustomBitmap); overload;
65 property SourceBorderColor: TBGRAPixel read FSourceBorderColor write FSourceBorderColor;
66 property DestinationBorderColor: TBGRAPixel read FDestinationBorderColor write FDestinationBorderColor;
67 property AutoSourceBorderColor: boolean read FAutoSourceBorderColor write FAutoSourceBorderColor;
68 end;
69
70 { TBGRAContourScanner }
71 { Filter contour compute a grayscale image, then for each pixel
72 calculates the difference with surrounding pixels (in intensity and alpha)
73 and draw black pixels when there is a difference }
74 TBGRAContourScanner = class(TBGRA3X3FilterScanner)
75 protected
76 FGammaCorrection: boolean;
77 FOpacity: byte;
78 function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override;
79 public
80 constructor Create(ASource: IBGRAScanner; ABounds: TRect;
81 AGammaCorrection: boolean = False); overload;
82 constructor Create(ASource: TBGRACustomBitmap;
83 AGammaCorrection: boolean = False); overload;
84 property Opacity: Byte read FOpacity write FOpacity;
85 end;
86
87 { TBGRASharpenScanner }
88
89 TBGRASharpenScanner = class(TBGRA3X3FilterScanner)
90 protected
91 FAmount: integer;
92 function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override;
93 public
94 constructor Create(ASource: IBGRAScanner; ABounds: TRect;
95 AAmount: integer = 256); overload;
96 constructor Create(ASource: TBGRACustomBitmap;
97 AAmount: integer = 256); overload;
98 end;
99
100 { TBGRAEmbossHightlightScanner }
101
102 TBGRAEmbossHightlightScanner = class(TBGRA3X3FilterScanner)
103 protected
104 FFillSelection: boolean;
105 FSourceChannel: TChannel;
106 FChannelOffset: Byte;
107 function DoFilter3X3(PTop,PMiddle,PBottom: PBGRAPixel): TBGRAPixel; override;
108 procedure SetSourceChannel(AValue: TChannel);
109 public
110 constructor Create(ASource: IBGRAScanner; ABounds: TRect; ABoundsVisible: Boolean); overload;
111 constructor Create(ASource: TBGRACustomBitmap; ABoundsVisible: Boolean); overload;
112 property FillSelection: boolean read FFillSelection write FFillSelection;
113 property SourceChannel: TChannel read FSourceChannel write SetSourceChannel;
114 end;
115
116implementation
117
118uses BGRABlend, math, SysUtils;
119
120{ TBGRAEmbossHightlightScanner }
121
122procedure TBGRAEmbossHightlightScanner.SetSourceChannel(AValue: TChannel);
123begin
124 FSourceChannel:=AValue;
125 case FSourceChannel of
126 cRed: FChannelOffset:= TBGRAPixel_RedByteOffset;
127 cGreen: FChannelOffset:= TBGRAPixel_GreenByteOffset;
128 cBlue: FChannelOffset:= TBGRAPixel_BlueByteOffset;
129 else {cAlpha:} FChannelOffset:= TBGRAPixel_AlphaByteOffset;
130 end;
131end;
132
133function TBGRAEmbossHightlightScanner.DoFilter3X3(PTop, PMiddle,
134 PBottom: PBGRAPixel): TBGRAPixel;
135var
136 sum: NativeInt;
137 slope,h: byte;
138 highlight: TBGRAPixel;
139begin
140 sum := NativeInt((PByte(PTop)+FChannelOffset)^) +
141 NativeInt((PByte(PTop+1)+FChannelOffset)^) +
142 NativeInt((PByte(PMiddle)+FChannelOffset)^) -
143 NativeInt((PByte(PMiddle+2)+FChannelOffset)^) -
144 NativeInt((PByte(PBottom+1)+FChannelOffset)^) -
145 NativeInt((PByte(PBottom+2)+FChannelOffset)^);
146 sum := 128 - sum div 3;
147 if sum > 255 then
148 slope := 255
149 else
150 if sum < 1 then
151 slope := 1
152 else
153 slope := sum;
154 h := (PByte(PMiddle+1)+FChannelOffset)^;
155
156 result.red := slope;
157 result.green := slope;
158 result.blue := slope;
159 result.alpha := abs(slope - 128) * 2;
160
161 if FFillSelection then
162 begin
163 highlight := BGRA(h shr 2, h shr 1, h, h shr 1);
164 if result.red < highlight.red then
165 result.red := highlight.red;
166 if result.green < highlight.green then
167 result.green := highlight.green;
168 if result.blue < highlight.blue then
169 result.blue := highlight.blue;
170 if result.alpha < highlight.alpha then
171 result.alpha := highlight.alpha;
172 end;
173end;
174
175constructor TBGRAEmbossHightlightScanner.Create(ASource: IBGRAScanner;
176 ABounds: TRect; ABoundsVisible: Boolean);
177begin
178 inherited Create(ASource,ABounds);
179 SourceChannel := cGreen;
180 FillSelection:= true;
181 AutoSourceBorderColor := not ABoundsVisible;
182end;
183
184constructor TBGRAEmbossHightlightScanner.Create(ASource: TBGRACustomBitmap;
185 ABoundsVisible: Boolean);
186begin
187 inherited Create(ASource);
188 SourceChannel := cGreen;
189 FillSelection:= true;
190 AutoSourceBorderColor := not ABoundsVisible;
191end;
192
193{ TBGRA3X3FilterScanner }
194
195procedure TBGRA3X3FilterScanner.DoComputeFilter(BufferX: Integer;
196 const Buffers: array of PBGRAPixel; BufferWidth: integer; ADest: PBGRAPixel;
197 ACount: integer);
198var MiddleX: Integer;
199 TopLine,MiddleLine,BottomLine: array[0..2] of TBGRAPixel;
200 PTop,PMiddle,PBottom: PBGRAPixel;
201 borderColor: TBGRAPixel;
202begin
203 if Buffers[1] = nil then
204 begin
205 FillDWord(ADest^, ACount, DWord(FDestinationBorderColor));
206 exit;
207 end;
208 MiddleX := BufferX+1;
209 while (ACount > 0) and (MiddleX < 0) do
210 begin
211 ADest^ := FDestinationBorderColor;
212 Dec(ACount);
213 Inc(ADest);
214 Inc(MiddleX);
215 end;
216 if (ACount > 0) and (MiddleX = 0) and (MiddleX < BufferWidth) then
217 begin
218 MiddleLine[1] := Buffers[1][MiddleX];
219 if AutoSourceBorderColor then borderColor := MiddleLine[1]
220 else borderColor := FSourceBorderColor;
221
222 TopLine[0] := borderColor;
223 MiddleLine[0] := borderColor;
224 BottomLine[0] := borderColor;
225 if Buffers[0] = nil then TopLine[1] := borderColor else TopLine[1] := Buffers[0][MiddleX];
226 if Buffers[2] = nil then BottomLine[1] := borderColor else BottomLine[1] := Buffers[2][MiddleX];
227 inc(MiddleX);
228 if MiddleX >= BufferWidth then
229 begin
230 TopLine[2] := borderColor;
231 MiddleLine[2] := borderColor;
232 BottomLine[2] := borderColor;
233 end else
234 begin
235 if Buffers[0] = nil then TopLine[2] := borderColor else TopLine[2] := Buffers[0][MiddleX];
236 MiddleLine[2] := Buffers[1][MiddleX];
237 if Buffers[2] = nil then BottomLine[2] := borderColor else BottomLine[2] := Buffers[2][MiddleX];
238 end;
239 ADest^ := DoFilter3X3(@TopLine,@MiddleLine,@BottomLine);
240 Dec(ACount);
241 Inc(ADest);
242 end;
243 if (Buffers[0]<>nil) and (Buffers[2]<>nil) then
244 begin
245 while (ACount > 0) and (MiddleX+1 < BufferWidth) do
246 begin
247 ADest^ := DoFilter3X3(@Buffers[0][MiddleX-1],@Buffers[1][MiddleX-1],@Buffers[2][MiddleX-1]);
248 Inc(MiddleX);
249 Dec(ACount);
250 Inc(ADest);
251 end;
252 end else
253 begin
254 if not AutoSourceBorderColor then
255 begin
256 TopLine[0] := FSourceBorderColor;
257 TopLine[1] := FSourceBorderColor;
258 TopLine[2] := FSourceBorderColor;
259 BottomLine[0] := FSourceBorderColor;
260 BottomLine[1] := FSourceBorderColor;
261 BottomLine[2] := FSourceBorderColor;
262 end;
263 while (ACount > 0) and (MiddleX+1 < BufferWidth) do
264 begin
265 PMiddle:= @Buffers[1][MiddleX-1];
266 if Buffers[0] = nil then
267 begin
268 if AutoSourceBorderColor then
269 begin
270 TopLine[0] := PMiddle[1];
271 TopLine[1] := PMiddle[1];
272 TopLine[2] := PMiddle[1];
273 end;
274 PTop := @TopLine;
275 end
276 else PTop := @Buffers[0][MiddleX-1];
277 if Buffers[2] = nil then
278 begin
279 if AutoSourceBorderColor then
280 begin
281 BottomLine[0] := PMiddle[1];
282 BottomLine[1] := PMiddle[1];
283 BottomLine[2] := PMiddle[1];
284 end;
285 PBottom := @BottomLine;
286 end
287 else PBottom := @Buffers[2][MiddleX-1];
288 ADest^ := DoFilter3X3(PTop,PMiddle,PBottom);
289 Inc(MiddleX);
290 Dec(ACount);
291 Inc(ADest);
292 end;
293 end;
294 if (ACount > 0) and (MiddleX < BufferWidth) then
295 begin
296 MiddleLine[1] := Buffers[1][MiddleX];
297 if AutoSourceBorderColor then borderColor := MiddleLine[1]
298 else borderColor := FSourceBorderColor;
299
300 if Buffers[0] = nil then TopLine[0] := borderColor else TopLine[0] := Buffers[0][MiddleX-1];
301 MiddleLine[0] := Buffers[1][MiddleX-1];
302 if Buffers[2] = nil then BottomLine[0] := borderColor else BottomLine[0] := Buffers[2][MiddleX-1];
303 if Buffers[0] = nil then TopLine[1] := borderColor else TopLine[1] := Buffers[0][MiddleX];
304 if Buffers[2] = nil then BottomLine[1] := borderColor else BottomLine[1] := Buffers[2][MiddleX];
305 inc(MiddleX);
306 if MiddleX >= BufferWidth then
307 begin
308 TopLine[2] := borderColor;
309 MiddleLine[2] := borderColor;
310 BottomLine[2] := borderColor;
311 end else
312 begin
313 if Buffers[0] = nil then TopLine[2] := borderColor else TopLine[2] := Buffers[0][MiddleX];
314 MiddleLine[2] := Buffers[1][MiddleX];
315 if Buffers[2] = nil then BottomLine[2] := borderColor else BottomLine[2] := Buffers[2][MiddleX];
316 end;
317 ADest^ := DoFilter3X3(@TopLine,@MiddleLine,@BottomLine);
318 Dec(ACount);
319 Inc(ADest);
320 end;
321 while (ACount > 0) do
322 begin
323 ADest^ := FDestinationBorderColor;
324 Dec(ACount);
325 Inc(ADest);
326 end;
327end;
328
329constructor TBGRA3X3FilterScanner.Create(ASource: IBGRAScanner;
330 ABounds: TRect);
331begin
332 inherited Create(ASource,ABounds,Point(-1,-1),3,3);
333 FSourceBorderColor := BGRAPixelTransparent;
334 FDestinationBorderColor := BGRAPixelTransparent;
335 FAutoSourceBorderColor := False;
336end;
337
338constructor TBGRA3X3FilterScanner.Create(ASource: TBGRACustomBitmap);
339begin
340 inherited Create(ASource,Rect(0,0,ASource.Width,ASource.Height),Point(-1,-1),3,3);
341 FSourceBorderColor := BGRAPixelTransparent;
342 FDestinationBorderColor := BGRAPixelTransparent;
343 FAutoSourceBorderColor := False;
344 AllowDirectRead := true;
345end;
346
347{ TBGRASharpenScanner }
348
349function TBGRASharpenScanner.DoFilter3X3(PTop, PMiddle, PBottom: PBGRAPixel): TBGRAPixel;
350var
351 sumR, sumG, sumB, sumA, nbA: NativeUInt;
352 refPixel: TBGRAPixel;
353 rgbDivShr1: NativeUint;
354begin
355 if FAmount = 0 then
356 begin
357 result := PMiddle[1];
358 exit;
359 end;
360 //compute sum
361 sumR := 0;
362 sumG := 0;
363 sumB := 0;
364 sumA := 0;
365 //RGBdiv := 0;
366 nbA := 0;
367
368 {$hints off}
369 with PTop[0] do if alpha <> 0 then begin sumR += red * alpha; sumG += green * alpha; sumB += blue * alpha; sumA += alpha; inc(nbA); end;
370 with PTop[1] do if alpha <> 0 then begin sumR += red * alpha; sumG += green * alpha; sumB += blue * alpha; sumA += alpha; inc(nbA); end;
371 with PTop[2] do if alpha <> 0 then begin sumR += red * alpha; sumG += green * alpha; sumB += blue * alpha; sumA += alpha; inc(nbA); end;
372 with PMiddle[0] do if alpha <> 0 then begin sumR += red * alpha; sumG += green * alpha; sumB += blue * alpha; sumA += alpha; inc(nbA); end;
373 with PMiddle[2] do if alpha <> 0 then begin sumR += red * alpha; sumG += green * alpha; sumB += blue * alpha; sumA += alpha; inc(nbA); end;
374 with PBottom[0] do if alpha <> 0 then begin sumR += red * alpha; sumG += green * alpha; sumB += blue * alpha; sumA += alpha; inc(nbA); end;
375 with PBottom[1] do if alpha <> 0 then begin sumR += red * alpha; sumG += green * alpha; sumB += blue * alpha; sumA += alpha; inc(nbA); end;
376 with PBottom[2] do if alpha <> 0 then begin sumR += red * alpha; sumG += green * alpha; sumB += blue * alpha; sumA += alpha; inc(nbA); end;
377 {$hints on}
378
379 //we finally have an average pixel
380 if (sumA = 0) then
381 refPixel := BGRAPixelTransparent
382 else
383 begin
384 rgbDivShr1:= sumA shr 1;
385 refPixel.red := (sumR + rgbDivShr1) div sumA;
386 refPixel.green := (sumG + rgbDivShr1) div sumA;
387 refPixel.blue := (sumB + rgbDivShr1) div sumA;
388 refPixel.alpha := (sumA + nbA shr 1) div nbA;
389 end;
390
391 //read the pixel at the center of the square
392 if refPixel <> BGRAPixelTransparent then
393 begin
394 with PMiddle[1] do
395 begin
396 //compute sharpened pixel by adding the difference
397 if FAmount<>256 then
398 result := BGRA( max(0, min($FFFF, Int32or64(red shl 8) +
399 FAmount*(red - refPixel.red))) shr 8,
400 max(0, min($FFFF, Int32or64(green shl 8) +
401 FAmount*(green - refPixel.green))) shr 8,
402 max(0, min($FFFF, Int32or64(blue shl 8) +
403 FAmount*(blue - refPixel.blue))) shr 8,
404 max(0, min($FFFF, Int32or64(alpha shl 8) +
405 FAmount*(alpha - refPixel.alpha))) shr 8 )
406 else
407 result := BGRA( max(0, min(255, (red shl 1) - refPixel.red)),
408 max(0, min(255, (green shl 1) - refPixel.green)),
409 max(0, min(255, (blue shl 1) - refPixel.blue)),
410 max(0, min(255, (alpha shl 1) - refPixel.alpha)));
411 end;
412 end else
413 result := PMiddle[1];
414end;
415
416constructor TBGRASharpenScanner.Create(ASource: IBGRAScanner;
417 ABounds: TRect; AAmount: integer);
418begin
419 inherited Create(ASource,ABounds);
420 FAmount:= AAmount;
421end;
422
423constructor TBGRASharpenScanner.Create(ASource: TBGRACustomBitmap;
424 AAmount: integer);
425begin
426 inherited Create(ASource);
427 FAmount:= AAmount;
428end;
429
430{ TBGRAContourScanner }
431
432function TBGRAContourScanner.DoFilter3X3(PTop, PMiddle, PBottom: PBGRAPixel): TBGRAPixel;
433var
434 sum: NativeInt;
435 slope: byte;
436begin
437 if FGammaCorrection then
438 begin
439 sum := (FastBGRAExpandedDiff(PTop[0],PBottom[2]) + FastBGRAExpandedDiff(PTop[1],PBottom[1]) +
440 FastBGRAExpandedDiff(PTop[2],PBottom[0]) + FastBGRAExpandedDiff(PMiddle[0],PMiddle[2])) div 3;
441
442 if sum >= 65535 then
443 slope := 0
444 else if sum <= 0 then
445 slope := 255
446 else slope := GammaCompressionTab[65535-sum];
447 end else
448 begin
449 sum := (FastBGRALinearDiff(PTop[0],PBottom[2]) + FastBGRALinearDiff(PTop[1],PBottom[1]) +
450 FastBGRALinearDiff(PTop[2],PBottom[0]) + FastBGRALinearDiff(PMiddle[0],PMiddle[2])) div 3;
451
452 if sum >= 255 then
453 slope := 0
454 else if sum < 0 then
455 slope := 255
456 else slope := 255-sum;
457 end;
458 result.red := slope;
459 result.green := slope;
460 result.blue := slope;
461 result.alpha := FOpacity;
462end;
463
464constructor TBGRAContourScanner.Create(ASource: IBGRAScanner;
465 ABounds: TRect; AGammaCorrection: boolean);
466begin
467 inherited Create(ASource,ABounds);
468 FGammaCorrection := AGammaCorrection;
469 AutoSourceBorderColor:= True;
470 FOpacity:= 255;
471end;
472
473constructor TBGRAContourScanner.Create(ASource: TBGRACustomBitmap;
474 AGammaCorrection: boolean);
475begin
476 inherited Create(ASource);
477 FGammaCorrection := AGammaCorrection;
478 AutoSourceBorderColor:= True;
479 FOpacity:= 255;
480end;
481
482{ TBGRAFilterScannerNormalize }
483
484procedure TBGRAFilterScannerNormalize.DetermineNormalizationFactors(ABounds: TRect; AEachChannel: boolean);
485var
486 buffer: TBGRAPixelBuffer;
487 p: PBGRAPixel;
488 c: TExpandedPixel;
489 yb, xb: LongInt;
490begin
491 if (ABounds.Right <= ABounds.Left) or (ABounds.Bottom <= ABounds.Top) then
492 begin
493 addValRed := 0;
494 addValGreen := 0;
495 addValBlue := 0;
496 addAlpha := 0;
497 factorValRed := 4096;
498 factorValGreen := 4096;
499 factorValBlue := 4096;
500 factorAlpha := 4096;
501 exit;
502 end;
503 maxValRed := 0;
504 minValRed := 65535;
505 maxValGreen := 0;
506 minValGreen := 65535;
507 maxValBlue := 0;
508 minValBlue := 65535;
509 maxAlpha := 0;
510 minAlpha := 65535;
511 buffer := nil;
512 for yb := ABounds.Top to ABounds.Bottom do
513 begin
514 if Source.ProvidesScanline(rect(ABounds.Left,yb,ABounds.Right,yb+1)) then
515 p := Source.GetScanlineAt(ABounds.Left,yb)
516 else
517 begin
518 Source.ScanMoveTo(ABounds.Left,yb);
519 AllocateBGRAPixelBuffer(buffer, ABounds.Right-ABounds.Left);
520 p := @buffer[0];
521 ScannerPutPixels(Source,p,ABounds.Right-ABounds.Left,dmSet);
522 end;
523 for xb := ABounds.Right-ABounds.Left-1 downto 0 do
524 begin
525 c := GammaExpansion(p[xb]);
526 if c.red > maxValRed then
527 maxValRed := c.red;
528 if c.green > maxValGreen then
529 maxValGreen := c.green;
530 if c.blue > maxValBlue then
531 maxValBlue := c.blue;
532 if c.red < minValRed then
533 minValRed := c.red;
534 if c.green < minValGreen then
535 minValGreen := c.green;
536 if c.blue < minValBlue then
537 minValBlue := c.blue;
538 if c.alpha > maxAlpha then
539 maxAlpha := c.alpha;
540 if c.alpha < minAlpha then
541 minAlpha := c.alpha;
542 end;
543 end;
544 if not AEachChannel then
545 begin
546 minValRed := min(min(minValRed, minValGreen), minValBlue);
547 maxValRed := max(max(maxValRed, maxValGreen), maxValBlue);
548 minValGreen := minValRed;
549 maxValGreen := maxValRed;
550 minValBlue := minValBlue;
551 maxValBlue := maxValBlue;
552 end;
553 if maxValRed > minValRed then
554 begin
555 factorValRed := 268431360 div (maxValRed - minValRed);
556 addValRed := 0;
557 end else
558 begin
559 factorValRed := 0;
560 if minValRed = 0 then
561 addValRed := 0
562 else addValRed := 65535;
563 end;
564 if maxValGreen > minValGreen then
565 begin
566 factorValGreen := 268431360 div (maxValGreen - minValGreen);
567 addValGreen := 0;
568 end else
569 begin
570 factorValGreen := 0;
571 if minValGreen = 0 then
572 addValGreen := 0
573 else addValGreen := 65535;
574 end;
575 if maxValBlue > minValBlue then
576 begin
577 factorValBlue := 268431360 div (maxValBlue - minValBlue);
578 addValBlue := 0;
579 end else
580 begin
581 factorValBlue := 0;
582 if minValBlue = 0 then
583 addValBlue := 0 else
584 addValBlue := 65535;
585 end;
586 if maxAlpha > minAlpha then
587 begin
588 factorAlpha := 268431360 div (maxAlpha - minAlpha);
589 addAlpha := 0;
590 end else
591 begin
592 factorAlpha := 0;
593 if minAlpha = 0 then
594 addAlpha := 0 else
595 addAlpha := 65535;
596 end;
597end;
598
599procedure TBGRAFilterScannerNormalize.DoComputeFilterAt(ASource: PBGRAPixel;
600 ADest: PBGRAPixel; ACount: integer; AGammaCorrection: boolean);
601var
602 c: TExpandedPixel;
603begin
604 While ACount > 0 do
605 begin
606 c := GammaExpansion(ASource^);
607 Inc(ASource);
608 c.red := ((c.red - minValRed) * factorValRed + 2047) shr 12 + addValRed;
609 c.green := ((c.green - minValGreen) * factorValGreen + 2047) shr 12 + addValGreen;
610 c.blue := ((c.blue - minValBlue) * factorValBlue + 2047) shr 12 + addValBlue;
611 c.alpha := ((c.alpha - minAlpha) * factorAlpha + 2047) shr 12 + addAlpha;
612 ADest^ := GammaCompression(c);
613 Inc(ADest);
614 dec(ACount);
615 end;
616end;
617
618constructor TBGRAFilterScannerNormalize.Create(ASource: IBGRAScanner;
619 AOffset: TPoint; ABounds: TRect; AEachChannel: boolean);
620begin
621 inherited Create(ASource,AOffset,True);
622 DetermineNormalizationFactors(ABounds, AEachChannel);
623end;
624
625class procedure TBGRAFilterScannerNormalize.ComputeFilterAt(
626 ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer;
627 AGammaCorrection: boolean);
628begin
629 raise exception.Create('Normalize filter scanner cannot be called as a class procedure');
630end;
631
632{ TBGRAFilterScannerSwapRedBlue }
633
634class procedure TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(
635 ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer;
636 AGammaCorrection: boolean);
637const RedMask = 255 shl TBGRAPixel_RedShift;
638 BlueMask = 255 shl TBGRAPixel_BlueShift;
639 GreenAndAlphaMask = (255 shl TBGRAPixel_GreenShift) or (255 shl TBGRAPixel_AlphaShift);
640 RedMask64 = RedMask or (RedMask shl 32);
641 BlueMask64 = BlueMask or (BlueMask shl 32);
642 GreenAndAlphaMask64 = GreenAndAlphaMask or (GreenAndAlphaMask shl 32);
643var
644 temp: longword;
645 temp64: QWord;
646 oddN: boolean;
647begin
648 {$PUSH}{$WARNINGS OFF}
649 if ACount <= 0 then exit;
650 oddN := odd(ACount);
651 ACount := ACount shr 1;
652 if TBGRAPixel_RedShift > TBGRAPixel_BlueShift then
653 while ACount > 0 do
654 begin
655 temp64 := PQWord(ASource)^;
656 PQWord(ADest)^ := ((temp64 and BlueMask64) shl (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or
657 ((temp64 and RedMask64) shr (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or
658 (temp64 and GreenAndAlphaMask64);
659 dec(ACount);
660 inc(ASource,2);
661 inc(ADest,2);
662 end else
663 while ACount > 0 do
664 begin
665 temp64 := PQWord(ASource)^;
666 PQWord(ADest)^ := ((temp64 and BlueMask64) shr (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or
667 ((temp64 and RedMask64) shl (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or
668 (temp64 and GreenAndAlphaMask64);
669 dec(ACount);
670 inc(ASource,2);
671 inc(ADest,2);
672 end;
673 if oddN then
674 begin
675 if TBGRAPixel_RedShift > TBGRAPixel_BlueShift then
676 begin
677 temp := PDWord(ASource)^;
678 PDWord(ADest)^ := ((temp and BlueMask) shl (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or
679 ((temp and RedMask) shr (TBGRAPixel_RedShift-TBGRAPixel_BlueShift)) or
680 (temp and GreenAndAlphaMask);
681 end else
682 begin
683 temp := PDWord(ASource)^;
684 PDWord(ADest)^ := ((temp and BlueMask) shr (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or
685 ((temp and RedMask) shl (TBGRAPixel_BlueShift-TBGRAPixel_RedShift)) or
686 (temp and GreenAndAlphaMask);
687 end;
688 end;
689 {$POP}
690end;
691
692{ TBGRAFilterScannerNegative }
693
694class procedure TBGRAFilterScannerNegative.ComputeFilterAt(
695 ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer;
696 AGammaCorrection: boolean);
697begin
698 if ADest = ASource then
699 begin
700 if AGammaCorrection then
701 while ACount > 0 do
702 begin
703 with ADest^ do
704 if alpha <> 0 then
705 begin
706 ADest^.red := GammaCompressionTab[not GammaExpansionTab[red]];
707 ADest^.green := GammaCompressionTab[not GammaExpansionTab[green]];
708 ADest^.blue := GammaCompressionTab[not GammaExpansionTab[blue]];
709 end;
710 Inc(ADest);
711 dec(ACount);
712 end else
713 while ACount > 0 do
714 begin
715 if ADest^.alpha <> 0 then
716 DWord(ADest^) := DWord(ADest^) xor ($ffffffff and not ($ff shl TBGRAPixel_AlphaShift));
717 Inc(ADest);
718 dec(ACount);
719 end;
720 end else
721 if AGammaCorrection then
722 while ACount > 0 do
723 begin
724 with ASource^ do
725 if alpha = 0 then
726 ADest^ := BGRAPixelTransparent
727 else
728 begin
729 ADest^.red := GammaCompressionTab[not GammaExpansionTab[red]];
730 ADest^.green := GammaCompressionTab[not GammaExpansionTab[green]];
731 ADest^.blue := GammaCompressionTab[not GammaExpansionTab[blue]];
732 ADest^.alpha := alpha;
733 end;
734 inc(ASource);
735 Inc(ADest);
736 dec(ACount);
737 end else
738 while ACount > 0 do
739 begin
740 if ASource^.alpha = 0 then
741 ADest^ := BGRAPixelTransparent
742 else
743 DWord(ADest^) := DWord(ASource^) xor ($ffffffff and not ($ff shl TBGRAPixel_AlphaShift));
744 inc(ASource);
745 Inc(ADest);
746 dec(ACount);
747 end;
748end;
749
750{ TBGRAFilterScannerGrayscale }
751
752class procedure TBGRAFilterScannerGrayscale.ComputeFilterAt(
753 ASource: PBGRAPixel; ADest: PBGRAPixel; ACount: integer;
754 AGammaCorrection: boolean);
755begin
756 if ASource = ADest then
757 begin
758 if AGammaCorrection then
759 while ACount > 0 do
760 begin
761 if ADest^.alpha <> 0 then
762 ADest^ := BGRAToGrayscale(ADest^);
763 Inc(ADest);
764 dec(ACount);
765 end else
766 while ACount > 0 do
767 begin
768 if ADest^.alpha <> 0 then
769 ADest^ := BGRAToGrayscaleLinear(ADest^);
770 Inc(ADest);
771 dec(ACount);
772 end;
773 end else
774 if AGammaCorrection then
775 while ACount > 0 do
776 begin
777 ADest^ := BGRAToGrayscale(ASource^);
778 inc(ASource);
779 Inc(ADest);
780 dec(ACount);
781 end else
782 while ACount > 0 do
783 begin
784 ADest^ := BGRAToGrayscaleLinear(ASource^);
785 inc(ASource);
786 Inc(ADest);
787 dec(ACount);
788 end;
789end;
790
791end.
792
Note: See TracBrowser for help on using the repository browser.