1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRAGrayscaleMask;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 BGRAClasses, BGRAGraphics, SysUtils, BGRABitmapTypes, BGRAResample, {%H-}UniversalDrawer;
10
11 type
12 { TGrayscaleMask }
13
14 TGrayscaleMask = class(specialize TGenericUniversalBitmap<TByteMask,TByteMaskColorspace>)
15 private
GetScanLinenull16 function GetScanLine(Y: Integer): PByte; inline;
17 protected
InternalNewnull18 function InternalNew: TCustomUniversalBitmap; override;
19 procedure AssignTransparentPixel(out ADest); override;
InternalGetPixelCycle256null20 function InternalGetPixelCycle256(ix,iy: int32or64; iFactX,iFactY: int32or64): TByteMask;
InternalGetPixel256null21 function InternalGetPixel256(ix,iy: int32or64; iFactX,iFactY: int32or64; smoothBorder: boolean): TByteMask;
22 procedure Init; override;
23 public
24 ScanInterpolationFilter: TResampleFilter;
25
26 constructor Create(AWidth,AHeight: Integer; AValue: byte); overload;
27 constructor Create(ABitmap: TBGRACustomBitmap; AChannel: TChannel); overload;
28 constructor CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth,AHeight: integer);
29 constructor CreateDownSample(ABitmap: TGrayscaleMask; AWidth,AHeight: integer);
30 constructor CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth,AHeight: integer; ASourceRect: TRect);
31 constructor CreateDownSample(ABitmap: TGrayscaleMask; AWidth,AHeight: integer; ASourceRect: TRect);
32 procedure CopyFrom(ABitmap: TGrayscaleMask); overload;
33 procedure CopyFrom(ABitmap: TBGRACustomBitmap; AChannel: TChannel); overload;
34 procedure CopyPropertiesTo(ABitmap: TCustomUniversalBitmap); override;
GetImageBoundsnull35 function GetImageBounds: TRect; overload; override;
GetImageBoundsWithinnull36 function GetImageBoundsWithin(const ARect: TRect; Channel: TChannel = cAlpha; ANothingValue: Byte = 0): TRect; overload; override;
GetImageBoundsWithinnull37 function GetImageBoundsWithin(const ARect: TRect; Channels: TChannels; ANothingValue: Byte = 0): TRect; overload; override;
38
39 class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TByteMask; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
40 class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency;
41 AOffsetX: integer = 0; AOffsetY: integer = 0); override;
42 class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner;
43 AOffsetX: integer = 0; AOffsetY: integer = 0); override;
44 class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override;
45 class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override;
46
47 procedure Draw(ABitmap: TBGRACustomBitmap; X,Y: Integer; AGammaCorrection: boolean = false);
48 procedure DrawAsAlpha(ABitmap: TBGRACustomBitmap; X,Y: Integer; const c: TBGRAPixel); overload;
49 procedure DrawAsAlpha(ABitmap: TBGRACustomBitmap; X,Y: Integer; texture: IBGRAScanner); overload;
GetPixelnull50 function GetPixel(X,Y: integer): byte; overload;
51 procedure SetPixel(X,Y: integer; AValue: byte);
52 property ScanLine[Y: Integer]: PByte read GetScanLine;
53 property Data: PByte read FDataByte;
54
GetPixelnull55 function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TByteMask; overload;
GetPixel256null56 function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TByteMask;
57
58 procedure ScanNextMaskChunk(var ACount: integer; out AMask: PByteMask; out AStride: integer); override;
ScanAtIntegerMasknull59 function ScanAtIntegerMask(X,Y: integer): TByteMask; override;
ScanAtMasknull60 function ScanAtMask(X,Y: Single): TByteMask; override;
ScanAtIntegernull61 function ScanAtInteger(X, Y: integer): TBGRAPixel; override;
ScanAtnull62 function ScanAt(X, Y: Single): TBGRAPixel; override;
63
64 {inplace filters}
65 procedure Negative;
66 procedure NegativeRect(ABounds: TRect);
67 procedure InplaceNormalize; overload;
68 procedure InplaceNormalize(ABounds: TRect); overload;
69
70 //return type helpers
NewBitmapnull71 function NewBitmap: TGrayscaleMask; overload; override;
NewBitmapnull72 function NewBitmap(AWidth, AHeight: integer): TGrayscaleMask; overload; override;
NewBitmapnull73 function NewBitmap(AWidth, AHeight: integer; const Color: TByteMask): TGrayscaleMask; overload; override;
NewBitmapnull74 function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TGrayscaleMask; overload; override;
NewReferencenull75 function NewReference: TGrayscaleMask; override;
GetUniquenull76 function GetUnique: TGrayscaleMask; override;
Duplicatenull77 function Duplicate(DuplicateProperties: Boolean = False): TGrayscaleMask; overload; override;
GetPartnull78 function GetPart(const ARect: TRect): TGrayscaleMask; override;
CreateBrushTexturenull79 function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TByteMask;
80 AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TGrayscaleMask; override;
RotateCWnull81 function RotateCW: TGrayscaleMask; override;
RotateCCWnull82 function RotateCCW: TGrayscaleMask; override;
RotateUDnull83 function RotateUD: TGrayscaleMask; override;
FilterContournull84 function FilterContour(ABorderValue: byte = 0): TGrayscaleMask;
FilterBlurRadialnull85 function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override;
FilterBlurRadialnull86 function FilterBlurRadial(const ABounds: TRect; radius: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override;
FilterBlurRadialnull87 function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override;
FilterBlurRadialnull88 function FilterBlurRadial(const ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TGrayscaleMask; overload; override;
FilterBlurMotionnull89 function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TGrayscaleMask; overload; override;
FilterBlurMotionnull90 function FilterBlurMotion(const ABounds: TRect; distance: single; angle: single; oriented: boolean): TGrayscaleMask; overload; override;
FilterCustomBlurnull91 function FilterCustomBlur(mask: TCustomUniversalBitmap): TGrayscaleMask; overload; override;
FilterCustomBlurnull92 function FilterCustomBlur(const ABounds: TRect; mask: TCustomUniversalBitmap): TGrayscaleMask; overload; override;
FilterSpherenull93 function FilterSphere: TGrayscaleMask;
FilterCylindernull94 function FilterCylinder: TGrayscaleMask;
95 end;
96
97 procedure DownSamplePutImageGrayscale(sourceData: PByte; sourcePixelSize: Int32or64; sourceRowDelta: Int32or64; sourceWidth, sourceHeight: Int32or64; dest: TGrayscaleMask; ADestRect: TRect); overload;
98 procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; dest: TGrayscaleMask; ADestRect: TRect); overload;
99 procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; dest: TGrayscaleMask; ADestRect: TRect); overload;
100 procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap; dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect); overload;
101 procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect); overload;
102
103 procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,
104 y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel;
105 texture: IBGRAScanner; RGBOrder: boolean);
106
107 const
108 ByteMaskBlack : TByteMask = (gray:0);
109 ByteMaskWhite : TByteMask = (gray:255);
110
111 operator = (const c1, c2: TByteMask): boolean; inline;
112
113 implementation
114
115 uses BGRABlend, BGRATransform;
116
117 operator = (const c1, c2: TByteMask): boolean;
118 begin
119 result := c1.gray = c2.gray;
120 end;
121
122 procedure BGRAFillClearTypeGrayscaleMask(dest: TBGRACustomBitmap; x,
123 y: integer; xThird: integer; mask: TGrayscaleMask; color: TBGRAPixel;
124 texture: IBGRAScanner; RGBOrder: boolean);
125 var delta: Int32or64;
126 begin
127 delta := mask.Width;
128 BGRABlend.BGRAFillClearTypeMaskPtr(dest,x,y,xThird,mask.ScanLineByte[0],1,delta,mask.Width,mask.Height,color,texture,RGBOrder);
129 end;
130
131 procedure ByteMaskSolidBrushSkipPixels({%H-}AFixedData: Pointer;
132 AContextData: PUniBrushContext; {%H-}AAlpha: Word; ACount: integer);
133 begin
134 inc(PByteMask(AContextData^.Dest), ACount);
135 end;
136
137 procedure ByteMaskChunkSetPixels(
138 ASource: PByteMask; ADest: PByteMask;
139 AAlpha: Word; ACount: integer; ASourceStride: integer); inline;
140 var
141 alphaOver: UInt32or64;
142 begin
143 if AAlpha=0 then exit;
144 if AAlpha=65535 then
145 begin
146 if ASourceStride = 1 then
147 begin
148 move(ASource^, ADest^, ACount);
149 inc(ASource, ACount);
150 end else
151 while ACount > 0 do
152 begin
153 ADest^ := ASource^;
154 inc(ADest);
155 dec(ACount);
156 inc(PByte(ASource), ASourceStride);
157 end;
158 end else
159 begin
160 if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha;
161 while ACount > 0 do
162 begin
163 ADest^.gray := (ADest^.gray*UInt32or64(65536-alphaOver) + ASource^.gray*alphaOver + 32768) shr 16;
164 inc(ADest);
165 dec(ACount);
166 inc(PByte(ASource), ASourceStride);
167 end;
168 end;
169 end;
170
171 procedure ByteMaskChunkXorPixels(
172 ASource: PByteMask; ADest: PByteMask;
173 AAlpha: Word; ACount: integer; ASourceStride: integer); inline;
174 var
175 alphaOver: UInt32or64;
176 temp: Byte;
177 begin
178 if AAlpha=0 then exit;
179 if AAlpha=65535 then
180 begin
181 if ASourceStride = 1 then
182 begin
183 move(ASource^, ADest^, ACount);
184 inc(ASource, ACount);
185 end else
186 while ACount > 0 do
187 begin
188 ADest^.gray := ADest^.gray xor ASource^.gray;
189 inc(ADest);
190 dec(ACount);
191 inc(PByte(ASource), ASourceStride);
192 end;
193 end else
194 begin
195 if AAlpha > 32768 then alphaOver := AAlpha+1 else alphaOver := AAlpha;
196 while ACount > 0 do
197 begin
198 temp := ADest^.gray xor ASource^.gray;
199 ADest^.gray := (ADest^.gray*UInt32or64(65536-alphaOver) + temp*alphaOver + 32768) shr 16;
200 inc(ADest);
201 dec(ACount);
202 inc(PByte(ASource), ASourceStride);
203 end;
204 end;
205 end;
206
207 procedure ByteMaskSolidBrushSetPixels(AFixedData: Pointer;
208 AContextData: PUniBrushContext; AAlpha: Word; ACount: integer);
209 var
210 pDest: PByteMask;
211 begin
212 pDest := PByteMask(AContextData^.Dest);
213 ByteMaskChunkSetPixels( PByteMask(AFixedData), pDest, AAlpha, ACount, 0);
214 inc(pDest, ACount);
215 AContextData^.Dest := pDest;
216 end;
217
218 procedure ByteMaskSolidBrushXorPixels(AFixedData: Pointer;
219 AContextData: PUniBrushContext; AAlpha: Word; ACount: integer);
220 var
221 pDest: PByteMask;
222 begin
223 pDest := PByteMask(AContextData^.Dest);
224 ByteMaskChunkXorPixels( PByteMask(AFixedData), pDest, AAlpha, ACount, 0);
225 inc(pDest, ACount);
226 AContextData^.Dest := pDest;
227 end;
228
229 type
230 PByteMaskScannerBrushFixedData = ^TByteMaskScannerBrushFixedData;
231 TByteMaskScannerBrushFixedData = record
232 Scanner: Pointer; //avoid ref count by using pointer type
233 OffsetX, OffsetY: integer;
234 Conversion: TBridgedConversion;
235 end;
236
237 procedure ByteMaskScannerBrushInitContext(AFixedData: Pointer;
238 AContextData: PUniBrushContext);
239 begin
240 with PByteMaskScannerBrushFixedData(AFixedData)^ do
241 IBGRAScanner(Scanner).ScanMoveTo(AContextData^.Ofs.X + OffsetX,
242 AContextData^.Ofs.Y + OffsetY);
243 end;
244
245 procedure ByteMaskScannerConvertBrushSetPixels(AFixedData: Pointer;
246 AContextData: PUniBrushContext; AAlpha: Word; ACount: integer);
247 var
248 psrc: Pointer;
249 pDest: PByteMask;
250 qty, pixSize: Integer;
251 buf: packed array[0..31] of TByteMask;
252 begin
253 with PByteMaskScannerBrushFixedData(AFixedData)^ do
254 begin
255 if AAlpha = 0 then
256 begin
257 inc(PByteMask(AContextData^.Dest), ACount);
258 IBGRAScanner(Scanner).ScanSkipPixels(ACount);
259 exit;
260 end;
261 pDest := PByteMask(AContextData^.Dest);
262 pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize;
263 while ACount > 0 do
264 begin
265 if ACount > length(buf) then qty := length(buf) else qty := ACount;
266 IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc);
267 Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TByteMask), nil);
268 ByteMaskChunkSetPixels(@buf, pDest, AAlpha, qty, sizeof(TByteMask) );
269 inc(pDest, qty);
270 dec(ACount, qty);
271 end;
272 AContextData^.Dest := pDest;
273 end;
274 end;
275
276 procedure ByteMaskScannerConvertBrushXorPixels(AFixedData: Pointer;
277 AContextData: PUniBrushContext; AAlpha: Word; ACount: integer);
278 var
279 psrc: Pointer;
280 pDest: PByteMask;
281 qty, pixSize: Integer;
282 buf: packed array[0..31] of TByteMask;
283 begin
284 with PByteMaskScannerBrushFixedData(AFixedData)^ do
285 begin
286 if AAlpha = 0 then
287 begin
288 inc(PByteMask(AContextData^.Dest), ACount);
289 IBGRAScanner(Scanner).ScanSkipPixels(ACount);
290 exit;
291 end;
292 pDest := PByteMask(AContextData^.Dest);
293 pixSize := IBGRAScanner(Scanner).GetScanCustomColorspace.GetSize;
294 while ACount > 0 do
295 begin
296 if ACount > length(buf) then qty := length(buf) else qty := ACount;
297 IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc);
298 Conversion.Convert(psrc, @buf, qty, pixSize, sizeof(TByteMask), nil);
299 ByteMaskChunkXorPixels(@buf, pDest, AAlpha, qty, sizeof(TByteMask) );
300 inc(pDest, qty);
301 dec(ACount, qty);
302 end;
303 AContextData^.Dest := pDest;
304 end;
305 end;
306
307 procedure ByteMaskScannerChunkBrushSetPixels(AFixedData: Pointer;
308 AContextData: PUniBrushContext; AAlpha: Word; ACount: integer);
309 var
310 psrc: Pointer;
311 pDest: PByteMask;
312 qty: Integer;
313 begin
314 with PByteMaskScannerBrushFixedData(AFixedData)^ do
315 begin
316 if AAlpha = 0 then
317 begin
318 inc(PByteMask(AContextData^.Dest), ACount);
319 IBGRAScanner(Scanner).ScanSkipPixels(ACount);
320 exit;
321 end;
322 pDest := PByteMask(AContextData^.Dest);
323 while ACount > 0 do
324 begin
325 qty := ACount;
326 IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc);
327 ByteMaskChunkSetPixels(PByteMask(psrc), pDest, AAlpha, qty, sizeof(TByteMask) );
328 inc(pDest, qty);
329 dec(ACount, qty);
330 end;
331 AContextData^.Dest := pDest;
332 end;
333 end;
334
335 procedure ByteMaskScannerChunkBrushXorPixels(AFixedData: Pointer;
336 AContextData: PUniBrushContext; AAlpha: Word; ACount: integer);
337 var
338 psrc: Pointer;
339 pDest: PByteMask;
340 qty: Integer;
341 begin
342 with PByteMaskScannerBrushFixedData(AFixedData)^ do
343 begin
344 if AAlpha = 0 then
345 begin
346 inc(PByteMask(AContextData^.Dest), ACount);
347 IBGRAScanner(Scanner).ScanSkipPixels(ACount);
348 exit;
349 end;
350 pDest := PByteMask(AContextData^.Dest);
351 while ACount > 0 do
352 begin
353 qty := ACount;
354 IBGRAScanner(Scanner).ScanNextCustomChunk(qty, psrc);
355 ByteMaskChunkXorPixels(PByteMask(psrc), pDest, AAlpha, qty, sizeof(TByteMask) );
356 inc(pDest, qty);
357 dec(ACount, qty);
358 end;
359 AContextData^.Dest := pDest;
360 end;
361 end;
362
363 procedure ByteMaskMaskBrushApply(AFixedData: Pointer;
364 AContextData: PUniBrushContext; AAlpha: Word; ACount: integer);
365 var
366 pDest: PByteMask;
367 qty, maskStride: Integer;
368 pMask: PByteMask;
369 factor: UInt32or64;
370 begin
371 with PByteMaskScannerBrushFixedData(AFixedData)^ do
372 begin
373 if AAlpha = 0 then
374 begin
375 inc(PByteMask(AContextData^.Dest), ACount);
376 IBGRAScanner(Scanner).ScanSkipPixels(ACount);
377 exit;
378 end;
379 pDest := PByteMask(AContextData^.Dest);
380 if AAlpha = 65535 then
381 begin
382 while ACount > 0 do
383 begin
384 qty := ACount;
385 IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride);
386 dec(ACount,qty);
387 while qty > 0 do
388 begin
389 pDest^.gray := ApplyOpacity(pDest^.gray, pMask^.gray);
390 inc(pDest);
391 inc(pMask, maskStride);
392 dec(qty);
393 end;
394 end;
395 end else
396 begin
397 factor := AAlpha + (AAlpha shr 8) + (AAlpha shr 14);
398 while ACount > 0 do
399 begin
400 qty := ACount;
401 IBGRAScanner(Scanner).ScanNextMaskChunk(qty, pMask, maskStride);
402 dec(ACount,qty);
403 while qty > 0 do
404 begin
405 pDest^.gray := (pDest^.gray*((factor*pMask^.gray+128) shr 8)) shr 16;
406 inc(pDest);
407 inc(pMask, maskStride);
408 dec(qty);
409 end;
410 end;
411 end;
412 PByteMask(AContextData^.Dest) := pDest;
413 end;
414 end;
415
416 procedure ByteMaskBrushErasePixels(AFixedData: Pointer;
417 AContextData: PUniBrushContext; AAlpha: Word; ACount: integer);
418 var
419 pDest: PByteMask;
420 alphaMul,eraseMul: UInt32or64;
421 begin
422 pDest := PByteMask(AContextData^.Dest);
423 if AAlpha>=32768 then alphaMul := AAlpha+1 else alphaMul := AAlpha;
424 eraseMul := PWord(AFixedData)^;
425 if eraseMul>=32768 then inc(eraseMul);
426 eraseMul := 65536 - (eraseMul*alphaMul shr 16);
427 while ACount > 0 do
428 begin
429 pDest^.gray:= pDest^.gray*eraseMul shr 16;
430 dec(ACount);
431 inc(pDest);
432 end;
433 AContextData^.Dest := pDest;
434 end;
435
436 { TGrayscaleMask }
437
InternalNewnull438 function TGrayscaleMask.InternalNew: TCustomUniversalBitmap;
439 begin
440 Result:= TGrayscaleMask.Create;
441 end;
442
443 procedure TGrayscaleMask.AssignTransparentPixel(out ADest);
444 begin
445 TByteMask(ADest).gray := 0;
446 end;
447
InternalGetPixelCycle256null448 function TGrayscaleMask.InternalGetPixelCycle256(ix, iy: int32or64; iFactX,
449 iFactY: int32or64): TByteMask;
450 var
451 ixMod2: int32or64;
452 pUpLeft, pUpRight, pDownLeft, pDownRight: PByteMask;
453 scan: PByteMask;
454 begin
455 scan := GetScanlineFast(iy);
456
457 pUpLeft := (scan + ix);
458 ixMod2 := ix+1;
459 if ixMod2=Width then ixMod2 := 0;
460 pUpRight := (scan + ixMod2);
461
462 Inc(iy);
463 if iy = Height then iy := 0;
464 scan := GetScanlineFast(iy);
465 pDownLeft := (scan + ix);
466 pDownRight := (scan + ixMod2);
467
468 InterpolateBilinearMask(pUpLeft, pUpRight, pDownLeft,
469 pDownRight, iFactX, iFactY, @result);
470 end;
471
TGrayscaleMask.InternalGetPixel256null472 function TGrayscaleMask.InternalGetPixel256(ix, iy: int32or64; iFactX,
473 iFactY: int32or64; smoothBorder: boolean): TByteMask;
474 var
475 pUpLeft, pUpRight, pDownLeft, pDownRight: PByteMask;
476 scan: PByteMask;
477 begin
478 if (iy >= 0) and (iy < FHeight) then
479 begin
480 scan := GetScanlineFast(iy);
481
482 if (ix >= 0) and (ix < FWidth) then
483 pUpLeft := scan+ix
484 else if smoothBorder then
485 pUpLeft := @ByteMaskBlack
486 else
487 pUpLeft := nil;
488
489 if (ix+1 >= 0) and (ix+1 < FWidth) then
490 pUpRight := scan+(ix+1)
491 else if smoothBorder then
492 pUpRight := @ByteMaskBlack
493 else
494 pUpRight := nil;
495 end else
496 if smoothBorder then
497 begin
498 pUpLeft := @ByteMaskBlack;
499 pUpRight := @ByteMaskBlack;
500 end else
501 begin
502 pUpLeft := nil;
503 pUpRight := nil;
504 end;
505
506 if (iy+1 >= 0) and (iy+1 < FHeight) then
507 begin
508 scan := GetScanlineFast(iy+1);
509
510 if (ix >= 0) and (ix < FWidth) then
511 pDownLeft := scan+ix
512 else if smoothBorder then
513 pDownLeft := @ByteMaskBlack
514 else
515 pDownLeft := nil;
516
517 if (ix+1 >= 0) and (ix+1 < FWidth) then
518 pDownRight := scan+(ix+1)
519 else if smoothBorder then
520 pDownRight := @ByteMaskBlack
521 else
522 pDownRight := nil;
523 end else
524 if smoothBorder then
525 begin
526 pDownLeft := @ByteMaskBlack;
527 pDownRight := @ByteMaskBlack;
528 end else
529 begin
530 pDownLeft := nil;
531 pDownRight := nil;
532 end;
533
534 InterpolateBilinearMask(pUpLeft, pUpRight, pDownLeft,
535 pDownRight, iFactX, iFactY, @result);
536 end;
537
538 procedure TGrayscaleMask.Init;
539 begin
540 inherited Init;
541 ScanInterpolationFilter := rfLinear;
542 end;
543
TGrayscaleMask.GetScanLinenull544 function TGrayscaleMask.GetScanLine(Y: Integer): PByte;
545 begin
546 result := PByte(GetScanLineByte(y));
547 end;
548
549 procedure TGrayscaleMask.CopyFrom(ABitmap: TBGRACustomBitmap; AChannel: TChannel);
550 var psrc: PByte;
551 pdest: PByte;
552 x,y: integer;
553 ofs: Int32or64;
554 begin
555 SetSize(ABitmap.Width, ABitmap.Height);
556 if NbPixels > 0 then
557 begin
558 pdest := DataByte;
559 ofs := TBGRAPixel_ChannelByteOffset[AChannel];
560 for y := 0 to FHeight-1 do
561 begin
562 psrc := PByte(ABitmap.ScanLine[y])+ofs;
563 for x := FWidth-1 downto 0 do
564 begin
565 pdest^ := psrc^;
566 inc(pdest);
567 inc(psrc,sizeof(TBGRAPixel));
568 end;
569 end;
570 end;
571 end;
572
573 procedure TGrayscaleMask.CopyPropertiesTo(ABitmap: TCustomUniversalBitmap);
574 begin
575 inherited CopyPropertiesTo(ABitmap);
576 if ABitmap is TGrayscaleMask then
577 begin
578 TGrayscaleMask(ABitmap).ScanInterpolationFilter:= self.ScanInterpolationFilter;
579 end;
580 end;
581
GetImageBoundsnull582 function TGrayscaleMask.GetImageBounds: TRect;
583 begin
584 Result:= GetImageBounds(cGreen);
585 end;
586
GetImageBoundsWithinnull587 function TGrayscaleMask.GetImageBoundsWithin(const ARect: TRect;
588 Channel: TChannel; ANothingValue: Byte): TRect;
589 var
590 minx, miny, maxx, maxy: integer;
591 xb, xb2, yb: integer;
592 p: PByte;
593 actualRect: TRect;
594 begin
595 if Channel = cAlpha then raise exception.Create('Channel not found');
596 actualRect := TRect.Intersect(ARect,rect(0,0,self.Width,self.Height));
597 maxx := actualRect.Left-1;
598 maxy := actualRect.Top-1;
599 minx := actualRect.Right;
600 miny := actualRect.Bottom;
601 for yb := actualRect.Top to actualRect.Bottom-1 do
602 begin
603 p := GetPixelAddress(actualRect.Left,yb);
604 for xb := actualRect.Left to actualRect.Right - 1 do
605 begin
606 if p^<>ANothingValue then
607 begin
608 if xb < minx then minx := xb;
609 if yb < miny then miny := yb;
610 if xb > maxx then maxx := xb;
611 if yb > maxy then maxy := yb;
612
613 inc(p, actualRect.Right-1-xb);
614 for xb2 := actualRect.Right-1 downto xb+1 do
615 begin
616 if p^ <> ANothingValue then
617 begin
618 if xb2 > maxx then maxx := xb2;
619 break;
620 end;
621 dec(p);
622 end;
623 break;
624 end;
625 Inc(p);
626 end;
627 end;
628 if minx > maxx then
629 begin
630 Result.left := 0;
631 Result.top := 0;
632 Result.right := 0;
633 Result.bottom := 0;
634 end
635 else
636 begin
637 Result.left := minx;
638 Result.top := miny;
639 Result.right := maxx + 1;
640 Result.bottom := maxy + 1;
641 end;
642 end;
643
GetImageBoundsWithinnull644 function TGrayscaleMask.GetImageBoundsWithin(const ARect: TRect;
645 Channels: TChannels; ANothingValue: Byte): TRect;
646 begin
647 if cAlpha in Channels then raise exception.Create('Channel not found')
648 else if Channels = [] then result := EmptyRect
649 else result := GetImageBoundsWithin(ARect, cGreen, ANothingValue);
650 end;
651
652 class procedure TGrayscaleMask.SolidBrush(out ABrush: TUniversalBrush;
653 const AColor: TByteMask; ADrawMode: TDrawMode);
654 begin
655 ABrush.Colorspace := TByteMaskColorspace;
656 PByteMask(@ABrush.FixedData)^ := AColor;
657 if ADrawMode <> dmXor then
658 ABrush.InternalPutNextPixels:= @ByteMaskSolidBrushSetPixels
659 else
660 ABrush.InternalPutNextPixels:= @ByteMaskSolidBrushXorPixels;
661 end;
662
663 class procedure TGrayscaleMask.ScannerBrush(out ABrush: TUniversalBrush;
664 AScanner: IBGRAScanner; ADrawMode: TDrawMode; AOffsetX: integer;
665 AOffsetY: integer);
666 var
667 sourceSpace: TColorspaceAny;
668 begin
669 ABrush.Colorspace:= TByteMaskColorspace;
670 with PByteMaskScannerBrushFixedData(@ABrush.FixedData)^ do
671 begin
672 Scanner := Pointer(AScanner);
673 OffsetX := AOffsetX;
674 OffsetY := AOffsetY;
675 end;
676 ABrush.InternalInitContext:= @ByteMaskScannerBrushInitContext;
677 sourceSpace := AScanner.GetScanCustomColorspace;
678 if sourceSpace = TByteMaskColorspace then
679 begin
680 if ADrawMode <> dmXor then
681 ABrush.InternalPutNextPixels:= @ByteMaskScannerChunkBrushSetPixels
682 else
683 ABrush.InternalPutNextPixels:= @ByteMaskScannerChunkBrushXorPixels;
684 end else
685 begin
686 with PByteMaskScannerBrushFixedData(@ABrush.FixedData)^ do
687 Conversion := sourceSpace.GetBridgedConversion(TByteMaskColorspace);
688 if ADrawMode <> dmXor then
689 ABrush.InternalPutNextPixels:= @ByteMaskScannerConvertBrushSetPixels
690 else
691 ABrush.InternalPutNextPixels:= @ByteMaskScannerConvertBrushXorPixels;
692 end;
693 end;
694
695 class procedure TGrayscaleMask.MaskBrush(out ABrush: TUniversalBrush;
696 AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer);
697 begin
698 ABrush.Colorspace:= TByteMaskColorspace;
699 with PByteMaskScannerBrushFixedData(@ABrush.FixedData)^ do
700 begin
701 Scanner := Pointer(AScanner);
702 OffsetX := AOffsetX;
703 OffsetY := AOffsetY;
704 end;
705 ABrush.InternalInitContext:= @ByteMaskScannerBrushInitContext;
706 ABrush.InternalPutNextPixels:= @ByteMaskMaskBrushApply;
707 end;
708
709 class procedure TGrayscaleMask.EraseBrush(out ABrush: TUniversalBrush;
710 AAlpha: Word);
711 begin
712 ABrush.Colorspace := TByteMaskColorspace;
713 PWord(@ABrush.FixedData)^ := AAlpha;
714 ABrush.InternalPutNextPixels:= @ByteMaskBrushErasePixels;
715 end;
716
717 class procedure TGrayscaleMask.AlphaBrush(out ABrush: TUniversalBrush;
718 AAlpha: Word);
719 begin
720 ABrush.Colorspace := TByteMaskColorspace;
721 PWord(@ABrush.FixedData)^ := not AAlpha;
722 ABrush.InternalPutNextPixels:= @ByteMaskBrushErasePixels;
723 end;
724
725 constructor TGrayscaleMask.Create(AWidth, AHeight: Integer; AValue: byte);
726 begin
727 inherited Create(AWidth, AHeight, TByteMask.New(AValue));
728 end;
729
730 constructor TGrayscaleMask.Create(ABitmap: TBGRACustomBitmap; AChannel: TChannel);
731 begin
732 inherited Create(0,0);
733 CopyFrom(ABitmap, AChannel);
734 end;
735
736 constructor TGrayscaleMask.CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth,
737 AHeight: integer);
738 begin
739 CreateDownSample(ABitmap, AWidth, AHeight, rect(0,0,ABitmap.Width,ABitmap.Height));
740 end;
741
742 constructor TGrayscaleMask.CreateDownSample(ABitmap: TGrayscaleMask; AWidth,
743 AHeight: integer);
744 begin
745 CreateDownSample(ABitmap, AWidth, AHeight, rect(0,0,ABitmap.Width,ABitmap.Height));
746 end;
747
748 constructor TGrayscaleMask.CreateDownSample(ABitmap: TBGRACustomBitmap; AWidth,
749 AHeight: integer; ASourceRect: TRect);
750 begin
751 inherited Create(0,0);
752 if (AWidth = ABitmap.Width) and (AHeight = ABitmap.Height) then
753 CopyFrom(ABitmap,cGreen)
754 else
755 begin
756 if (ABitmap.Width < AWidth) or (ABitmap.Height < AHeight) then
757 raise exception.Create('Original size smaller');
758 SetSize(AWidth,AHeight);
759 if NbPixels > 0 then
760 DownSamplePutImageGrayscale(ABitmap, self, rect(0,0,FWidth,FHeight), ASourceRect);
761 end;
762 end;
763
764 constructor TGrayscaleMask.CreateDownSample(ABitmap: TGrayscaleMask; AWidth,
765 AHeight: integer; ASourceRect: TRect);
766 begin
767 inherited Create(0,0);
768 if (AWidth = ABitmap.Width) and (AHeight = ABitmap.Height) then
769 CopyFrom(ABitmap)
770 else
771 begin
772 if (ABitmap.Width < AWidth) or (ABitmap.Height < AHeight) then
773 raise exception.Create('Original size smaller');
774 SetSize(AWidth,AHeight);
775 if NbPixels > 0 then
776 DownSamplePutImageGrayscale(ABitmap, self, rect(0,0,FWidth,FHeight), ASourceRect);
777 end;
778 end;
779
780 procedure TGrayscaleMask.CopyFrom(ABitmap: TGrayscaleMask);
781 begin
782 SetSize(ABitmap.Width, ABitmap.Height);
783 if NbPixels > 0 then
784 move(ABitmap.Data^, Data^, NbPixels);
785 end;
786
787 procedure TGrayscaleMask.Draw(ABitmap: TBGRACustomBitmap; X, Y: Integer; AGammaCorrection: boolean = false);
788 var
789 yb, minxb, minyb, maxxb, maxyb, ignoreleft, copycount,
790 i, delta_source, delta_dest: integer;
791 pdest: PBGRAPixel;
792 psource: PByte;
793 value: byte;
794 begin
795 if not CheckPutImageBounds(x,y,FWidth,Fheight,minxb,minyb,maxxb,maxyb,ignoreleft,ABitmap.ClipRect) then exit;
796 copycount := maxxb - minxb + 1;
797
798 psource := ScanLineByte[minyb - y] + ignoreleft;
799 delta_source := FWidth;
800
801 pdest := ABitmap.Scanline[minyb] + minxb;
802 if ABitmap.LineOrder = riloBottomToTop then
803 delta_dest := -ABitmap.Width
804 else
805 delta_dest := ABitmap.Width;
806
807 Dec(delta_source, copycount);
808 Dec(delta_dest, copycount);
809 for yb := minyb to maxyb do
810 begin
811 if AGammaCorrection then
812 begin
813 for i := copycount -1 downto 0 do
814 begin
815 value := GammaCompressionTab[psource^ + (psource^ shl 8)];
816 pdest^ := BGRA(value,value,value,255);
817 inc(psource);
818 inc(pdest);
819 end;
820 end else
821 begin
822 for i := copycount -1 downto 0 do
823 begin
824 value := psource^;
825 pdest^ := BGRA(value,value,value,255);
826 inc(psource);
827 inc(pdest);
828 end;
829 end;
830 Inc(psource, delta_source);
831 Inc(pdest, delta_dest);
832 end;
833 ABitmap.InvalidateBitmap;
834 end;
835
836 procedure TGrayscaleMask.DrawAsAlpha(ABitmap: TBGRACustomBitmap; X, Y: Integer; const c: TBGRAPixel);
837 begin
838 ABitmap.FillMask(x,y, self, c, dmDrawWithTransparency);
839 end;
840
841 procedure TGrayscaleMask.DrawAsAlpha(ABitmap: TBGRACustomBitmap; X, Y: Integer; texture: IBGRAScanner);
842 begin
843 ABitmap.FillMask(x,y, self, texture, dmDrawWithTransparency);
844 end;
845
GetPixelnull846 function TGrayscaleMask.GetPixel(X, Y: integer): byte;
847 begin
848 if (x < 0) or (x >= FWidth) then
849 raise ERangeError.Create('GetPixel: out of bounds');
850 result := (ScanLineByte[Y]+X)^;
851 end;
852
853 procedure TGrayscaleMask.SetPixel(X, Y: integer; AValue: byte);
854 begin
855 if (x < 0) or (x >= FWidth) then
856 raise ERangeError.Create('SetPixel: out of bounds');
857 (ScanLineByte[Y]+X)^ := AValue;
858 end;
859
GetPixelnull860 function TGrayscaleMask.GetPixel(x, y: single;
861 AResampleFilter: TResampleFilter; smoothBorder: boolean): TByteMask;
862 var
863 ix, iy: Int32or64;
864 iFactX,iFactY: Int32or64;
865 begin
866 ix := round(x*256);
867 if (ix<= -256) or (ix>=Width shl 8) then
868 begin
869 result := ByteMaskBlack;
870 exit;
871 end;
872 iy := round(y*256);
873 if (iy<= -256) or (iy>=Height shl 8) then
874 begin
875 result := ByteMaskBlack;
876 exit;
877 end;
878
879 iFactX := ix and 255; //distance from integer coordinate
880 iFactY := iy and 255;
881 if ix<0 then ix := -1 else ix := ix shr 8;
882 if iy<0 then iy := -1 else iy := iy shr 8;
883
884 //if the coordinate is integer, then call standard GetPixel function
ifnull885 if (iFactX = 0) and (iFactY = 0) then
886 begin
887 Result := (GetScanlineFast(iy)+ix)^;
888 exit;
889 end;
890
891 result := InternalGetPixel256(ix,iy, FineInterpolation256(iFactX, AResampleFilter),
892 FineInterpolation256(iFactY, AResampleFilter), smoothBorder);
893 end;
894
TGrayscaleMask.GetPixel256null895 function TGrayscaleMask.GetPixel256(x, y, fracX256, fracY256: int32or64;
896 AResampleFilter: TResampleFilter; smoothBorder: boolean): TByteMask;
897 begin
898 if (fracX256 = 0) and (fracY256 = 0) then
899 result := GetPixel(x,y)
900 else if AResampleFilter = rfBox then
901 begin
902 if fracX256 >= 128 then inc(x);
903 if fracY256 >= 128 then inc(y);
904 result := GetPixel(x,y);
905 end else
906 result := InternalGetPixel256(x,y, FineInterpolation256(fracX256,AResampleFilter),
907 FineInterpolation256(fracY256,AResampleFilter), smoothBorder);
908 end;
909
910 procedure TGrayscaleMask.ScanNextMaskChunk(var ACount: integer; out
911 AMask: PByteMask; out AStride: integer);
912 var
913 pPixels: Pointer;
914 begin
915 ScanNextCustomChunk(ACount, pPixels);
916 AMask := PByteMask(pPixels);
917 AStride := sizeof(TByteMask);
918 end;
919
TGrayscaleMask.ScanAtIntegerMasknull920 function TGrayscaleMask.ScanAtIntegerMask(X, Y: integer): TByteMask;
921 begin
922 if (FScanWidth <> 0) and (FScanHeight <> 0) then
923 result := GetPixelAddress(PositiveMod(X+ScanOffset.X, FScanWidth),
924 PositiveMod(Y+ScanOffset.Y, FScanHeight))^
925 else
926 result := ByteMaskBlack;
927 end;
928
ScanAtMasknull929 function TGrayscaleMask.ScanAtMask(X, Y: Single): TByteMask;
930 var
931 ix, iy: Int32or64;
932 iFactX,iFactY: Int32or64;
933 begin
934 if (FScanWidth = 0) or (FScanHeight = 0) then
935 begin
936 result := BGRAPixelTransparent;
937 exit;
938 end;
939 LoadFromBitmapIfNeeded;
940 ix := round(x*256);
941 iy := round(y*256);
942 if ScanInterpolationFilter = rfBox then
943 begin
944 ix := PositiveMod((ix+128)+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8;
945 iy := PositiveMod((iy+128)+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8;
946 result := (GetScanlineFast(iy)+ix)^;
947 exit;
948 end;
949 iFactX := ix and 255;
950 iFactY := iy and 255;
951 ix := PositiveMod(ix+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8;
952 iy := PositiveMod(iy+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8;
953 if (iFactX = 0) and (iFactY = 0) then
954 begin
955 result := (GetScanlineFast(iy)+ix)^;
956 exit;
957 end;
958 if ScanInterpolationFilter <> rfLinear then
959 begin
960 iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter );
961 iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter );
962 end;
963 result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY);
964 end;
965
ScanAtIntegernull966 function TGrayscaleMask.ScanAtInteger(X, Y: integer): TBGRAPixel;
967 begin
968 Result:= MaskToBGRA(ScanAtIntegerMask(X, Y));
969 end;
970
ScanAtnull971 function TGrayscaleMask.ScanAt(X, Y: Single): TBGRAPixel;
972 begin
973 Result:= MaskToBGRA(ScanAtMask(X, Y));
974 end;
975
976 procedure TGrayscaleMask.Negative;
977 begin
978 NegativeRect(rect(0, 0, Width, Height));
979 end;
980
981 procedure TGrayscaleMask.NegativeRect(ABounds: TRect);
982 var
983 yb, w, xb: LongInt;
984 p: PByte;
985 begin
986 ABounds.Intersect(ClipRect);
987 w := ABounds.Width;
988 for yb := ABounds.Top to ABounds.Bottom-1 do
989 begin
990 p := GetPixelAddress(ABounds.Left, yb);
991 for xb := w-1 downto 0 do
992 begin
993 p^ := not p^;
994 inc(p);
995 end;
996 end;
997 end;
998
999 procedure TGrayscaleMask.InplaceNormalize;
1000 begin
1001 InplaceNormalize(rect(0, 0, Width, Height));
1002 end;
1003
1004 procedure TGrayscaleMask.InplaceNormalize(ABounds: TRect);
1005 var
1006 yb, w, xb: LongInt;
1007 p: PByte;
1008 minVal, maxVal, spread: byte;
1009 begin
1010 ABounds.Intersect(ClipRect);
1011 if ABounds.IsEmpty then exit;
1012 minVal := 255;
1013 maxVal := 0;
1014 w := ABounds.Width;
1015 for yb := ABounds.Top to ABounds.Bottom-1 do
1016 begin
1017 p := GetPixelAddress(ABounds.Left, yb);
1018 for xb := w-1 downto 0 do
1019 begin
1020 if p^ < minVal then minVal := p^;
1021 if p^ > maxVal then maxVal := p^;
1022 inc(p);
1023 end;
1024 end;
1025 if (minVal > 0) or (maxVal < 255) then
1026 begin
1027 if minVal = maxVal then
1028 begin
1029 if (minVal > 0) and (minVal < 255) then
1030 FillRect(ABounds, TByteMask.New(255));
1031 end else
1032 begin
1033 spread := maxVal - minVal;
1034 for yb := ABounds.Top to ABounds.Bottom-1 do
1035 begin
1036 p := GetPixelAddress(ABounds.Left, yb);
1037 for xb := w-1 downto 0 do
1038 begin
1039 p^ := (p^ - minVal) * 255 div spread;
1040 inc(p);
1041 end;
1042 end;
1043 end;
1044 end;
1045 end;
1046
TGrayscaleMask.NewBitmapnull1047 function TGrayscaleMask.NewBitmap: TGrayscaleMask;
1048 begin
1049 Result:=inherited NewBitmap as TGrayscaleMask;
1050 end;
1051
TGrayscaleMask.NewBitmapnull1052 function TGrayscaleMask.NewBitmap(AWidth, AHeight: integer): TGrayscaleMask;
1053 begin
1054 Result:=inherited NewBitmap(AWidth, AHeight) as TGrayscaleMask;
1055 end;
1056
TGrayscaleMask.NewBitmapnull1057 function TGrayscaleMask.NewBitmap(AWidth, AHeight: integer;
1058 const Color: TByteMask): TGrayscaleMask;
1059 begin
1060 Result:=inherited NewBitmap(AWidth, AHeight, Color) as TGrayscaleMask;
1061 end;
1062
TGrayscaleMask.NewBitmapnull1063 function TGrayscaleMask.NewBitmap(AWidth, AHeight: integer; AColor: Pointer
1064 ): TGrayscaleMask;
1065 begin
1066 Result:=inherited NewBitmap(AWidth, AHeight, AColor) as TGrayscaleMask;
1067 end;
1068
NewReferencenull1069 function TGrayscaleMask.NewReference: TGrayscaleMask;
1070 begin
1071 Result:=inherited NewReference as TGrayscaleMask;
1072 end;
1073
GetUniquenull1074 function TGrayscaleMask.GetUnique: TGrayscaleMask;
1075 begin
1076 Result:=inherited GetUnique as TGrayscaleMask;
1077 end;
1078
TGrayscaleMask.Duplicatenull1079 function TGrayscaleMask.Duplicate(DuplicateProperties: Boolean): TGrayscaleMask;
1080 begin
1081 Result:=inherited Duplicate(DuplicateProperties) as TGrayscaleMask;
1082 end;
1083
GetPartnull1084 function TGrayscaleMask.GetPart(const ARect: TRect): TGrayscaleMask;
1085 begin
1086 Result:=inherited GetPart(ARect) as TGrayscaleMask;
1087 end;
1088
CreateBrushTexturenull1089 function TGrayscaleMask.CreateBrushTexture(ABrushStyle: TBrushStyle;
1090 APatternColor, ABackgroundColor: TByteMask; AWidth: integer;
1091 AHeight: integer; APenWidth: single): TGrayscaleMask;
1092 begin
1093 Result:=inherited CreateBrushTexture(ABrushStyle, APatternColor,
1094 ABackgroundColor, AWidth, AHeight, APenWidth) as TGrayscaleMask;
1095 end;
1096
TGrayscaleMask.RotateCWnull1097 function TGrayscaleMask.RotateCW: TGrayscaleMask;
1098 begin
1099 Result:=inherited RotateCW as TGrayscaleMask;
1100 end;
1101
RotateCCWnull1102 function TGrayscaleMask.RotateCCW: TGrayscaleMask;
1103 begin
1104 Result:=inherited RotateCCW as TGrayscaleMask;
1105 end;
1106
TGrayscaleMask.RotateUDnull1107 function TGrayscaleMask.RotateUD: TGrayscaleMask;
1108 begin
1109 Result:=inherited RotateUD as TGrayscaleMask;
1110 end;
1111
TGrayscaleMask.FilterContournull1112 function TGrayscaleMask.FilterContour(ABorderValue: byte = 0): TGrayscaleMask;
1113 var
1114 pDest: PByte;
1115
1116 procedure ComputeDiff(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline;
1117 var diff: Integer;
1118 begin
1119 diff := (abs((pCurRow+x+1)^ - (pCurRow+x-1)^) +
1120 abs((pPrevRow+x-1)^ - (pNextRow+x+1)^) +
1121 abs((pPrevRow+x)^ - (pNextRow+x)^) +
1122 abs((pPrevRow+x+1)^ - (pNextRow+x-1)^)) div 3;
1123 if diff > 255 then
1124 (pDest+x)^ := 0
1125 else (pDest+x)^ := not Byte(diff);
1126 end;
1127
1128 procedure ComputeDiffLeft(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline;
1129 var diff: Integer;
1130 begin
1131 diff := (abs((pCurRow+x+1)^ - ABorderValue) +
1132 abs(ABorderValue - (pNextRow+x+1)^) +
1133 abs((pPrevRow+x)^ - (pNextRow+x)^) +
1134 abs((pPrevRow+x+1)^ - ABorderValue)) div 3;
1135 if diff > 255 then
1136 (pDest+x)^ := 0
1137 else (pDest+x)^ := not Byte(diff);
1138 end;
1139
1140 procedure ComputeDiffRight(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline;
1141 var diff: Integer;
1142 begin
1143 diff := (abs(ABorderValue - (pCurRow+x-1)^) +
1144 abs((pPrevRow+x-1)^ - ABorderValue) +
1145 abs((pPrevRow+x)^ - (pNextRow+x)^) +
1146 abs(ABorderValue - (pNextRow+x-1)^)) div 3;
1147 if diff > 255 then
1148 (pDest+x)^ := 0
1149 else (pDest+x)^ := not Byte(diff);
1150 end;
1151
1152 procedure ComputeDiffLeftRight(x: integer; pPrevRow, pCurRow, pNextRow: PByte); inline;
1153 var diff: Integer;
1154 begin
1155 diff := abs((pPrevRow+x)^ - (pNextRow+x)^) div 3;
1156 if diff > 255 then
1157 (pDest+x)^ := 0
1158 else (pDest+x)^ := not Byte(diff);
1159 end;
1160
1161 var
1162 pPrevRow, pCurRow, pNextRow, pBorder: PByte;
1163 border: packed array of byte;
1164 yb, xb: Integer;
1165
1166 begin
1167 if NbPixels = 0 then exit;
1168 result := TGrayscaleMask.Create;
1169 result.SetSize(Width, Height);
1170 setlength(border, Width);
1171 for xb := 0 to Width-1 do
1172 border[xb] := ABorderValue;
1173 pBorder := @border[0];
1174 pPrevRow := nil;
1175 pCurRow := nil;
1176 pNextRow := ScanLine[0];
1177 for yb := 0 to Height-1 do
1178 begin
1179 pPrevRow := pCurRow;
1180 pCurRow := pNextRow;
1181 if yb < Height-1 then
1182 pNextRow := ScanLine[yb+1]
1183 else pNextRow := nil;
1184 pDest := result.ScanLine[yb];
1185
1186 if pPrevRow = nil then
1187 begin
1188 if pNextRow = nil then
1189 begin
1190 if Width = 1 then
1191 ComputeDiffLeftRight(0, pBorder, pCurRow, pBorder) else
1192 begin
1193 ComputeDiffLeft(0, pBorder, pCurRow, pBorder);
1194 for xb := 1 to Width-2 do
1195 ComputeDiff(xb, pBorder, pCurRow, pBorder);
1196 ComputeDiffRight(Width-1, pBorder, pCurRow, pBorder);
1197 end;
1198 end else
1199 begin
1200 if Width = 1 then
1201 ComputeDiffLeftRight(0, pBorder, pCurRow, pNextRow) else
1202 begin
1203 ComputeDiffLeft(0, pBorder, pCurRow, pNextRow);
1204 for xb := 1 to Width-2 do
1205 ComputeDiff(xb, pBorder, pCurRow, pNextRow);
1206 ComputeDiffRight(Width-1, pBorder, pCurRow, pNextRow);
1207 end;
1208 end;
1209 end else
1210 if pNextRow = nil then
1211 begin
1212 if Width = 1 then
1213 ComputeDiffLeftRight(0, pPrevRow, pCurRow, pBorder) else
1214 begin
1215 ComputeDiffLeft(0, pPrevRow, pCurRow, pBorder);
1216 for xb := 1 to Width-2 do
1217 ComputeDiff(xb, pPrevRow, pCurRow, pBorder);
1218 ComputeDiffRight(Width-1, pPrevRow, pCurRow, pBorder);
1219 end;
1220 end else
1221 begin
1222 if Width = 1 then
1223 ComputeDiffLeftRight(0, pPrevRow, pCurRow, pNextRow) else
1224 begin
1225 ComputeDiffLeft(0, pPrevRow, pCurRow, pNextRow);
1226 for xb := 1 to Width-2 do
1227 ComputeDiff(xb, pPrevRow, pCurRow, pNextRow);
1228 ComputeDiffRight(Width-1, pPrevRow, pCurRow, pNextRow);
1229 end;
1230 end;
1231 end;
1232 end;
1233
TGrayscaleMask.FilterBlurRadialnull1234 function TGrayscaleMask.FilterBlurRadial(radius: single;
1235 blurType: TRadialBlurType): TGrayscaleMask;
1236 begin
1237 Result:=inherited FilterBlurRadial(radius, blurType) as TGrayscaleMask;
1238 end;
1239
TGrayscaleMask.FilterBlurRadialnull1240 function TGrayscaleMask.FilterBlurRadial(const ABounds: TRect; radius: single;
1241 blurType: TRadialBlurType): TGrayscaleMask;
1242 begin
1243 Result:=inherited FilterBlurRadial(ABounds, radius, blurType) as TGrayscaleMask;
1244 end;
1245
TGrayscaleMask.FilterBlurRadialnull1246 function TGrayscaleMask.FilterBlurRadial(radiusX, radiusY: single;
1247 blurType: TRadialBlurType): TGrayscaleMask;
1248 begin
1249 Result:=inherited FilterBlurRadial(radiusX, radiusY, blurType) as TGrayscaleMask;
1250 end;
1251
TGrayscaleMask.FilterBlurRadialnull1252 function TGrayscaleMask.FilterBlurRadial(const ABounds: TRect; radiusX,
1253 radiusY: single; blurType: TRadialBlurType): TGrayscaleMask;
1254 begin
1255 Result:=inherited FilterBlurRadial(ABounds, radiusX, radiusY, blurType) as TGrayscaleMask;
1256 end;
1257
TGrayscaleMask.FilterBlurMotionnull1258 function TGrayscaleMask.FilterBlurMotion(distance: single; angle: single;
1259 oriented: boolean): TGrayscaleMask;
1260 begin
1261 Result:=inherited FilterBlurMotion(distance, angle, oriented) as TGrayscaleMask;
1262 end;
1263
TGrayscaleMask.FilterBlurMotionnull1264 function TGrayscaleMask.FilterBlurMotion(const ABounds: TRect;
1265 distance: single; angle: single; oriented: boolean): TGrayscaleMask;
1266 begin
1267 Result:=inherited FilterBlurMotion(ABounds, distance, angle, oriented) as TGrayscaleMask;
1268 end;
1269
FilterCustomBlurnull1270 function TGrayscaleMask.FilterCustomBlur(mask: TCustomUniversalBitmap
1271 ): TGrayscaleMask;
1272 begin
1273 Result:=inherited FilterCustomBlur(mask) as TGrayscaleMask;
1274 end;
1275
FilterCustomBlurnull1276 function TGrayscaleMask.FilterCustomBlur(const ABounds: TRect;
1277 mask: TCustomUniversalBitmap): TGrayscaleMask;
1278 begin
1279 Result:=inherited FilterCustomBlur(ABounds, mask) as TGrayscaleMask;
1280 end;
1281
FilterSpherenull1282 function TGrayscaleMask.FilterSphere: TGrayscaleMask;
1283 var
1284 cx, cy: single;
1285 scanner: TBGRASphereDeformationScanner;
1286 begin
1287 Result := NewBitmap(Width, Height);
1288 cx := Width / 2 - 0.5;
1289 cy := Height / 2 - 0.5;
1290 scanner := TBGRASphereDeformationScanner.Create(self, PointF(cx,cy), Width/2, Height/2);
1291 result.FillEllipseAntialias(cx, cy, Width/2-0.5, Height/2-0.5, scanner);
1292 scanner.Free;
1293 end;
1294
FilterCylindernull1295 function TGrayscaleMask.FilterCylinder: TGrayscaleMask;
1296 var
1297 cx: single;
1298 scanner: TBGRAVerticalCylinderDeformationScanner;
1299 begin
1300 Result := NewBitmap(Width, Height);
1301 cx := Width / 2 - 0.5;
1302 scanner := TBGRAVerticalCylinderDeformationScanner.Create(self, cx, Width/2);
1303 result.Fill(scanner, dmSet);
1304 scanner.Free;
1305 end;
1306
1307 procedure DownSamplePutImageGrayscale(sourceData: PByte;
1308 sourcePixelSize: Int32or64; sourceRowDelta: Int32or64; sourceWidth,
1309 sourceHeight: Int32or64; dest: TGrayscaleMask; ADestRect: TRect);
1310 var
1311 x_dest,y_dest: integer;
1312 pdest: PByte;
1313 nbPix,sum: UInt32or64;
1314 prev_x_src,x_src,x_src_nb,xb: Int32or64;
1315 x_src_inc,x_src_acc,x_src_div,x_src_rest: Int32or64;
1316 prev_y_src,y_src,y_src_nb,yb: Int32or64;
1317 y_src_inc,y_src_acc,y_src_div,y_src_rest: Int32or64;
1318 psrc,psrc2,psrc3: PByte;
1319 begin
1320 y_src_div := ADestRect.Bottom-ADestRect.Top;
1321 y_src_inc := sourceHeight div y_src_div;
1322 y_src_rest := sourceHeight mod y_src_div;
1323 x_src_div := ADestRect.Right-ADestRect.Left;
1324 x_src_inc := sourceWidth div x_src_div;
1325 x_src_rest := sourceWidth mod x_src_div;
1326
1327 if (x_src_rest = 0) and (y_src_rest = 0) then
1328 begin
1329 x_src_nb := x_src_inc;
1330 y_src_nb := y_src_inc;
1331 nbPix := x_src_nb*y_src_nb;
1332 y_src := 0;
1333 for y_dest := ADestRect.Top to ADestRect.Bottom-1 do
1334 begin
1335 pdest := dest.GetPixelAddress(ADestRect.Left, y_dest);
1336 psrc := sourceData + y_src*sourceRowDelta;
1337 inc(y_src,y_src_inc);
1338
1339 for x_dest := ADestRect.Right-ADestRect.Left-1 downto 0 do
1340 begin
1341 sum := 0;
1342 psrc2 := psrc;
1343 for xb := x_src_nb-1 downto 0 do
1344 begin
1345 psrc3 := psrc2;
1346 for yb := y_src_nb-1 downto 0 do
1347 begin
1348 inc(sum, psrc3^);
1349 inc(psrc3, sourceRowDelta);
1350 end;
1351 inc(psrc2, sourcePixelSize);
1352 end;
1353 pdest^ := sum div nbPix;
1354
1355 psrc := psrc2;
1356 inc(pdest);
1357 end;
1358 end;
1359 end else
1360 begin
1361 y_src := 0;
1362 y_src_acc := 0;
1363 for y_dest := ADestRect.Top to ADestRect.Bottom-1 do
1364 begin
1365 pdest := dest.GetPixelAddress(ADestRect.Left, y_dest);
1366 psrc := sourceData + y_src*sourceRowDelta;
1367
1368 prev_y_src := y_src;
1369 inc(y_src,y_src_inc);
1370 inc(y_src_acc,y_src_rest);
1371 if y_src_acc >= y_src_div then
1372 begin
1373 dec(y_src_acc,y_src_div);
1374 inc(y_src);
1375 end;
1376 y_src_nb := y_src-prev_y_src;
1377
1378 x_src := 0;
1379 x_src_acc := 0;
1380 for x_dest := ADestRect.Right-ADestRect.Left-1 downto 0 do
1381 begin
1382 prev_x_src := x_src;
1383 inc(x_src,x_src_inc);
1384 inc(x_src_acc,x_src_rest);
1385 if x_src_acc >= x_src_div then
1386 begin
1387 dec(x_src_acc,x_src_div);
1388 inc(x_src);
1389 end;
1390 x_src_nb := x_src-prev_x_src;
1391
1392 sum := 0;
1393 nbPix := 0;
1394 psrc2 := psrc;
1395 for xb := x_src_nb-1 downto 0 do
1396 begin
1397 psrc3 := psrc2;
1398 for yb := y_src_nb-1 downto 0 do
1399 begin
1400 inc(nbPix);
1401 inc(sum, psrc3^);
1402 inc(psrc3, sourceRowDelta);
1403 end;
1404 inc(psrc2, sourcePixelSize);
1405 end;
1406 pdest^ := sum div nbPix;
1407
1408 psrc := psrc2;
1409 inc(pdest);
1410 end;
1411 end;
1412 end;
1413 end;
1414
1415 procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap;
1416 dest: TGrayscaleMask; ADestRect: TRect);
1417 begin
1418 DownSamplePutImageGrayscale(source, dest, ADestRect, rect(0,0,source.Width,source.Height));
1419 end;
1420
1421 procedure DownSamplePutImageGrayscale(source: TGrayscaleMask; dest: TGrayscaleMask; ADestRect: TRect); overload;
1422 begin
1423 DownSamplePutImageGrayscale(source, dest, ADestRect, rect(0,0,source.Width,source.Height));
1424 end;
1425
1426 procedure DownSamplePutImageGrayscale(source: TBGRACustomBitmap;
1427 dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect);
1428 var delta: Int32or64;
1429 begin
1430 delta := source.Width*sizeof(TBGRAPixel);
1431 if source.LineOrder = riloBottomToTop then
1432 delta := -delta;
1433 DownSamplePutImageGrayscale(
1434 source.GetPixelAddress(ASourceRect.Left, ASourceRect.Top) + TBGRAPixel_GreenByteOffset,
1435 sizeof(TBGRAPixel), delta, ASourceRect.Width, ASourceRect.Height, dest, ADestRect);
1436 end;
1437
1438 procedure DownSamplePutImageGrayscale(source: TGrayscaleMask;
1439 dest: TGrayscaleMask; ADestRect: TRect; ASourceRect: TRect);
1440 var delta: Int32or64;
1441 begin
1442 delta := source.Width;
1443 if source.LineOrder = riloBottomToTop then
1444 delta := -delta;
1445 DownSamplePutImageGrayscale(source.GetPixelAddress(ASourceRect.Left, ASourceRect.Top), 1,
1446 delta, ASourceRect.Width, ASourceRect.Height, dest, ADestRect);
1447 end;
1448
1449 end.
1450
1451