1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 {
3 /**************************************************************************\
4 bgradefaultbitmap.pas
5 ---------------------
6 This unit defines basic operations on bitmaps.
7 It should NOT be added to the 'uses' clause.
8 Some operations may be slow, so there are
9 accelerated versions for some routines.
10 }
11
12 unit BGRADefaultBitmap;
13
14 {$mode objfpc}{$H+}
15 {$i bgrabitmap.inc}
16
17 interface
18
19 { This unit contains TBGRADefaultBitmap class. This class contains basic drawing routines,
20 and call functions from other units to perform advanced drawing functions. }
21
22 uses
23 SysUtils, BGRAClasses, FPImage, BGRAGraphics, BGRABitmapTypes,
24 {$IFDEF BGRABITMAP_USE_FPCANVAS}FPImgCanv,{$ENDIF}
25 BGRACanvas, BGRACanvas2D, BGRATransform, BGRATextBidi,
26 UniversalDrawer, BGRAGrayscaleMask;
27
28 type
29 TBGRAPtrBitmap = class;
30 {=== TBGRABitmap reference ===}
31 { TBGRADefaultBitmap }
32 {* This class is the base for all ''TBGRABitmap'' classes. It implements most
33 function to the exception from implementations specific to the
34 widgetset }{ in the doc, it is presented as
35 TBGRABitmap = class(TBGRACustomBitmap)
36 }
37 TBGRADefaultBitmap = class(TBGRACustomBitmap)
38 private
39 { Bounds checking which are shared by drawing functions. These functions check
40 if the coordinates are visible and return true if it is the case, swap
41 coordinates if necessary and make them fit into the clipping rectangle }
CheckRectBoundsnull42 function CheckRectBounds(var x,y,x2,y2: integer; minsize: integer): boolean; inline;
CheckAntialiasRectBoundsnull43 function CheckAntialiasRectBounds(var x,y,x2,y2: single; w: single): boolean;
GetCanvasBGRAnull44 function GetCanvasBGRA: TBGRACanvas;
GetCanvas2Dnull45 function GetCanvas2D: TBGRACanvas2D;
46 procedure GradientFillDithered(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
47 gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
48 gammaColorCorrection: boolean = True; Sinus: Boolean=False;
49 ditherAlgo: TDitheringAlgorithm = daFloydSteinberg); overload;
50 procedure GradientFillDithered(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
51 gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
52 Sinus: Boolean=False;
53 ditherAlgo: TDitheringAlgorithm = daFloydSteinberg); overload;
54
55 protected
56 //Pixel data
57 FDataModified: boolean; //if data image has changed so TBitmap should be updated
58
59 //GUI bitmap object
60 FBitmap: TBitmap;
61 FBitmapModified: boolean; //if TBitmap has changed so pixel data should be updated
62 FCanvasOpacity: byte; //opacity used with standard canvas functions
63 FAlphaCorrectionNeeded: boolean; //the alpha channel is not correct because standard functions do not
64 //take it into account
65
66 //FreePascal drawing routines
67 {$IFDEF BGRABITMAP_USE_FPCANVAS}FCanvasFP: TFPImageCanvas;{$ENDIF}
68 FCanvasDrawModeFP: TDrawMode;
69 FCanvasPixelProcFP: procedure(x, y: int32or64; const col: TBGRAPixel) of object;
70
71 //canvas-like with antialiasing and texturing
72 FCanvasBGRA: TBGRACanvas;
73 FCanvas2D: TBGRACanvas2D;
74
75 //drawing options
76 FFontHeight: integer;
77 FFontRenderer: TBGRACustomFontRenderer;
78
79 //Pixel data
LoadFromRawImagenull80 function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte;
81 AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean; virtual; abstract;
82
83 //FreePascal drawing routines
GetCanvasFPnull84 {$IFDEF BGRABITMAP_USE_FPCANVAS}function GetCanvasFP: TFPImageCanvas; override;{$ENDIF}
85 procedure SetCanvasDrawModeFP(const AValue: TDrawMode); override;
GetCanvasDrawModeFPnull86 function GetCanvasDrawModeFP: TDrawMode; override;
87
88 //GUI bitmap object
GetBitmapnull89 function GetBitmap: TBitmap; override;
GetCanvasnull90 function GetCanvas: TCanvas; override;
GetCanvasOpacitynull91 function GetCanvasOpacity: byte; override;
92 procedure SetCanvasOpacity(AValue: byte); override;
GetCanvasAlphaCorrectionnull93 function GetCanvasAlphaCorrection: boolean; override;
94 procedure SetCanvasAlphaCorrection(const AValue: boolean); override;
95 procedure DoAlphaCorrection;
96 procedure DiscardBitmapChange; inline;
97 procedure DoLoadFromBitmap; virtual;
98
CreatePtrBitmapnull99 function CreatePtrBitmap(AWidth,AHeight: integer; AData: PBGRAPixel): TBGRAPtrBitmap; virtual;
100
101 procedure RebuildBitmap; virtual; abstract;
102 procedure FreeBitmap; virtual;
103
104 procedure Init; override;
105
106 {TFPCustomImage}
107 procedure SetInternalColor(x, y: integer; const Value: TFPColor); override;
GetInternalColornull108 function GetInternalColor(x, y: integer): TFPColor; override;
109 procedure SetInternalPixel(x, y: integer; Value: integer); override;
GetInternalPixelnull110 function GetInternalPixel(x, y: integer): integer; override;
111
112 {Image functions}
FineResamplenull113 function FineResample(NewWidth, NewHeight: integer): TBGRACustomBitmap;
SimpleStretchnull114 function SimpleStretch(NewWidth, NewHeight: integer): TBGRACustomBitmap;
CheckEmptynull115 function CheckEmpty: boolean; override;
GetHasTransparentPixelsnull116 function GetHasTransparentPixels: boolean; override;
GetHasSemiTransparentPixelsnull117 function GetHasSemiTransparentPixels: boolean; override;
GetAverageColornull118 function GetAverageColor: TColor; override;
GetAveragePixelnull119 function GetAveragePixel: TBGRAPixel; override;
120
121 protected //pen style accesors
GetPenJoinStylenull122 function GetPenJoinStyle: TPenJoinStyle; override;
123 procedure SetPenJoinStyle(const AValue: TPenJoinStyle); override;
GetPenMiterLimitnull124 function GetPenMiterLimit: single; override;
125 procedure SetPenMiterLimit(const AValue: single); override;
GetCustomPenStylenull126 function GetCustomPenStyle: TBGRAPenStyle; override;
127 procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); override;
128 procedure SetPenStyle(const AValue: TPenStyle); override;
GetPenStylenull129 function GetPenStyle: TPenStyle; override;
130
GetArrowEndSizenull131 function GetArrowEndSize: TPointF; override;
GetArrowStartSizenull132 function GetArrowStartSize: TPointF; override;
133 procedure SetArrowEndSize(AValue: TPointF); override;
134 procedure SetArrowStartSize(AValue: TPointF); override;
GetArrowEndOffsetnull135 function GetArrowEndOffset: single; override;
GetArrowStartOffsetnull136 function GetArrowStartOffset: single; override;
137 procedure SetArrowEndOffset(AValue: single); override;
138 procedure SetArrowStartOffset(AValue: single); override;
GetArrowEndRepeatnull139 function GetArrowEndRepeat: integer; override;
GetArrowStartRepeatnull140 function GetArrowStartRepeat: integer; override;
141 procedure SetArrowEndRepeat(AValue: integer); override;
142 procedure SetArrowStartRepeat(AValue: integer); override;
143
144 protected //font accessors
GetFontHeightnull145 function GetFontHeight: integer; override;
146 procedure SetFontHeight(AHeight: integer); override;
GetFontFullHeightnull147 function GetFontFullHeight: integer; override;
148 procedure SetFontFullHeight(AHeight: integer); override;
GetFontPixelMetricnull149 function GetFontPixelMetric: TFontPixelMetric; override;
CreateDefaultFontRenderernull150 function CreateDefaultFontRenderer: TBGRACustomFontRenderer; virtual; abstract;
GetFontVerticalAnchorOffsetnull151 function GetFontVerticalAnchorOffset: single; override;
GetFontAnchorRotatedOffsetnull152 function GetFontAnchorRotatedOffset: TPointF; overload;
GetFontAnchorRotatedOffsetnull153 function GetFontAnchorRotatedOffset(ACustomOrientation: integer): TPointF; overload;
GetFontRenderernull154 function GetFontRenderer: TBGRACustomFontRenderer; override;
155 procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); override;
156
InternalGetPixelCycle256null157 function InternalGetPixelCycle256(ix,iy: int32or64; iFactX,iFactY: int32or64): TBGRAPixel;
InternalGetPixel256null158 function InternalGetPixel256(ix,iy: int32or64; iFactX,iFactY: int32or64; smoothBorder: boolean): TBGRAPixel;
159 procedure InternalTextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
160 procedure InternalTextOutLetterSpacing(x,y: single; sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
161 procedure InternalCrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePos: byte; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency);
162
163 procedure InternalArc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single;
164 AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); override;
InternalNewnull165 function InternalNew: TBGRADefaultBitmap; override;
166
167 public
168 {** Provides a canvas with opacity and antialiasing }
169 property CanvasBGRA: TBGRACanvas read GetCanvasBGRA;
170 {** Provides a canvas with 2d transformation and similar to HTML5. }
171 property Canvas2D: TBGRACanvas2D read GetCanvas2D;
172 {** For more properties, see parent class [[TBGRACustomBitmap and IBGRAScanner#TBGRACustomBitmap|TBGRACustomBitmap]] }
173
174 procedure SetSize(AWidth, AHeight: integer); override;
175
176 {==== Constructors ====}
177
178 {------------------------- Constructors from TBGRACustomBitmap-------------}
179
180 {** Creates an image by copying the content of a ''TFPCustomImage'' }
181 constructor Create(AFPImage: TFPCustomImage); overload; override;
182 {** Creates an image by copying the content of a ''TBitmap'' }
183 constructor Create(ABitmap: TBitmap; AUseTransparent: boolean = true); overload; override;
184
185 {** Creates an image by loading its content from the file ''AFilename''.
186 The encoding of the string is the default one for the operating system.
187 It is recommended to use the next constructor and UTF8 encoding }
188 constructor Create(AFilename: string); overload; override;
189
190 {** Creates an image by loading its content from the file ''AFilename''.
191 The boolean ''AIsUtf8Filename'' specifies if UTF8 encoding is assumed
192 for the filename }
193 constructor Create(AFilename: string; AIsUtf8: boolean); overload; override;
194 constructor Create(AFilename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions); overload; override;
195
196 {** Creates an image by loading its content from the stream ''AStream'' }
197 constructor Create(AStream: TStream); overload; override;
198 {** Free the object and all its resources }
199 destructor Destroy; override;
200
201 {** Clear all channels of transparent pixels }
202 procedure ClearTransparentPixels; override;
203
204 {------------------------- Quasi-constructors -----------------------------}
205
206 {** Can only be called from an existing instance of ''TBGRABitmap''.
207 Creates a new instance with dimensions 0 x 0. }
NewBitmapnull208 function NewBitmap: TBGRADefaultBitmap; overload; override;
209
210 {** Can only be called from an existing instance of ''TBGRABitmap''.
211 Creates a new instance with dimensions ''AWidth'' and ''AHeight'',
212 containing transparent pixels. }
NewBitmapnull213 function NewBitmap(AWidth, AHeight: integer): TBGRADefaultBitmap; overload; override;
214
215 {* Example:
216 <syntaxhighlight>
217 * var bmp1, bmp2: TBGRABitmap;
218 * begin
219 * bmp1 := TBGRABitmap.Create(100,100);
220 * bmp2 := bmp1.NewBitmap(100,100);
221 * ...
222 * end;</syntaxhighlight>
223 See tutorial 2 on [[BGRABitmap_tutorial_2|how to load and display an image]].
224 * See reference on [[TBGRACustomBitmap_and_IBGRAScanner#Load_and_save_files|loading and saving files]] }
225
226 {** Can only be called from an existing instance of ''TBGRABitmap''.
227 Creates a new instance with dimensions ''AWidth'' and ''AHeight'',
228 and fills it with Color }
NewBitmapnull229 function NewBitmap(AWidth, AHeight: integer; const Color: TBGRAPixel): TBGRADefaultBitmap; overload; override;
NewBitmapnull230 function NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRADefaultBitmap; overload; override;
231
232 {** Can only be called from an existing instance of ''TBGRABitmap''.
233 Creates a new instance with by loading its content
234 from the file ''Filename''. The encoding of the string
235 is the default one for the operating system }
NewBitmapnull236 function NewBitmap(Filename: string): TBGRADefaultBitmap; overload; override;
237
238 {** Can only be called from an existing instance of ''TBGRABitmap''.
239 Creates a new instance with by loading its content
240 from the file ''Filename'' }
NewBitmapnull241 function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRADefaultBitmap; overload; override;
NewBitmapnull242 function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGRADefaultBitmap; overload; override;
243
244 {** Can only be called from an existing instance of ''TBGRABitmap''.
245 Creates an image by copying the content of a ''TFPCustomImage'' }
NewBitmapnull246 function NewBitmap(AFPImage: TFPCustomImage): TBGRADefaultBitmap; overload; override;
247
248 {** Assign the content of the specified ''Source''. It can be a ''TBGRACustomBitmap'' or
249 a ''TFPCustomImage'' }
250 procedure Assign(Source: TPersistent); overload; override;
251 procedure Assign(Source: TBitmap; AUseTransparent: boolean); overload;
252
253 {** Stores the image in the stream without compression nor header }
254 procedure Serialize(AStream: TStream); override;
255 {** Reads the image in a stream that was previously serialized }
256 procedure Deserialize(AStream: TStream); override;
257
258 // universal brushes
259 procedure SolidBrushIndirect(out ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
260 class procedure SolidBrush(out ABrush: TUniversalBrush; const AColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
261 class procedure ScannerBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency;
262 AOffsetX: integer = 0; AOffsetY: integer = 0); override;
263 class procedure MaskBrush(out ABrush: TUniversalBrush; AScanner: IBGRAScanner;
264 AOffsetX: integer = 0; AOffsetY: integer = 0); override;
265 class procedure EraseBrush(out ABrush: TUniversalBrush; AAlpha: Word); override;
266 class procedure AlphaBrush(out ABrush: TUniversalBrush; AAlpha: Word); override;
267
268 {==== Pixel functions ====}
269 {** Sets the pixel by replacing the content at (''x'',''y'') with the specified color.
270 Alpha value is set to 255 (opaque) }
271 procedure SetPixel(x, y: int32or64; c: TColor); overload; override;
272 {** Applies a logical '''xor''' to the content of the pixel with the specified value.
273 This includes the alpha channel, so if you want to preserve the opacity, provide
274 a color ''c'' with alpha channel equal to zero }
275 procedure XorPixel(x, y: int32or64; const c: TBGRAPixel); override;
276 {** Draws a pixel with gamma correction at (''x'',''y''). Pixel is supplied
277 in sRGB colorspace }
278 procedure DrawPixel(x, y: int32or64; const c: TBGRAPixel); overload; override;
279 {** Draws a pixel without gamma correction at (''x'',''y''). Pixel is supplied
280 in sRGB colorspace }
281 procedure FastBlendPixel(x, y: int32or64; const c: TBGRAPixel); override;
282 {** Erase the content of the pixel by reducing the value of the
283 alpha channel. ''alpha'' specifies how much to decrease.
284 If the resulting alpha reaches zero, the content
285 is replaced by ''BGRAPixelTransparent'' }
286 procedure ErasePixel(x, y: int32or64; alpha: byte); override;
287 {** Sets the alpha value at (''x'',''y''). If ''alpha'' = 0, the
288 pixel is replaced by ''BGRAPixelTransparent'' }
289 procedure AlphaPixel(x, y: int32or64; alpha: byte); override;
290 {** Computes the value of the pixel at a floating point coordiante
291 by interpolating the values of the pixels around it.
292 * There is a one pixel wide margin around the pixel where the pixels are
293 still considered inside. If ''smoothBorder'' is set to true, pixel fade
294 to transparent.
295 * If it is more out of the bounds, the result is ''BGRAPixelTransparent''.
296 * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted
297 values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' }
GetPixelnull298 function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; overload; override;
299 {** Similar to previous ''GetPixel'' function, but the fractional part of
300 the coordinate is supplied with a number from 0 to 255. The actual
301 coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) }
GetPixel256null302 function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; override;
303 {** Computes the value of the pixel at a floating point coordiante
304 by interpolating the values of the pixels around it. If the pixel
305 is out of bounds, the image is repeated.
306 * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted
307 values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' }
GetPixelCyclenull308 function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; override;
309 {** Similar to previous ''GetPixel'' function, but the fractional part of
310 the coordinate is supplied with a number from 0 to 255. The actual
311 coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) }
GetPixelCycle256null312 function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; override;
313 {** Computes the value of the pixel at a floating point coordiante
314 by interpolating the values of the pixels around it. ''repeatX'' and
315 ''repeatY'' specifies if the image is to be repeated or not.
316 * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted
317 values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' }
GetPixelCyclenull318 function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; override;
319 {** Similar to previous ''GetPixel'' function, but the fractional part of
320 the coordinate is supplied with a number from 0 to 255. The actual
321 coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) }
GetPixelCycle256null322 function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; override;
323
324 {==== Drawing lines and polylines (integer coordinates) ====}
325 {* These functions do not take into account current pen style/cap/join.
326 See [[BGRABitmap tutorial 13|coordinate system]]. }
327
328 {** Applies xor to the pixels at line ''y'' and
329 at columns ''x'' to ''x2'' included, using specified color.
330 This includes the alpha channel, so if you want to preserve the
331 opacity, provide a color ''c'' with alpha channel equal to zero }
332 procedure XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
333 {** Draws an horizontal line with gamma correction at line ''y'' and
334 at columns ''x'' to ''x2'' included, using specified color }
335 procedure DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel); override; overload;
336 {** Draws an horizontal line without gamma correction at line ''y'' and
337 at columns ''x'' to ''x2'' included, using specified color }
338 procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
339 {** Replaces the alpha value of the pixels at line ''y'' and
340 at columns ''x'' to ''x2'' included }
341 procedure AlphaHorizLine(x, y, x2: int32or64; alpha: byte); override;
342 {** Draws an horizontal line with gamma correction at line ''y'' and
343 at columns ''x'' to ''x2'' included, using specified color,
344 and with a transparency that increases with the color difference
345 with ''compare''. If the difference is greater than ''maxDiff'',
346 pixels are not changed }
347 procedure DrawHorizLineDiff(x, y, x2: int32or64; c, compare: TBGRAPixel;
348 maxDiff: byte); override;
349 procedure HorizLineDiff(x, y, x2: int32or64; const ABrush: TUniversalBrush;
350 ACompare: TBGRAPixel; AMaxDiffW: word); override;
351
352 {** Xors a vertical line at column ''x'' and at row ''y'' to ''y2'' }
353 procedure XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
354 {** Draws a vertical line with gamma correction at column ''x'' and at row ''y'' to ''y2'' }
355 procedure DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
356 {** Draws a vertical line without gamma correction at column ''x'' and at row ''y'' to ''y2'' }
357 procedure FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
358 {** Replace alpha values in a vertical line at column ''x'' and at row ''y'' to ''y2'' }
359 procedure AlphaVertLine(x, y, y2: int32or64; alpha: byte); override;
360
361 {** Fills completely a rectangle, without any border, with the specified ''texture'' and
362 with the specified ''mode'' }
363 procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); overload; override;
364
365 {==== Rectangles, ellipses and path (floating point coordinates) ====}
366 {* These functions use the current pen style/cap/join. The parameter ''w''
367 specifies the width of the line and the base unit for dashes
368 * The coordinates are pixel-centered, so that when filling a rectangle,
369 if the supplied values are integers, the border will be half transparent.
370 If you want the border to be completely filled, you can subtract/add
371 0.5 to the coordinates to include the remaining thin border.
372 See [[BGRABitmap tutorial 13|coordinate system]]. }
373
374 {==== Multi-shape fill ====}
375
376 {** Draws and fill a polyline using current pen style/cap/join in one go.
377 The stroke is stricly over the fill even if partially transparent.
378 ''fillcolor'' specifies a color to fill the polygon formed by the points }
379 procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; override;
380 {** Draws a filled polygon using current pen style/cap/join in one go.
381 The stroke is stricly over the fill even if partially transparent.
382 The polygon is always closed. You don't need to set the last point
383 to be the same as the first point. }
384 procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; override;
385
386 {** Draws and fills an ellipse }
387 procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override;
388 procedure EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override;
389
390 {** Draws and fills a path }
391 procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; override;
392 procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; override;
393 procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; override;
394 procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; override;
395
396 {** Draws and fills a path with a matrix transform }
397 procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; override;
398 procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; override;
399 procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; override;
400 procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; override;
401
402 {** Draws a rectangle with antialiasing and fills it with color ''back''.
403 Note that the pixel (x2,y2) is included contrary to integer coordinates }
404 procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override;
405
406 {** Draws a rounded rectangle border with antialiasing. The corners have an
407 elliptical radius of ''rx'' and ''ry''. ''options'' specifies how to
408 draw the corners. See [[BGRABitmap Geometry types|geometry types]] }
409 procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); overload; override;
410 {** Draws a rounded rectangle border with the specified texture.
411 The corners have an elliptical radius of ''rx'' and ''ry''.
412 ''options'' specifies how to draw the corners.
413 See [[BGRABitmap Geometry types|geometry types]] }
414 procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); overload; override;
415 {** Draws and fills a round rectangle }
416 procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); overload; override;
417 {** Draws and fills a round rectangle with textures }
418 procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); overload; override;
419
420 {==== Gradient polygons ====}
421
422 procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
423 procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
424 procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); override;
425 procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); override;
426 procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); override;
427
428 procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
429 procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
430 procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True; ACulling: TFaceCulling = fcNone; ACropToPolygon: boolean = true); override;
431 procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); override;
432 procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACulling: TFaceCulling = fcNone); override;
433 procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
434 procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
435 procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override;
436 procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect); override;
437 procedure FillQuadAffineMapping(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; ADrawMode: TDrawMode = dmDrawWithTransparency; AOpacity: byte = 255); override;
438 procedure FillQuadAffineMappingAntialias(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; AOpacity: byte = 255); override;
439
440 {** Fills an ellipse with a gradient of color. ''outercolor'' specifies
441 the end color of the gradient on the border of the ellipse and
442 ''innercolor'' the end color of the gradient at the center of the ellipse }
443 procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); overload; override;
444 procedure FillEllipseLinearColorAntialias(AOrigin, AXAxis, AYAxis: TPointF; outercolor, innercolor: TBGRAPixel); overload; override;
445
446 procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); override;
447 procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); override;
448 procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel); override;
449 procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean; zbuffer: psingle = nil); override;
450 procedure FillPolyPerspectiveMappingLightness(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean; zbuffer: psingle = nil); override;
451
452 procedure ArrowStartAsNone; override;
453 procedure ArrowStartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
454 procedure ArrowStartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
455 procedure ArrowStartAsTail; override;
456
457 procedure ArrowEndAsNone; override;
458 procedure ArrowEndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
459 procedure ArrowEndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
460 procedure ArrowEndAsTail; override;
461
462 { Draws the UTF8 encoded string, with color c.
463 If align is taLeftJustify, (x,y) is the top-left corner.
464 If align is taCenter, (x,y) is at the top and middle of the text.
465 If align is taRightJustify, (x,y) is the top-right corner.
466 The value of FontOrientation is taken into account, so that the text may be rotated. }
467 procedure TextOut(x, y: single; const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override;
468
469 { Same as above functions, except that the text is filled using texture.
470 The value of FontOrientation is taken into account, so that the text may be rotated. }
471 procedure TextOut(x, y: single; const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override;
472
473 procedure TextOut(x, y: single; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; override;
474 procedure TextOut(x, y: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; override;
475
476 { Same as above, except that the orientation is specified, overriding the value of the property FontOrientation. }
477 procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override;
478 procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override;
479
480 procedure TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; override;
481 procedure TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; override;
482
483 procedure TextMultiline(ALeft,ATop,AWidth: single; const sUTF8: string; c: TBGRAPixel; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; override;
484 procedure TextMultiline(ALeft,ATop,AWidth: single; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; override;
485
486 { Draw the UTF8 encoded string at the coordinate (x,y), clipped inside the rectangle ARect.
487 Additional style information is provided by the style parameter.
488 The color c or texture is used to fill the text. No rotation is applied. }
489 procedure TextRect(ARect: TRect; x, y: integer; const sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; override;
490 procedure TextRect(ARect: TRect; x, y: integer; const sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; override;
491
492 { Returns the total size of the string provided using the current font.
493 Orientation is not taken into account, so that the width is along the text. End of lines are stripped from the string. }
TextSizenull494 function TextSize(const sUTF8: string): TSize; override;
TextSizeMultilinenull495 function TextSizeMultiline(const sUTF8: string; AMaxWidth: single = EmptySingle; AParagraphSpacing: single = 0): TSize; override;
496
497 { Returns the affine box of the string provided using the current font.
498 Orientation is taken into account. End of lines are stripped from the string. }
TextAffineBoxnull499 function TextAffineBox(const sUTF8: string): TAffineBox; override;
500
501 { Returns the total size of a paragraph i.e. with word break }
TextSizenull502 function TextSize(const sUTF8: string; AMaxWidth: integer): TSize; override;
TextSizenull503 function TextSize(const sUTF8: string; AMaxWidth: integer; ARightToLeft: boolean): TSize; override;
TextFitInfonull504 function TextFitInfo(const sUTF8: string; AMaxWidth: integer): integer; override;
505
506 {Spline}
ComputeClosedSplinenull507 function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override;
ComputeOpenedSplinenull508 function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override;
509
ComputeBezierCurvenull510 function ComputeBezierCurve(const ACurve: TCubicBezierCurve): ArrayOfTPointF; overload; override;
ComputeBezierCurvenull511 function ComputeBezierCurve(const ACurve: TQuadraticBezierCurve): ArrayOfTPointF; overload; override;
ComputeBezierSplinenull512 function ComputeBezierSpline(const ASpline: array of TCubicBezierCurve): ArrayOfTPointF; overload; override;
ComputeBezierSplinenull513 function ComputeBezierSpline(const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF; overload; override;
514
ComputeWidePolylinenull515 function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; overload; override;
ComputeWidePolylinenull516 function ComputeWidePolyline(const points: array of TPointF; w: single; ClosedCap: boolean): ArrayOfTPointF; overload; override;
ComputeWidePolygonnull517 function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; overload; override;
518
ComputeEllipseContournull519 function ComputeEllipseContour(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; override;
ComputeEllipseContournull520 function ComputeEllipseContour(AOrigin, AXAxis, AYAxis: TPointF; quality: single = 1): ArrayOfTPointF; overload; override;
ComputeEllipseBordernull521 function ComputeEllipseBorder(x,y,rx,ry,w: single; quality: single = 1): ArrayOfTPointF; overload; override;
ComputeEllipseBordernull522 function ComputeEllipseBorder(AOrigin, AXAxis, AYAxis: TPointF; w: single; quality: single = 1): ArrayOfTPointF; override; overload;
ComputeArc65536null523 function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; override;
ComputeArcRadnull524 function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; override;
ComputeRoundRectnull525 function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; override;
ComputeRoundRectnull526 function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; overload; override;
ComputePie65536null527 function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; override;
ComputePieRadnull528 function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; override;
529
530 {Filling}
531 procedure Fill(c: TBGRAPixel; start, Count: integer); overload; override;
532 procedure DrawPixels(c: TBGRAPixel; start, Count: integer); override;
533 procedure AlphaFill(alpha: byte; start, Count: integer); overload; override;
534 procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; const AColor: TBGRAPixel; ADrawMode: TDrawMode); overload; override;
535 procedure FillMask(x,y: integer; AMask: TCustomUniversalBitmap; ATexture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte); overload; override;
536 procedure EraseMask(x,y: integer; AMask: TBGRACustomBitmap; alpha: byte=255); override;
537 procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); override;
538 procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); override;
539 procedure ReplaceColor(before, after: TColor); overload; override;
540 procedure ReplaceColor(ABounds: TRect; before, after: TColor); overload; override;
541 procedure ParallelFloodFill(X, Y: integer; Dest: TCustomUniversalBitmap; Color: TBGRAPixel;
542 mode: TFloodfillMode; Tolerance: byte = 0; DestOfsX: integer = 0; DestOfsY: integer = 0); overload; override;
543 procedure ParallelFloodFill(X, Y: integer; Dest: TCustomUniversalBitmap; const Brush: TUniversalBrush;
544 Progressive: boolean; ToleranceW: Word = $00ff; DestOfsX: integer = 0; DestOfsY: integer = 0); overload; override;
545 procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
546 gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
547 gammaColorCorrection: boolean = True; Sinus: Boolean=False;
548 ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); override;
549 procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
550 gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
551 Sinus: Boolean=False; ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); override;
552
ScanAtIntegernull553 function ScanAtInteger(X,Y: integer): TBGRAPixel; override;
ScanNextPixelnull554 function ScanNextPixel: TBGRAPixel; override;
ScanAtnull555 function ScanAt(X,Y: Single): TBGRAPixel; override;
IsScanPutPixelsDefinednull556 function IsScanPutPixelsDefined: boolean; override;
557 procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override;
558
559 {Canvas drawing functions}
560 procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); overload; override;
561 procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); overload; override;
562 procedure InvalidateBitmap; override; //call if you modify with Scanline
563 procedure LoadFromBitmapIfNeeded; override; //call to ensure that bitmap data is up to date
564 procedure NotifyBitmapChange; inline;
565
566 {BGRA bitmap functions}
567 procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); overload; override;
568 procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); overload; override;
569 procedure PutImage(X, Y: integer; ASource: TCustomUniversalBitmap; AMode: TDrawMode; AOpacity: byte); overload; override;
570 procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255; APixelCenteredCoords: boolean = true); overload; override;
GetImageAffineBoundsnull571 function GetImageAffineBounds(AMatrix: TAffineMatrix; ASourceBounds: TRect; AClipOutput: boolean = true; APixelCenteredCoords: boolean = true): TRect; overload; override;
IsAffineRoughlyTranslationnull572 class function IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean; override;
573
574 procedure StretchPutImage(ARect: TRect; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); override;
575 procedure BlendRect(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AExcludeChannels: TChannels); overload; override;
576 procedure BlendRectOver(ADest: TRect; AColor: TBGRAPixel; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean; AExcludeChannels: TChannels); overload; override;
577 procedure BlendImage(x, y: integer; ASource: TBGRACustomBitmap; AOperation: TBlendOperation); overload; override;
578 procedure BlendImage(ADest: TRect; ASource: IBGRAScanner; AOffsetX, AOffsetY: integer; AOperation: TBlendOperation); overload; override;
579 procedure BlendImageOver(x, y: integer; ASource: TBGRACustomBitmap; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false); overload; override;
580 procedure BlendImageOver(ADest: TRect; ASource: IBGRAScanner; AOffsetX, AOffsetY: integer; AOperation: TBlendOperation; AOpacity: byte = 255; ALinearBlend: boolean = false); overload; override;
581
GetPtrBitmapnull582 function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; override;
MakeBitmapCopynull583 function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; override;
584
Resamplenull585 function Resample(newWidth, newHeight: integer;
586 mode: TResampleMode = rmFineResample): TBGRADefaultBitmap; override;
587 procedure Negative; override;
588 procedure NegativeRect(ABounds: TRect); override;
589 procedure LinearNegative; override;
590 procedure LinearNegativeRect(ABounds: TRect); override;
591 procedure InplaceGrayscale(AGammaCorrection: boolean = true); overload; override;
592 procedure InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true); overload; override;
593 procedure InplaceNormalize(AEachChannel: boolean = True); overload; override;
594 procedure InplaceNormalize(ABounds: TRect; AEachChannel: boolean = True); overload; override;
595 procedure SwapRedBlue; override;
596 procedure SwapRedBlue(ARect: TRect); override;
597 procedure GrayscaleToAlpha; override;
598 procedure AlphaToGrayscale; override;
GetMaskFromAlphanull599 function GetMaskFromAlpha: TBGRADefaultBitmap; override;
GetGrayscaleMaskFromAlphanull600 function GetGrayscaleMaskFromAlpha: TGrayscaleMask;
601 procedure ConvertToLinearRGB; override;
602 procedure ConvertFromLinearRGB; override;
603
604 {Filters}
FilterSmartZoom3null605 function FilterSmartZoom3(Option: TMedianOption): TBGRADefaultBitmap; override;
FilterMediannull606 function FilterMedian(Option: TMedianOption): TBGRADefaultBitmap; override;
FilterSmoothnull607 function FilterSmooth: TBGRADefaultBitmap; override;
FilterSharpennull608 function FilterSharpen(Amount: single = 1): TBGRADefaultBitmap; overload; override;
FilterSharpennull609 function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRADefaultBitmap; overload; override;
FilterContournull610 function FilterContour(AGammaCorrection: boolean = false): TBGRADefaultBitmap; override;
FilterPixelatenull611 function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRADefaultBitmap; override;
FilterEmbossnull612 function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRADefaultBitmap; overload; override;
FilterEmbossnull613 function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRADefaultBitmap; overload; override;
FilterEmbossHighlightnull614 function FilterEmbossHighlight(FillSelection: boolean): TBGRADefaultBitmap; overload; override;
FilterEmbossHighlightnull615 function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRADefaultBitmap; overload; override;
FilterEmbossHighlightnull616 function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRADefaultBitmap; overload; override;
FilterGrayscalenull617 function FilterGrayscale: TBGRADefaultBitmap; overload; override;
FilterGrayscalenull618 function FilterGrayscale(ABounds: TRect): TBGRADefaultBitmap; overload; override;
FilterNormalizenull619 function FilterNormalize(eachChannel: boolean = True): TBGRADefaultBitmap; overload; override;
FilterNormalizenull620 function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRADefaultBitmap; overload; override;
FilterRotatenull621 function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRADefaultBitmap; override;
FilterAffinenull622 function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGRADefaultBitmap; override;
FilterSpherenull623 function FilterSphere: TBGRADefaultBitmap; override;
FilterTwirlnull624 function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRADefaultBitmap; overload; override;
FilterTwirlnull625 function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRADefaultBitmap; overload; override;
FilterCylindernull626 function FilterCylinder: TBGRADefaultBitmap; override;
FilterPlanenull627 function FilterPlane: TBGRADefaultBitmap; override;
628 end;
629
630 { TBGRAPtrBitmap }
631
632 TBGRAPtrBitmap = class(TBGRADefaultBitmap)
633 protected
GetLineOrdernull634 function GetLineOrder: TRawImageLineOrder; override;
635 procedure SetLineOrder(AValue: TRawImageLineOrder); override;
636 procedure ReallocData; override;
637 procedure FreeData; override;
638 procedure CannotResize;
639 procedure NotImplemented;
640 procedure RebuildBitmap; override;
641
CreateDefaultFontRenderernull642 function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; //to override
LoadFromRawImagenull643 function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte;
644 {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean
645 =True): boolean; override; //to override
646 public
647 constructor Create(AWidth, AHeight: integer; AData: Pointer); overload;
648 procedure SetDataPtr(AData: Pointer);
649 property LineOrder: TRawImageLineOrder Read GetLineOrder Write SetLineOrder;
650
651 procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer;
652 {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; //to override
653 procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer;
654 {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; //to override
655 procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //to override
656
657 procedure Assign({%H-}Source: TPersistent); override;
658 procedure TakeScreenshot({%H-}ARect: TRect); override;
659 procedure TakeScreenshotOfPrimaryMonitor; override;
660 procedure LoadFromDevice({%H-}DC: HDC); override;
661 procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override;
662 end;
663
664 { TBGRAMemoryStreamBitmap }
665
666 TBGRAMemoryStreamBitmap = class(TBGRAPtrBitmap)
667 private
GetOwnStreamnull668 function GetOwnStream: boolean;
669 procedure SetOwnStream(AValue: boolean);
670 protected
671 FStream: TMemoryStream;
672 FStreamOffset: IntPtr;
673 FOwnStream: boolean;
674 public
675 constructor Create(AWidth, AHeight: integer; AStream: TMemoryStream; AStreamOffset: IntPtr; AOwnStream: boolean);
676 constructor Create(AWidth, AHeight: integer); override;
677 constructor Create(AWidth, AHeight: integer; AColor: TBGRAPixel);
678 destructor Destroy; override;
679 property OwnStream: boolean read GetOwnStream write SetOwnStream;
680 property Stream: TMemoryStream read FStream;
681 end;
682
683 var
684 DefaultTextStyle: TTextStyle;
685
686 procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer;
687 c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
688 gammaColorCorrection: boolean = True; Sinus: Boolean=False);
689
690 implementation
691
692 uses Math, BGRAUTF8, BGRABlend, BGRAFilters, BGRAGradientScanner,
693 BGRAResample, BGRAPolygon, BGRAPolygonAliased,
694 BGRAPath, FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM,
695 BGRAReadBMP, BGRAReadJpeg,
696 BGRADithering, BGRAFilterScanner;
697
698 { TBGRAMemoryStreamBitmap }
699
GetOwnStreamnull700 function TBGRAMemoryStreamBitmap.GetOwnStream: boolean;
701 begin
702 result := FOwnStream;
703 end;
704
705 procedure TBGRAMemoryStreamBitmap.SetOwnStream(AValue: boolean);
706 begin
707 FOwnStream:= AValue;
708 end;
709
710 constructor TBGRAMemoryStreamBitmap.Create(AWidth, AHeight: integer;
711 AStream: TMemoryStream; AStreamOffset: IntPtr; AOwnStream: boolean);
712 begin
713 inherited Create(AWidth, AHeight, PByte(AStream.Memory) + AStreamOffset);
714 FStream := AStream;
715 FStreamOffset:= AStreamOffset;
716 FOwnStream := AOwnStream;
717 end;
718
719 constructor TBGRAMemoryStreamBitmap.Create(AWidth, AHeight: integer);
720 begin
721 Create(AWidth, AHeight, BGRAPixelTransparent);
722 end;
723
724 constructor TBGRAMemoryStreamBitmap.Create(AWidth, AHeight: integer;
725 AColor: TBGRAPixel);
726 begin
727 inherited Create(AWidth, AHeight);
728 FStream := TMemoryStream.Create;
729 FStreamOffset:= 0;
730 FStream.Size := RowSize * Height;
731 FOwnStream := true;
732 SetDataPtr(PByte(FStream.Memory) + FStreamOffset);
733 Fill(AColor, dmSet);
734 end;
735
736 destructor TBGRAMemoryStreamBitmap.Destroy;
737 begin
738 if FOwnStream then FStream.Free;
739 inherited Destroy;
740 end;
741
742 { TBGRADefaultBitmap }
743
TBGRADefaultBitmap.CheckEmptynull744 function TBGRADefaultBitmap.CheckEmpty: boolean;
745 const
746 alphaMask = $ff shl TBGRAPixel_AlphaShift;
747 var
748 i: integer;
749 p: PBGRAPixel;
750 begin
751 p := Data;
752 for i := (NbPixels shr 1) - 1 downto 0 do
753 begin
754 if PInt64(p)^ and (alphaMask or (alphaMask shl 32)) <> 0 then
755 begin
756 Result := False;
757 exit;
758 end;
759 Inc(p,2);
760 end;
761 if Odd(NbPixels) and (p^.alpha <> 0) then
762 begin
763 Result := false;
764 exit;
765 end;
766 Result := True;
767 end;
768
GetCanvasAlphaCorrectionnull769 function TBGRADefaultBitmap.GetCanvasAlphaCorrection: boolean;
770 begin
771 Result := (FCanvasOpacity <> 0);
772 end;
773
GetCustomPenStylenull774 function TBGRADefaultBitmap.GetCustomPenStyle: TBGRAPenStyle;
775 begin
776 result := GetInternalPen.CustomPenStyle;
777 end;
778
779 procedure TBGRADefaultBitmap.SetCanvasAlphaCorrection(const AValue: boolean);
780 begin
781 if AValue then
782 begin
783 if FCanvasOpacity = 0 then
784 FCanvasOpacity := 255;
785 end
786 else
787 FCanvasOpacity := 0;
788 end;
789
790 procedure TBGRADefaultBitmap.DoLoadFromBitmap;
791 begin
792 //nothing
793 end;
794
795 procedure TBGRADefaultBitmap.SetCustomPenStyle(const AValue: TBGRAPenStyle);
796 begin
797 GetInternalPen.CustomPenStyle := AValue;
798 end;
799
800 procedure TBGRADefaultBitmap.SetPenStyle(const AValue: TPenStyle);
801 begin
802 GetInternalPen.Style := AValue;
803 end;
804
GetPenStylenull805 function TBGRADefaultBitmap.GetPenStyle: TPenStyle;
806 begin
807 Result:= GetInternalPen.Style;
808 end;
809
TBGRADefaultBitmap.GetArrowEndSizenull810 function TBGRADefaultBitmap.GetArrowEndSize: TPointF;
811 begin
812 result := GetArrow.EndSize;
813 end;
814
TBGRADefaultBitmap.GetArrowStartSizenull815 function TBGRADefaultBitmap.GetArrowStartSize: TPointF;
816 begin
817 result := GetArrow.StartSize;
818 end;
819
820 procedure TBGRADefaultBitmap.SetArrowEndSize(AValue: TPointF);
821 begin
822 {$PUSH}{$OPTIMIZATION OFF}
823 GetArrow.EndSize := AValue;
824 {$POP}
825 end;
826
827 procedure TBGRADefaultBitmap.SetArrowStartSize(AValue: TPointF);
828 begin
829 {$PUSH}{$OPTIMIZATION OFF}
830 GetArrow.StartSize := AValue;
831 {$POP}
832 end;
833
TBGRADefaultBitmap.GetArrowEndOffsetnull834 function TBGRADefaultBitmap.GetArrowEndOffset: single;
835 begin
836 result := GetArrow.EndOffsetX;
837 end;
838
TBGRADefaultBitmap.GetArrowStartOffsetnull839 function TBGRADefaultBitmap.GetArrowStartOffset: single;
840 begin
841 result := GetArrow.StartOffsetX;
842 end;
843
844 procedure TBGRADefaultBitmap.SetArrowEndOffset(AValue: single);
845 begin
846 GetArrow.EndOffsetX := AValue;
847 end;
848
849 procedure TBGRADefaultBitmap.SetArrowStartOffset(AValue: single);
850 begin
851 GetArrow.StartOffsetX := AValue;
852 end;
853
TBGRADefaultBitmap.GetArrowEndRepeatnull854 function TBGRADefaultBitmap.GetArrowEndRepeat: integer;
855 begin
856 result := GetArrow.EndRepeatCount;
857 end;
858
TBGRADefaultBitmap.GetArrowStartRepeatnull859 function TBGRADefaultBitmap.GetArrowStartRepeat: integer;
860 begin
861 result := GetArrow.StartRepeatCount;
862 end;
863
864 procedure TBGRADefaultBitmap.SetArrowEndRepeat(AValue: integer);
865 begin
866 GetArrow.EndRepeatCount := AValue;
867 end;
868
869 procedure TBGRADefaultBitmap.SetArrowStartRepeat(AValue: integer);
870 begin
871 GetArrow.StartRepeatCount := AValue;
872 end;
873
874 procedure TBGRADefaultBitmap.SetFontHeight(AHeight: integer);
875 begin
876 FFontHeight := AHeight;
877 end;
878
GetFontFullHeightnull879 function TBGRADefaultBitmap.GetFontFullHeight: integer;
880 begin
881 if FontHeight < 0 then
882 result := -FontHeight
883 else
884 result := TextSize('Hg').cy;
885 end;
886
887 procedure TBGRADefaultBitmap.SetFontFullHeight(AHeight: integer);
888 begin
889 if AHeight > 0 then
890 FontHeight := -AHeight
891 else
892 FontHeight := 1;
893 end;
894
TBGRADefaultBitmap.GetFontPixelMetricnull895 function TBGRADefaultBitmap.GetFontPixelMetric: TFontPixelMetric;
896 begin
897 result := FontRenderer.GetFontPixelMetric;
898 end;
899
TBGRADefaultBitmap.GetFontRenderernull900 function TBGRADefaultBitmap.GetFontRenderer: TBGRACustomFontRenderer;
901 begin
902 if FFontRenderer = nil then FFontRenderer := CreateDefaultFontRenderer;
903 if FFontRenderer = nil then raise exception.Create('No font renderer');
904 result := FFontRenderer;
905 result.FontName := FontName;
906 result.FontStyle := FontStyle;
907 result.FontQuality := FontQuality;
908 result.FontOrientation := FontOrientation;
909 result.FontEmHeight := FFontHeight;
910 end;
911
912 procedure TBGRADefaultBitmap.SetFontRenderer(AValue: TBGRACustomFontRenderer);
913 begin
914 if AValue = FFontRenderer then exit;
915 FFontRenderer.Free;
916 FFontRenderer := AValue
917 end;
918
TBGRADefaultBitmap.GetFontVerticalAnchorOffsetnull919 function TBGRADefaultBitmap.GetFontVerticalAnchorOffset: single;
920 begin
921 case FontVerticalAnchor of
922 fvaTop: result := 0;
923 fvaCenter: result := FontFullHeight*0.5;
924 fvaCapLine: result := FontPixelMetric.CapLine;
925 fvaCapCenter: result := (FontPixelMetric.CapLine+FontPixelMetric.Baseline)*0.5;
926 fvaXLine: result := FontPixelMetric.xLine;
927 fvaXCenter: result := (FontPixelMetric.xLine+FontPixelMetric.Baseline)*0.5;
928 fvaBaseline: result := FontPixelMetric.Baseline;
929 fvaDescentLine: result := FontPixelMetric.DescentLine;
930 fvaBottom: result := FontFullHeight;
931 else
932 result := 0;
933 end;
934 end;
935
TBGRADefaultBitmap.GetFontAnchorRotatedOffsetnull936 function TBGRADefaultBitmap.GetFontAnchorRotatedOffset: TPointF;
937 begin
938 result := GetFontAnchorRotatedOffset(FontOrientation);
939 end;
940
TBGRADefaultBitmap.GetFontAnchorRotatedOffsetnull941 function TBGRADefaultBitmap.GetFontAnchorRotatedOffset(
942 ACustomOrientation: integer): TPointF;
943 begin
944 result := PointF(0, GetFontVerticalAnchorOffset);
945 if ACustomOrientation <> 0 then
946 result := AffineMatrixRotationDeg(-ACustomOrientation*0.1)*result;
947 end;
948
949 { Creates a new bitmap with dimensions 0 x 0 }
TBGRADefaultBitmap.NewBitmapnull950 function TBGRADefaultBitmap.NewBitmap: TBGRADefaultBitmap;
951 begin
952 Result := inherited NewBitmap as TBGRADefaultBitmap;
953 end;
954
955 { Creates a new bitmap with dimensions AWidth and AHeight and filled with
956 transparent pixels. Internally, it uses the same type so that if you
957 use an optimized version, you get a new bitmap with the same optimizations }
TBGRADefaultBitmap.NewBitmapnull958 function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer): TBGRADefaultBitmap;
959 begin
960 result := inherited NewBitmap(AWidth, AHeight) as TBGRADefaultBitmap;
961 end;
962
963 { Can only be called from an existing instance of TBGRABitmap.
964 Creates a new instance with dimensions AWidth and AHeight,
965 and fills it with Color. }
TBGRADefaultBitmap.NewBitmapnull966 function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer;
967 const Color: TBGRAPixel): TBGRADefaultBitmap;
968 begin
969 result := inherited NewBitmap(AWidth, AHeight, Color) as TBGRADefaultBitmap;
970 end;
971
TBGRADefaultBitmap.NewBitmapnull972 function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer; AColor: Pointer): TBGRADefaultBitmap;
973 begin
974 result := inherited NewBitmap(AWidth, AHeight, AColor) as TBGRADefaultBitmap;
975 end;
976
977 { Creates a new bitmap and loads it contents from a file.
978 The encoding of the string is the default one for the operating system.
979 It is recommended to use the next function and UTF8 encoding }
TBGRADefaultBitmap.NewBitmapnull980 function TBGRADefaultBitmap.NewBitmap(Filename: string): TBGRADefaultBitmap;
981 var
982 BGRAClass: TBGRABitmapAny;
983 begin
984 BGRAClass := TBGRABitmapAny(self.ClassType);
985 Result := BGRAClass.Create(Filename) as TBGRADefaultBitmap;
986 end;
987
988 { Creates a new bitmap and loads it contents from a file.
989 It is recommended to use UTF8 encoding }
TBGRADefaultBitmap.NewBitmapnull990 function TBGRADefaultBitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGRADefaultBitmap;
991 var
992 BGRAClass: TBGRABitmapAny;
993 begin
994 BGRAClass := TBGRABitmapAny(self.ClassType);
995 Result := BGRAClass.Create(Filename,AIsUtf8) as TBGRADefaultBitmap;
996 end;
997
TBGRADefaultBitmap.NewBitmapnull998 function TBGRADefaultBitmap.NewBitmap(Filename: string; AIsUtf8: boolean;
999 AOptions: TBGRALoadingOptions): TBGRADefaultBitmap;
1000 var
1001 BGRAClass: TBGRABitmapAny;
1002 begin
1003 BGRAClass := TBGRABitmapAny(self.ClassType);
1004 Result := BGRAClass.Create(Filename,AIsUtf8,AOptions) as TBGRADefaultBitmap;
1005 end;
1006
TBGRADefaultBitmap.NewBitmapnull1007 function TBGRADefaultBitmap.NewBitmap(AFPImage: TFPCustomImage): TBGRADefaultBitmap;
1008 var
1009 BGRAClass: TBGRABitmapAny;
1010 begin
1011 BGRAClass := TBGRABitmapAny(self.ClassType);
1012 Result := BGRAClass.Create(AFPImage) as TBGRADefaultBitmap;
1013 end;
1014
1015 {----------------------- TFPCustomImage override ------------------------------}
1016
1017 { Set the size of the current bitmap. All data is lost during the process }
1018 procedure TBGRADefaultBitmap.SetSize(AWidth, AHeight: integer);
1019 begin
1020 if (Width <> AWidth) or (Height <> AHeight) then
1021 begin
1022 inherited SetSize(AWidth, AHeight);
1023 FreeBitmap;
1024 end;
1025 end;
1026
1027 {---------------------- Constructors ---------------------------------}
1028
1029 constructor TBGRADefaultBitmap.Create(AFPImage: TFPCustomImage);
1030 begin
1031 inherited Create;
1032 Assign(AFPImage);
1033 end;
1034
1035 { Creates an image of dimensions AWidth and AHeight and filled with transparent pixels. }
1036 constructor TBGRADefaultBitmap.Create(ABitmap: TBitmap; AUseTransparent: boolean);
1037 begin
1038 inherited Create;
1039 Assign(ABitmap, AUseTransparent);
1040 end;
1041
1042 { Creates an image by loading its content from the file AFilename.
1043 The encoding of the string is the default one for the operating system.
1044 It is recommended to use the next constructor and UTF8 encoding. }
1045 constructor TBGRADefaultBitmap.Create(AFilename: string);
1046 begin
1047 inherited Create;
1048 LoadFromFile(Afilename);
1049 end;
1050
1051 { Free the object and all its resources }
1052 destructor TBGRADefaultBitmap.Destroy;
1053 begin
1054 DiscardXorMask;
1055 FFontRenderer.Free;
1056 {$IFDEF BGRABITMAP_USE_FPCANVAS}FCanvasFP.Free;{$ENDIF}
1057 FCanvasBGRA.Free;
1058 FCanvas2D.Free;
1059 FreeBitmap;
1060 inherited Destroy;
1061 end;
1062
1063 {------------------------- Loading functions ----------------------------------}
1064
1065 { Creates an image by loading its content from the file AFilename.
1066 The boolean AIsUtf8Filename specifies if UTF8 encoding is assumed for the filename. }
1067 constructor TBGRADefaultBitmap.Create(AFilename: string; AIsUtf8: boolean);
1068 begin
1069 inherited Create;
1070 if AIsUtf8 then
1071 LoadFromFileUTF8(Afilename)
1072 else
1073 LoadFromFile(Afilename);
1074 end;
1075
1076 constructor TBGRADefaultBitmap.Create(AFilename: string; AIsUtf8: boolean;
1077 AOptions: TBGRALoadingOptions);
1078 begin
1079 inherited Create;
1080 if AIsUtf8 then
1081 LoadFromFileUTF8(Afilename, AOptions)
1082 else
1083 LoadFromFile(Afilename, AOptions);
1084 end;
1085
1086 { Creates an image by loading its content from the stream AStream. }
1087 constructor TBGRADefaultBitmap.Create(AStream: TStream);
1088 begin
1089 inherited Create;
1090 LoadFromStream(AStream);
1091 end;
1092
1093 procedure TBGRADefaultBitmap.Serialize(AStream: TStream);
1094 begin
1095 If TBGRAPixel_RGBAOrder then
1096 begin
1097 LoadFromBitmapIfNeeded;
1098 TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(Data,Data,FNbPixels,False);
1099 end;
1100 inherited Serialize(AStream);
1101 If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(Data,Data,FNbPixels,False);
1102 end;
1103
1104 procedure TBGRADefaultBitmap.Deserialize(AStream: TStream);
1105 begin
1106 inherited Deserialize(AStream);
1107 If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(Data,Data,FNbPixels,False);
1108 InvalidateBitmap;
1109 end;
1110
1111 procedure TBGRADefaultBitmap.SolidBrushIndirect(out
1112 ABrush: TUniversalBrush; AColor: Pointer; ADrawMode: TDrawMode);
1113 begin
1114 BGRASolidBrushIndirect(ABrush, AColor, ADrawMode);
1115 end;
1116
1117 class procedure TBGRADefaultBitmap.SolidBrush(out ABrush: TUniversalBrush;
1118 const AColor: TBGRAPixel; ADrawMode: TDrawMode);
1119 begin
1120 BGRASolidBrushIndirect(ABrush, @AColor, ADrawMode);
1121 end;
1122
1123 class procedure TBGRADefaultBitmap.ScannerBrush(out ABrush: TUniversalBrush;
1124 AScanner: IBGRAScanner; ADrawMode: TDrawMode;
1125 AOffsetX: integer; AOffsetY: integer);
1126 begin
1127 BGRAScannerBrush(ABrush, AScanner, ADrawMode, AOffsetX, AOffsetY);
1128 end;
1129
1130 class procedure TBGRADefaultBitmap.MaskBrush(out ABrush: TUniversalBrush;
1131 AScanner: IBGRAScanner; AOffsetX: integer; AOffsetY: integer);
1132 begin
1133 BGRAMaskBrush(ABrush, AScanner, AOffsetX, AOffsetY);
1134 end;
1135
1136 class procedure TBGRADefaultBitmap.EraseBrush(out ABrush: TUniversalBrush;
1137 AAlpha: Word);
1138 begin
1139 BGRAEraseBrush(ABrush, AAlpha);
1140 end;
1141
1142 class procedure TBGRADefaultBitmap.AlphaBrush(out ABrush: TUniversalBrush;
1143 AAlpha: Word);
1144 begin
1145 BGRAAlphaBrush(ABrush, AAlpha);
1146 end;
1147
1148 procedure TBGRADefaultBitmap.Assign(Source: TPersistent);
1149 var pdest: PBGRAPixel;
1150 x,y: Int32or64;
1151 begin
1152 if Source is TBGRACustomBitmap then
1153 begin
1154 DiscardBitmapChange;
1155 SetSize(TBGRACustomBitmap(Source).Width, TBGRACustomBitmap(Source).Height);
1156 PutImage(0, 0, TBGRACustomBitmap(Source), dmSet);
1157 if Source is TBGRADefaultBitmap then
1158 begin
1159 HotSpot := TBGRADefaultBitmap(Source).HotSpot;
1160 if XorMask <> TBGRADefaultBitmap(Source).XorMask then
1161 begin
1162 DiscardXorMask;
1163 if TBGRADefaultBitmap(Source).XorMask is TBGRADefaultBitmap then
1164 FXorMask := TBGRADefaultBitmap(TBGRADefaultBitmap(Source).XorMask).NewReference as TBGRADefaultBitmap
1165 else
1166 FXorMask := TBGRADefaultBitmap(Source).XorMask.Duplicate;
1167 end;
1168 end;
1169 end else
1170 if Source is TFPCustomImage then
1171 begin
1172 DiscardBitmapChange;
1173 SetSize(TFPCustomImage(Source).Width, TFPCustomImage(Source).Height);
1174 for y := 0 to TFPCustomImage(Source).Height-1 do
1175 begin
1176 pdest := ScanLine[y];
1177 for x := 0 to TFPCustomImage(Source).Width-1 do
1178 begin
1179 pdest^ := FPColorToBGRA(TFPCustomImage(Source).Colors[x,y]);
1180 inc(pdest);
1181 end;
1182 end;
1183 end else
1184 inherited Assign(Source);
1185 end;
1186
1187 procedure TBGRADefaultBitmap.Assign(Source: TBitmap; AUseTransparent: boolean);
1188 var
1189 transpColor: TBGRAPixel;
1190 begin
1191 Assign(Source);
1192 if AUseTransparent and TBitmap(Source).Transparent then
1193 begin
1194 if TBitmap(Source).TransparentMode = tmFixed then
1195 transpColor := ColorToBGRA(TBitmap(Source).TransparentColor)
1196 else
1197 transpColor := GetPixel(0,Height-1);
1198 ReplaceColor(transpColor, BGRAPixelTransparent);
1199 end;
1200 end;
1201
1202 {------------------------- Clipping -------------------------------}
1203
InternalGetPixelCycle256null1204 function TBGRADefaultBitmap.InternalGetPixelCycle256(ix, iy: int32or64; iFactX,
1205 iFactY: int32or64): TBGRAPixel;
1206 var
1207 ixMod2: int32or64;
1208 pUpLeft, pUpRight, pDownLeft, pDownRight: PBGRAPixel;
1209 scan: PBGRAPixel;
1210 begin
1211 scan := GetScanlineFast(iy);
1212
1213 pUpLeft := (scan + ix);
1214 ixMod2 := ix+1;
1215 if ixMod2=Width then ixMod2 := 0;
1216 pUpRight := (scan + ixMod2);
1217
1218 Inc(iy);
1219 if iy = Height then iy := 0;
1220 scan := GetScanlineFast(iy);
1221 pDownLeft := (scan + ix);
1222 pDownRight := (scan + ixMod2);
1223
1224 InterpolateBilinear(pUpLeft, pUpRight, pDownLeft,
1225 pDownRight, iFactX, iFactY, @result);
1226 end;
1227
InternalGetPixel256null1228 function TBGRADefaultBitmap.InternalGetPixel256(ix, iy: int32or64; iFactX,
1229 iFactY: int32or64; smoothBorder: boolean): TBGRAPixel;
1230 var
1231 pUpLeft, pUpRight, pDownLeft, pDownRight: PBGRAPixel;
1232 scan: PBGRAPixel;
1233 begin
1234 if (iy >= 0) and (iy < FHeight) then
1235 begin
1236 scan := GetScanlineFast(iy);
1237
1238 if (ix >= 0) and (ix < FWidth) then
1239 pUpLeft := scan+ix
1240 else if smoothBorder then
1241 pUpLeft := @BGRAPixelTransparent
1242 else
1243 pUpLeft := nil;
1244
1245 if (ix+1 >= 0) and (ix+1 < FWidth) then
1246 pUpRight := scan+(ix+1)
1247 else if smoothBorder then
1248 pUpRight := @BGRAPixelTransparent
1249 else
1250 pUpRight := nil;
1251 end else
1252 if smoothBorder then
1253 begin
1254 pUpLeft := @BGRAPixelTransparent;
1255 pUpRight := @BGRAPixelTransparent;
1256 end else
1257 begin
1258 pUpLeft := nil;
1259 pUpRight := nil;
1260 end;
1261
1262 if (iy+1 >= 0) and (iy+1 < FHeight) then
1263 begin
1264 scan := GetScanlineFast(iy+1);
1265
1266 if (ix >= 0) and (ix < FWidth) then
1267 pDownLeft := scan+ix
1268 else if smoothBorder then
1269 pDownLeft := @BGRAPixelTransparent
1270 else
1271 pDownLeft := nil;
1272
1273 if (ix+1 >= 0) and (ix+1 < FWidth) then
1274 pDownRight := scan+(ix+1)
1275 else if smoothBorder then
1276 pDownRight := @BGRAPixelTransparent
1277 else
1278 pDownRight := nil;
1279 end else
1280 if smoothBorder then
1281 begin
1282 pDownLeft := @BGRAPixelTransparent;
1283 pDownRight := @BGRAPixelTransparent;
1284 end else
1285 begin
1286 pDownLeft := nil;
1287 pDownRight := nil;
1288 end;
1289
1290 InterpolateBilinear(pUpLeft, pUpRight, pDownLeft,
1291 pDownRight, iFactX, iFactY, @result);
1292 end;
1293
1294 {-------------------------- Pixel functions -----------------------------------}
1295
1296 procedure TBGRADefaultBitmap.XorPixel(x, y: int32or64; const c: TBGRAPixel);
1297 var
1298 p : PLongWord;
1299 begin
1300 if not PtInClipRect(x,y) then exit;
1301 LoadFromBitmapIfNeeded;
1302 p := PLongWord(GetScanlineFast(y) +x);
1303 p^ := p^ xor LongWord(c);
1304 InvalidateBitmap;
1305 end;
1306
1307 procedure TBGRADefaultBitmap.SetPixel(x, y: int32or64; c: TColor);
1308 var
1309 p: PBGRAPixel;
1310 begin
1311 if not PtInClipRect(x,y) then exit;
1312 LoadFromBitmapIfNeeded;
1313 p := GetScanlineFast(y) + x;
1314 RedGreenBlue(c, p^.red,p^.green,p^.blue);
1315 p^.alpha := 255;
1316 InvalidateBitmap;
1317 end;
1318
1319 procedure TBGRADefaultBitmap.DrawPixel(x, y: int32or64; const c: TBGRAPixel);
1320 begin
1321 if not PtInClipRect(x,y) then exit;
1322 LoadFromBitmapIfNeeded;
1323 DrawPixelInlineWithAlphaCheck(GetScanlineFast(y) + x, c);
1324 InvalidateBitmap;
1325 end;
1326
1327 procedure TBGRADefaultBitmap.FastBlendPixel(x, y: int32or64; const c: TBGRAPixel);
1328 begin
1329 if not PtInClipRect(x,y) then exit;
1330 LoadFromBitmapIfNeeded;
1331 FastBlendPixelInline(GetScanlineFast(y) + x, c);
1332 InvalidateBitmap;
1333 end;
1334
1335 procedure TBGRADefaultBitmap.ErasePixel(x, y: int32or64; alpha: byte);
1336 begin
1337 if not PtInClipRect(x,y) then exit;
1338 LoadFromBitmapIfNeeded;
1339 ErasePixelInline(GetScanlineFast(y) + x, alpha);
1340 InvalidateBitmap;
1341 end;
1342
1343 procedure TBGRADefaultBitmap.AlphaPixel(x, y: int32or64; alpha: byte);
1344 begin
1345 if not PtInClipRect(x,y) then exit;
1346 LoadFromBitmapIfNeeded;
1347 if alpha = 0 then
1348 (GetScanlineFast(y) +x)^ := BGRAPixelTransparent
1349 else
1350 (GetScanlineFast(y) +x)^.alpha := alpha;
1351 InvalidateBitmap;
1352 end;
1353
TBGRADefaultBitmap.GetPixel256null1354 function TBGRADefaultBitmap.GetPixel256(x, y, fracX256, fracY256: int32or64;
1355 AResampleFilter: TResampleFilter; smoothBorder: boolean = true): TBGRAPixel;
1356 begin
1357 if (fracX256 = 0) and (fracY256 = 0) then
1358 result := GetPixel(x,y)
1359 else if AResampleFilter = rfBox then
1360 begin
1361 if fracX256 >= 128 then inc(x);
1362 if fracY256 >= 128 then inc(y);
1363 result := GetPixel(x,y);
1364 end else
1365 begin
1366 LoadFromBitmapIfNeeded;
1367 result := InternalGetPixel256(x,y,FineInterpolation256(fracX256,AResampleFilter),FineInterpolation256(fracY256,AResampleFilter),smoothBorder);
1368 end;
1369 end;
1370
1371 {$hints off}
1372 { This function compute an interpolated pixel at floating point coordinates }
GetPixelnull1373 function TBGRADefaultBitmap.GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel;
1374 var
1375 ix, iy: Int32or64;
1376 iFactX,iFactY: Int32or64;
1377 begin
1378 ix := round(x*256);
1379 if (ix<= -256) or (ix>=Width shl 8) then
1380 begin
1381 result := BGRAPixelTransparent;
1382 exit;
1383 end;
1384 iy := round(y*256);
1385 if (iy<= -256) or (iy>=Height shl 8) then
1386 begin
1387 result := BGRAPixelTransparent;
1388 exit;
1389 end;
1390
1391 iFactX := ix and 255; //distance from integer coordinate
1392 iFactY := iy and 255;
1393 if ix<0 then ix := -1 else ix := ix shr 8;
1394 if iy<0 then iy := -1 else iy := iy shr 8;
1395
1396 //if the coordinate is integer, then call standard GetPixel function
ifnull1397 if (iFactX = 0) and (iFactY = 0) then
1398 begin
1399 Result := (GetScanlineFast(iy)+ix)^;
1400 exit;
1401 end;
1402
1403 LoadFromBitmapIfNeeded;
1404 result := InternalGetPixel256(ix,iy,FineInterpolation256(iFactX,AResampleFilter),FineInterpolation256(iFactY,AResampleFilter),smoothBorder);
1405 end;
1406
1407 { Same as GetPixel(single,single,TResampleFilter) but with coordinate cycle, supposing the image repeats itself in both directions }
TBGRADefaultBitmap.GetPixelCyclenull1408 function TBGRADefaultBitmap.GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel;
1409 var
1410 ix, iy: Int32or64;
1411 iFactX,iFactY: Int32or64;
1412 begin
1413 if FNbPixels = 0 then
1414 begin
1415 result := BGRAPixelTransparent;
1416 exit;
1417 end;
1418 LoadFromBitmapIfNeeded;
1419 ix := round(x*256);
1420 iy := round(y*256);
1421 iFactX := ix and 255;
1422 iFactY := iy and 255;
1423 ix := PositiveMod(ix, FWidth shl 8) shr 8;
1424 iy := PositiveMod(iy, FHeight shl 8) shr 8;
1425 if (iFactX = 0) and (iFactY = 0) then
1426 begin
1427 result := (GetScanlineFast(iy)+ix)^;
1428 exit;
1429 end;
1430 if ScanInterpolationFilter <> rfLinear then
1431 begin
1432 iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter );
1433 iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter );
1434 end;
1435 result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY);
1436 end;
1437
TBGRADefaultBitmap.GetPixelCyclenull1438 function TBGRADefaultBitmap.GetPixelCycle(x, y: single;
1439 AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean
1440 ): TBGRAPixel;
1441 var
1442 ix, iy: Int32or64;
1443 iFactX,iFactY: Int32or64;
1444 begin
1445 if FNbPixels = 0 then
1446 begin
1447 result := BGRAPixelTransparent;
1448 exit;
1449 end;
1450 ix := round(x*256);
1451 iy := round(y*256);
1452 iFactX := ix and 255;
1453 iFactY := iy and 255;
1454 if ix < 0 then ix := -((iFactX-ix) shr 8)
1455 else ix := ix shr 8;
1456 if iy < 0 then iy := -((iFactY-iy) shr 8)
1457 else iy := iy shr 8;
1458 result := GetPixelCycle256(ix,iy,iFactX,iFactY,AResampleFilter,repeatX,repeatY);
1459 end;
1460
TBGRADefaultBitmap.GetPixelCycle256null1461 function TBGRADefaultBitmap.GetPixelCycle256(x, y, fracX256,
1462 fracY256: int32or64; AResampleFilter: TResampleFilter): TBGRAPixel;
1463 begin
1464 if (fracX256 = 0) and (fracY256 = 0) then
1465 result := GetPixelCycle(x,y)
1466 else if AResampleFilter = rfBox then
1467 begin
1468 if fracX256 >= 128 then inc(x);
1469 if fracY256 >= 128 then inc(y);
1470 result := GetPixelCycle(x,y);
1471 end else
1472 begin
1473 LoadFromBitmapIfNeeded;
1474 result := InternalGetPixelCycle256(PositiveMod(x,FWidth),PositiveMod(y,FHeight),FineInterpolation256(fracX256,AResampleFilter),FineInterpolation256(fracY256,AResampleFilter));
1475 end;
1476 end;
1477
TBGRADefaultBitmap.GetPixelCycle256null1478 function TBGRADefaultBitmap.GetPixelCycle256(x, y, fracX256,
1479 fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean;
1480 repeatY: boolean): TBGRAPixel;
1481 begin
1482 if not repeatX and not repeatY then
1483 result := GetPixel256(x,y,fracX256,fracY256,AResampleFilter)
1484 else if repeatX and repeatY then
1485 result := GetPixelCycle256(x,y,fracX256,fracY256,AResampleFilter)
1486 else
1487 begin
1488 if not repeatX then
1489 begin
1490 if x < 0 then
1491 begin
1492 if x < -1 then
1493 begin
1494 result := BGRAPixelTransparent;
1495 exit;
1496 end;
1497 result := GetPixelCycle256(0,y,0,fracY256,AResampleFilter);
1498 result.alpha:= result.alpha*fracX256 shr 8;
1499 if result.alpha = 0 then
1500 result := BGRAPixelTransparent;
1501 exit;
1502 end;
1503 if x >= FWidth-1 then
1504 begin
1505 if x >= FWidth then
1506 begin
1507 result := BGRAPixelTransparent;
1508 exit;
1509 end;
1510 result := GetPixelCycle256(FWidth-1,y,0,fracY256,AResampleFilter);
1511 result.alpha:= result.alpha*(256-fracX256) shr 8;
1512 if result.alpha = 0 then
1513 result := BGRAPixelTransparent;
1514 exit;
1515 end;
1516 end else
1517 begin
1518 if y < 0 then
1519 begin
1520 if y < -1 then
1521 begin
1522 result := BGRAPixelTransparent;
1523 exit;
1524 end;
1525 result := GetPixelCycle256(x,0,fracX256,0,AResampleFilter);
1526 result.alpha:= result.alpha*fracY256 shr 8;
1527 if result.alpha = 0 then
1528 result := BGRAPixelTransparent;
1529 exit;
1530 end;
1531 if y >= FHeight-1 then
1532 begin
1533 if y >= FHeight then
1534 begin
1535 result := BGRAPixelTransparent;
1536 exit;
1537 end;
1538 result := GetPixelCycle256(x,FHeight-1,fracX256,0,AResampleFilter);
1539 result.alpha:= result.alpha*(256-fracY256) shr 8;
1540 if result.alpha = 0 then
1541 result := BGRAPixelTransparent;
1542 exit;
1543 end;
1544 end;
1545 result := GetPixelCycle256(x,y,fracX256,fracY256,AResampleFilter);
1546 end;
1547 end;
1548
1549 {$hints on}
1550
1551 procedure TBGRADefaultBitmap.InvalidateBitmap;
1552 begin
1553 FDataModified := True;
1554 end;
1555
TBGRADefaultBitmap.GetBitmapnull1556 function TBGRADefaultBitmap.GetBitmap: TBitmap;
1557 begin
1558 if FAlphaCorrectionNeeded then
1559 begin
1560 if CanvasAlphaCorrection then
1561 LoadFromBitmapIfNeeded
1562 else
1563 FAlphaCorrectionNeeded := false;
1564 end;
1565 if FDataModified or (FBitmap = nil) then
1566 begin
1567 RebuildBitmap;
1568 FBitmapModified := false;
1569 FAlphaCorrectionNeeded:= false;
1570 FDataModified := False;
1571 end;
1572 Result := FBitmap;
1573 end;
1574
TBGRADefaultBitmap.GetCanvasnull1575 function TBGRADefaultBitmap.GetCanvas: TCanvas;
1576 begin
1577 if FDataModified or (FBitmap = nil) then
1578 begin
1579 RebuildBitmap;
1580 FBitmapModified := false;
1581 FAlphaCorrectionNeeded:= false;
1582 FDataModified := False;
1583 end;
1584 Result := FBitmap.Canvas;
1585 end;
1586
TBGRADefaultBitmap.GetCanvasFPnull1587 {$IFDEF BGRABITMAP_USE_FPCANVAS}function TBGRADefaultBitmap.GetCanvasFP: TFPImageCanvas;
1588 begin
1589 {$warnings off}
1590 if FCanvasFP = nil then
1591 FCanvasFP := TFPImageCanvas.Create(self);
1592 {$warnings on}
1593 result := FCanvasFP;
1594 end;{$ENDIF}
1595
1596 procedure TBGRADefaultBitmap.SetCanvasDrawModeFP(const AValue: TDrawMode);
1597 begin
1598 FCanvasDrawModeFP := AValue;
1599 Case AValue of
1600 dmLinearBlend: FCanvasPixelProcFP := @FastBlendPixel;
1601 dmDrawWithTransparency: FCanvasPixelProcFP := @DrawPixel;
1602 dmXor: FCanvasPixelProcFP:= @XorPixel;
1603 else FCanvasPixelProcFP := @SetPixel;
1604 end;
1605 end;
1606
GetCanvasDrawModeFPnull1607 function TBGRADefaultBitmap.GetCanvasDrawModeFP: TDrawMode;
1608 begin
1609 Result:= FCanvasDrawModeFP;
1610 end;
1611
1612 procedure TBGRADefaultBitmap.LoadFromBitmapIfNeeded;
1613 begin
1614 if FBitmapModified then
1615 begin
1616 DoLoadFromBitmap;
1617 DiscardBitmapChange;
1618 end;
1619 if FAlphaCorrectionNeeded then
1620 begin
1621 DoAlphaCorrection;
1622 end;
1623 end;
1624
1625 procedure TBGRADefaultBitmap.CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency);
1626 begin
1627 if AFadePosition = 0 then
1628 FillRect(ARect, Source1, mode) else
1629 if AFadePosition = 255 then
1630 FillRect(ARect, Source2, mode) else
1631 InternalCrossFade(ARect, Source1,Source2, AFadePosition,nil, mode);
1632 end;
1633
1634 procedure TBGRADefaultBitmap.CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency);
1635 begin
1636 InternalCrossFade(ARect, Source1,Source2, 0,AFadeMask, mode);
1637 end;
1638
1639 procedure TBGRADefaultBitmap.DiscardBitmapChange; inline;
1640 begin
1641 FBitmapModified := False;
1642 end;
1643
1644 procedure TBGRADefaultBitmap.NotifyBitmapChange;
1645 begin
1646 FBitmapModified := True;
1647 FAlphaCorrectionNeeded := true;
1648 end;
1649
1650 { Initialize properties }
1651 procedure TBGRADefaultBitmap.Init;
1652 begin
1653 inherited Init;
1654 FBitmap := nil;
1655 {$IFDEF BGRABITMAP_USE_FPCANVAS}FCanvasFP := nil;{$ENDIF}
1656 FCanvasBGRA := nil;
1657 CanvasDrawModeFP := dmDrawWithTransparency;
1658 FCanvasOpacity := 255;
1659 FAlphaCorrectionNeeded := False;
1660
1661 FontName := 'Arial';
1662 FontStyle := [];
1663 FontAntialias := False;
1664 FontVerticalAnchor:= fvaTop;
1665 FFontHeight := 20;
1666
1667 ResampleFilter := rfHalfCosine;
1668 ScanInterpolationFilter := rfLinear;
1669 end;
1670
1671 procedure TBGRADefaultBitmap.SetInternalColor(x, y: integer; const Value: TFPColor);
1672 begin
1673 FCanvasPixelProcFP(x,y, FPColorToBGRA(Value));
1674 end;
1675
GetInternalColornull1676 function TBGRADefaultBitmap.GetInternalColor(x, y: integer): TFPColor;
1677 begin
1678 if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
1679 result := colTransparent
1680 else
1681 begin
1682 LoadFromBitmapIfNeeded;
1683 result := BGRAToFPColor((Scanline[y] + x)^);
1684 end;
1685 end;
1686
1687 procedure TBGRADefaultBitmap.SetInternalPixel(x, y: integer; Value: integer);
1688 var
1689 c: TFPColor;
1690 begin
1691 if not PtInClipRect(x,y) then exit;
1692 c := Palette.Color[Value];
1693 (Scanline[y] + x)^ := FPColorToBGRA(c);
1694 InvalidateBitmap;
1695 end;
1696
TBGRADefaultBitmap.GetInternalPixelnull1697 function TBGRADefaultBitmap.GetInternalPixel(x, y: integer): integer;
1698 var
1699 c: TFPColor;
1700 begin
1701 if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
1702 result := 0
1703 else
1704 begin
1705 LoadFromBitmapIfNeeded;
1706 c := BGRAToFPColor((Scanline[y] + x)^);
1707 Result := palette.IndexOf(c);
1708 end;
1709 end;
1710
1711 procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
1712 begin
1713 if (self = nil) or (Width = 0) or (Height = 0) then exit;
1714 if Opaque then
1715 DataDrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height), Data,
1716 FLineOrder, FWidth, FHeight)
1717 else
1718 begin
1719 LoadFromBitmapIfNeeded;
1720 if Empty then
1721 exit;
1722 ACanvas.Draw(X, Y, Bitmap);
1723 end;
1724 end;
1725
1726 procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean);
1727 begin
1728 if (self = nil) or (Width = 0) or (Height = 0) then exit;
1729 if Opaque then
1730 DataDrawOpaque(ACanvas, Rect, Data, FLineOrder, FWidth, FHeight)
1731 else
1732 begin
1733 LoadFromBitmapIfNeeded;
1734 ACanvas.StretchDraw(Rect, Bitmap);
1735 end;
1736 end;
1737
1738 {---------------------------- Line primitives ---------------------------------}
1739
1740 procedure TBGRADefaultBitmap.XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel);
1741 begin
1742 if not CheckHorizLineBounds(x,y,x2) then exit;
1743 XorInline(scanline[y] + x, c, x2 - x + 1);
1744 InvalidateBitmap;
1745 end;
1746
1747 procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel
1748 );
1749 begin
1750 if not CheckHorizLineBounds(x,y,x2) then exit;
1751 DrawExpandedPixelsInline(scanline[y] + x, ec, x2 - x + 1);
1752 InvalidateBitmap;
1753 end;
1754
1755 procedure TBGRADefaultBitmap.FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel);
1756 begin
1757 if not CheckHorizLineBounds(x,y,x2) then exit;
1758 FastBlendPixelsInline(scanline[y] + x, c, x2 - x + 1);
1759 InvalidateBitmap;
1760 end;
1761
1762 procedure TBGRADefaultBitmap.AlphaHorizLine(x, y, x2: int32or64; alpha: byte);
1763 begin
1764 if alpha = 0 then
1765 begin
1766 SetHorizLine(x, y, x2, BGRAPixelTransparent);
1767 exit;
1768 end;
1769 if not CheckHorizLineBounds(x,y,x2) then exit;
1770 AlphaFillInline(scanline[y] + x, alpha, x2 - x + 1);
1771 InvalidateBitmap;
1772 end;
1773
1774 procedure TBGRADefaultBitmap.XorVertLine(x, y, y2: int32or64; c: TBGRAPixel);
1775 var
1776 n, delta: int32or64;
1777 p: PBGRAPixel;
1778 begin
1779 if not CheckVertLineBounds(x,y,y2) then exit;
1780 if LineOrder = riloTopToBottom then delta := Width else delta := -Width;
1781 p := scanline[y] + x;
1782 for n := y2 - y downto 0 do
1783 begin
1784 PLongWord(p)^ := PLongWord(p)^ xor LongWord(c);
1785 Inc(p, delta);
1786 end;
1787 InvalidateBitmap;
1788 end;
1789
1790 procedure TBGRADefaultBitmap.DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel);
1791 var
1792 n, delta: int32or64;
1793 p: PBGRAPixel;
1794 begin
1795 if c.alpha = 255 then
1796 begin
1797 SetVertLine(x,y,y2,c);
1798 exit;
1799 end;
1800 if not CheckVertLineBounds(x,y,y2) or (c.alpha=0) then exit;
1801 p := scanline[y] + x;
1802 if LineOrder = riloTopToBottom then delta := Width else delta := -Width;
1803 for n := y2 - y downto 0 do
1804 begin
1805 DrawPixelInlineNoAlphaCheck(p, c);
1806 Inc(p, delta);
1807 end;
1808 InvalidateBitmap;
1809 end;
1810
1811 procedure TBGRADefaultBitmap.AlphaVertLine(x, y, y2: int32or64; alpha: byte);
1812 var
1813 n, delta: int32or64;
1814 p: PBGRAPixel;
1815 begin
1816 if alpha = 0 then
1817 begin
1818 SetVertLine(x, y, y2, BGRAPixelTransparent);
1819 exit;
1820 end;
1821 if not CheckVertLineBounds(x,y,y2) then exit;
1822 p := scanline[y] + x;
1823 if LineOrder = riloTopToBottom then delta := Width else delta := -Width;
1824 for n := y2 - y downto 0 do
1825 begin
1826 p^.alpha := alpha;
1827 Inc(p, delta);
1828 end;
1829 InvalidateBitmap;
1830 end;
1831
1832 procedure TBGRADefaultBitmap.FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel);
1833 var
1834 n, delta: int32or64;
1835 p: PBGRAPixel;
1836 begin
1837 if not CheckVertLineBounds(x,y,y2) then exit;
1838 p := scanline[y] + x;
1839 if LineOrder = riloTopToBottom then delta := Width else delta := -Width;
1840 for n := y2 - y downto 0 do
1841 begin
1842 FastBlendPixelInline(p, c);
1843 Inc(p, delta);
1844 end;
1845 InvalidateBitmap;
1846 end;
1847
1848 procedure TBGRADefaultBitmap.DrawHorizLineDiff(x, y, x2: int32or64;
1849 c, compare: TBGRAPixel; maxDiff: byte);
1850 begin
1851 if not CheckHorizLineBounds(x,y,x2) then exit;
1852 DrawPixelsInlineDiff(scanline[y] + x, c, x2 - x + 1, compare, maxDiff);
1853 InvalidateBitmap;
1854 end;
1855
1856 procedure TBGRADefaultBitmap.HorizLineDiff(x, y, x2: int32or64;
1857 const ABrush: TUniversalBrush; ACompare: TBGRAPixel; AMaxDiffW: word);
1858 var
1859 pScan: PBGRAPixel;
1860 ctx: TUniBrushContext;
1861 sameCount, remain: Int32or64;
1862 startAlpha, nextAlpha: Word;
1863 compExpand: TExpandedPixel;
1864 begin
1865 if ABrush.Colorspace <> Colorspace then RaiseInvalidBrushColorspace;
1866 if not CheckHorizLineBounds(x,y,x2) then exit;
1867 LoadFromBitmapIfNeeded;
1868 pScan := PBGRAPixel(GetPixelAddress(x,y));
1869 ABrush.MoveTo(@ctx, pScan,x,y);
1870 remain := x2-x+1;
1871 compExpand := ACompare.ToExpanded;
1872 if pScan^ = ACompare then nextAlpha := 65535
1873 else nextAlpha := (65535 * (AMaxDiffW + 1 - ExpandedDiff(GammaExpansion(pScan^), compExpand)) + (AMaxDiffW + 1) shr 1) div (AMaxDiffW + 1);
1874 inc(pScan);
1875 while remain > 0 do
1876 begin
1877 startAlpha := nextAlpha;
1878 sameCount := 1;
1879 dec(remain);
1880 while remain > 0 do
1881 begin
1882 if pScan^ = ACompare then nextAlpha := 65535
1883 else nextAlpha := (65535 * (AMaxDiffW + 1 - ExpandedDiff(GammaExpansion(pScan^), compExpand)) + (AMaxDiffW + 1) shr 1) div (AMaxDiffW + 1);
1884 inc(pScan);
1885 if nextAlpha = startAlpha then
1886 begin
1887 inc(sameCount);
1888 dec(remain);
1889 end else break;
1890 end;
1891 ABrush.PutNextPixels(@ctx, startAlpha, sameCount);
1892 end;
1893 InvalidateBitmap;
1894 end;
1895
1896 procedure TBGRADefaultBitmap.InternalTextOutCurved(
1897 ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel;
1898 ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
1899 var
1900 glyphCursor: TGlyphCursorUtf8;
1901 currentGlyph: TGlyphUtf8;
1902 currentGlyphUtf8: string;
1903 currentGlyphWidth: single;
1904 angle, textLen: single;
1905
1906 procedure NextGlyph;
1907 begin
1908 currentGlyph := glyphCursor.GetNextGlyph;
1909 if currentGlyph.MirroredGlyphUtf8 <> '' then
1910 currentGlyphUtf8:= currentGlyph.MirroredGlyphUtf8
1911 else currentGlyphUtf8 := currentGlyph.GlyphUtf8;
1912 currentGlyphWidth := TextSize(currentGlyphUtf8).cx;
1913 end;
1914
1915 begin
1916 if (ATexture = nil) and (AColor.alpha = 0) then exit;
1917 sUTF8 := CleanTextOutString(sUTF8);
1918 if sUTF8 = '' then exit;
1919 glyphCursor := TGlyphCursorUtf8.New(sUTF8, FontBidiMode);
1920
1921 if AAlign<> taLeftJustify then
1922 begin
1923 textLen := -ALetterSpacing;
1924 while not glyphCursor.EndOfString do
1925 begin
1926 NextGlyph;
1927 IncF(textLen, ALetterSpacing + currentGlyphWidth);
1928 end;
1929 case AAlign of
1930 taCenter: ACursor.MoveBackward(textLen*0.5);
1931 taRightJustify: ACursor.MoveBackward(textLen);
1932 end;
1933 glyphCursor.Rewind;
1934 end;
1935
1936 while not glyphCursor.EndOfString do
1937 begin
1938 NextGlyph;
1939 ACursor.MoveForward(currentGlyphWidth);
1940 ACursor.MoveBackward(currentGlyphWidth, false);
1941 ACursor.MoveForward(currentGlyphWidth*0.5);
1942 with ACursor.CurrentTangent do angle := arctan2(y,x);
1943 with ACursor.CurrentCoordinate do
1944 begin
1945 if ATexture = nil then
1946 TextOutAngle(x,y, system.round(-angle*1800/Pi), currentGlyphUtf8, AColor, taCenter)
1947 else
1948 TextOutAngle(x,y, system.round(-angle*1800/Pi), currentGlyphUtf8, ATexture, taCenter);
1949 end;
1950 ACursor.MoveForward(currentGlyphWidth*0.5 + ALetterSpacing);
1951 end;
1952 end;
1953
1954 procedure TBGRADefaultBitmap.InternalTextOutLetterSpacing(x, y: single;
1955 sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner;
1956 AAlign: TAlignment; ALetterSpacing: single);
1957 var
1958 glyphCursor: TGlyphCursorUtf8;
1959 currentGlyph: TGlyphUtf8;
1960 currentGlyphUtf8: string;
1961 currentGlyphWidth: single;
1962 angle, textLen: single;
1963 m: TAffineMatrix;
1964 ofs: TPointF;
1965
1966 procedure NextGlyph;
1967 begin
1968 currentGlyph := glyphCursor.GetNextGlyph;
1969 if currentGlyph.MirroredGlyphUtf8 <> '' then
1970 currentGlyphUtf8:= currentGlyph.MirroredGlyphUtf8
1971 else currentGlyphUtf8 := currentGlyph.GlyphUtf8;
1972 currentGlyphWidth := TextSize(currentGlyphUtf8).cx;
1973 end;
1974
1975 begin
1976 if (ATexture = nil) and (AColor.alpha = 0) then exit;
1977 sUTF8 := CleanTextOutString(sUTF8);
1978 if sUTF8 = '' then exit;
1979 glyphCursor := TGlyphCursorUtf8.New(sUTF8, FontBidiMode);
1980
1981 ofs := PointF(0, 0);
1982 if AAlign<> taLeftJustify then
1983 begin
1984 textLen := -ALetterSpacing;
1985 while not glyphCursor.EndOfString do
1986 begin
1987 NextGlyph;
1988 IncF(textLen, ALetterSpacing + currentGlyphWidth);
1989 end;
1990 case AAlign of
1991 taCenter: DecF(ofs.x, 0.5*textLen);
1992 taRightJustify: DecF(ofs.x, textLen);
1993 end;
1994 glyphCursor.Rewind;
1995 end;
1996 m := AffineMatrixRotationDeg(-FontOrientation*0.1);
1997 ofs := m*ofs;
1998 incF(x, ofs.x);
1999 incF(y, ofs.y);
2000
2001 while not glyphCursor.EndOfString do
2002 begin
2003 NextGlyph;
2004 if ATexture = nil then
2005 TextOut(x,y, currentGlyphUtf8, AColor, taLeftJustify, currentGlyph.RightToLeft)
2006 else
2007 TextOut(x,y, currentGlyphUtf8, ATexture, taLeftJustify, currentGlyph.RightToLeft);
2008 ofs := m*PointF(currentGlyphWidth + ALetterSpacing, 0);
2009 incF(x, ofs.x);
2010 incF(y, ofs.y);
2011 end;
2012 end;
2013
2014 procedure TBGRADefaultBitmap.InternalCrossFade(ARect: TRect; Source1,
2015 Source2: IBGRAScanner; AFadePos: byte; AFadeMask: IBGRAScanner; mode: TDrawMode);
2016 var xb,yb: Int32or64;
2017 pdest: PBGRAPixel;
2018 c: TBGRAPixel;
2019 buf1,buf2: ArrayOfTBGRAPixel;
2020 begin
2021 ARect.Intersect(ClipRect);
2022 if ARect.IsEmpty then exit;
2023 setlength(buf1, ARect.Width);
2024 setlength(buf2, ARect.Width);
2025 for yb := ARect.top to ARect.Bottom-1 do
2026 begin
2027 pdest := GetScanlineFast(yb)+ARect.Left;
2028 Source1.ScanMoveTo(ARect.left, yb);
2029 Source1.ScanPutPixels(@buf1[0], length(buf1), dmSet);
2030 Source2.ScanMoveTo(ARect.left, yb);
2031 Source2.ScanPutPixels(@buf2[0], length(buf2), dmSet);
2032 if AFadeMask<>nil then AFadeMask.ScanMoveTo(ARect.left, yb);
2033 for xb := 0 to ARect.Right-ARect.left-1 do
2034 begin
2035 if AFadeMask<>nil then AFadePos := AFadeMask.ScanNextPixel.green;
2036 c := MergeBGRAWithGammaCorrection(buf1[xb],not AFadePos,buf2[xb],AFadePos);
2037 case mode of
2038 dmSet: pdest^ := c;
2039 dmDrawWithTransparency: DrawPixelInlineWithAlphaCheck(pdest, c);
2040 dmLinearBlend: FastBlendPixelInline(pdest,c);
2041 dmSetExceptTransparent: if c.alpha = 255 then pdest^ := c;
2042 end;
2043 inc(pdest);
2044 end;
2045 end;
2046 InvalidateBitmap;
2047 end;
2048
2049 procedure TBGRADefaultBitmap.InternalArc(cx, cy, rx, ry: single; StartAngleRad,
2050 EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions;
2051 ADrawChord: boolean; ATexture: IBGRAScanner);
2052 var
2053 pts, ptsFill: array of TPointF;
2054 temp: single;
2055 multi: TBGRAMultishapeFiller;
2056 begin
2057 if (rx = 0) or (ry = 0) then exit;
2058 if ADrawChord then AOptions := AOptions+[aoClosePath];
2059 if not (aoFillPath in AOptions) then
2060 AFillColor := BGRAPixelTransparent;
2061
2062 if (ABorderColor.alpha = 0) and (AFillColor.alpha = 0) then exit;
2063
2064 if (abs(StartAngleRad-EndAngleRad) >= 2*PI - 1e-6) or (StartAngleRad = EndAngleRad) then
2065 begin
2066 if (aoPie in AOptions) or ((PenStyle <> psSolid) and (PenStyle <> psClear)) then
2067 EndAngleRad:= StartAngleRad+2*PI
2068 else
2069 begin
2070 EllipseAntialias(cx,cy,rx,ry,ABorderColor,w,AFillColor);
2071 exit;
2072 end;
2073 end;
2074
2075 if EndAngleRad < StartAngleRad then
2076 begin
2077 temp := StartAngleRad;
2078 StartAngleRad:= EndAngleRad;
2079 EndAngleRad:= temp;
2080 end;
2081
2082 pts := ComputeArcRad(cx,cy,rx,ry,StartAngleRad,EndAngleRad);
2083 if aoPie in AOptions then pts := ConcatPointsF([PointsF([PointF(cx,cy)]),pts]);
2084
2085 multi := TBGRAMultishapeFiller.Create;
2086 multi.FillMode := fmWinding;
2087 multi.PolygonOrder := poLastOnTop;
2088 if AFillColor.alpha <> 0 then
2089 begin
2090 if not (aoPie in AOptions) and (length(pts)>=2) then ptsFill := ConcatPointsF([PointsF([(pts[0]+pts[high(pts)])*0.5]),pts])
2091 else ptsFill := pts;
2092 if ATexture <> nil then
2093 multi.AddPolygon(ptsFill, ATexture)
2094 else
2095 multi.AddPolygon(ptsFill, AFillColor);
2096 end;
2097 if ABorderColor.alpha <> 0 then
2098 begin
2099 if [aoPie,aoClosePath]*AOptions <> [] then
2100 multi.AddPolygon(ComputeWidePolygon(pts,w), ABorderColor)
2101 else
2102 multi.AddPolygon(ComputeWidePolyline(pts,w), ABorderColor);
2103 end;
2104 multi.Antialiasing := true;
2105 multi.Draw(self);
2106 multi.Free;
2107 end;
2108
InternalNewnull2109 function TBGRADefaultBitmap.InternalNew: TBGRADefaultBitmap;
2110 var
2111 BGRAClass: TBGRABitmapAny;
2112 begin
2113 BGRAClass := TBGRABitmapAny(self.ClassType);
2114 if BGRAClass = TBGRAPtrBitmap then
2115 BGRAClass := TBGRADefaultBitmap;
2116 Result := BGRAClass.Create(0, 0) as TBGRADefaultBitmap;
2117 end;
2118
TBGRADefaultBitmap.IsAffineRoughlyTranslationnull2119 class function TBGRADefaultBitmap.IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean;
2120 const oneOver512 = 1/512;
2121 var Orig,HAxis,VAxis: TPointF;
2122 begin
2123 Orig := AMatrix*PointF(ASourceBounds.Left,ASourceBounds.Top);
2124 if (abs(Orig.x-round(Orig.x)) > oneOver512) or
2125 (abs(Orig.y-round(Orig.y)) > oneOver512) then
2126 begin
2127 result := false;
2128 exit;
2129 end;
2130 HAxis := AMatrix*PointF(ASourceBounds.Right-1,ASourceBounds.Top);
2131 if (abs(HAxis.x - (round(Orig.x)+ASourceBounds.Right-1 - ASourceBounds.Left)) > oneOver512) or
2132 (abs(HAxis.y - round(Orig.y)) > oneOver512) then
2133 begin
2134 result := false;
2135 exit;
2136 end;
2137 VAxis := AMatrix*PointF(ASourceBounds.Left,ASourceBounds.Bottom-1);
2138 if (abs(VAxis.y - (round(Orig.y)+ASourceBounds.Bottom-1 - ASourceBounds.Top)) > oneOver512) or
2139 (abs(VAxis.x - round(Orig.x)) > oneOver512) then
2140 begin
2141 result := false;
2142 exit;
2143 end;
2144 result := true;
2145 end;
2146
2147 {---------------------------- Lines ---------------------------------}
2148 { Call appropriate functions }
2149
2150 procedure TBGRADefaultBitmap.DrawPolyLineAntialias(
2151 const points: array of TPointF; c: TBGRAPixel; w: single;
2152 fillcolor: TBGRAPixel);
2153 var multi: TBGRAMultishapeFiller;
2154 begin
2155 multi := TBGRAMultishapeFiller.Create;
2156 multi.PolygonOrder := poLastOnTop;
2157 multi.AddPolygon(points,fillcolor);
2158 multi.AddPolygon(ComputeWidePolyline(points,w),c);
2159 if LinearAntialiasing then
2160 multi.Draw(self,dmLinearBlend)
2161 else
2162 multi.Draw(self,dmDrawWithTransparency);
2163 multi.Free;
2164 end;
2165
2166 procedure TBGRADefaultBitmap.DrawPolygonAntialias(
2167 const points: array of TPointF; c: TBGRAPixel; w: single;
2168 fillcolor: TBGRAPixel);
2169 var multi: TBGRAMultishapeFiller;
2170 begin
2171 multi := TBGRAMultishapeFiller.Create;
2172 multi.PolygonOrder := poLastOnTop;
2173 multi.AddPolygon(points,fillcolor);
2174 multi.AddPolygon(ComputeWidePolygon(points,w),c);
2175 if LinearAntialiasing then
2176 multi.Draw(self,dmLinearBlend)
2177 else
2178 multi.Draw(self,dmDrawWithTransparency);
2179 multi.Free;
2180 end;
2181
2182 procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2183 AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel);
2184 var tempPath: TBGRAPath;
2185 multi: TBGRAMultishapeFiller;
2186 begin
2187 tempPath := TBGRAPath.Create(APath);
2188 multi := TBGRAMultishapeFiller.Create;
2189 multi.FillMode := FillMode;
2190 multi.PolygonOrder := poLastOnTop;
2191 multi.AddPathFill(tempPath,AMatrix,AFillColor);
2192 multi.AddPathStroke(tempPath,AMatrix,AStrokeColor,AWidth,GetInternalPen);
2193 multi.Draw(self);
2194 multi.Free;
2195 tempPath.Free;
2196 end;
2197
2198 procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2199 AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel);
2200 var tempPath: TBGRAPath;
2201 multi: TBGRAMultishapeFiller;
2202 begin
2203 tempPath := TBGRAPath.Create(APath);
2204 multi := TBGRAMultishapeFiller.Create;
2205 multi.FillMode := FillMode;
2206 multi.PolygonOrder := poLastOnTop;
2207 multi.AddPathFill(tempPath,AMatrix,AFillColor);
2208 multi.AddPathStroke(tempPath,AMatrix,AStrokeTexture,AWidth,GetInternalPen);
2209 multi.Draw(self);
2210 multi.Free;
2211 tempPath.Free;
2212 end;
2213
2214 procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2215 AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner);
2216 var tempPath: TBGRAPath;
2217 multi: TBGRAMultishapeFiller;
2218 begin
2219 tempPath := TBGRAPath.Create(APath);
2220 multi := TBGRAMultishapeFiller.Create;
2221 multi.FillMode := FillMode;
2222 multi.PolygonOrder := poLastOnTop;
2223 multi.AddPathFill(tempPath,AMatrix,AFillTexture);
2224 multi.AddPathStroke(tempPath,AMatrix,AStrokeColor,AWidth,GetInternalPen);
2225 multi.Draw(self);
2226 multi.Free;
2227 tempPath.Free;
2228 end;
2229
2230 procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2231 AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner);
2232 var
2233 tempPath: TBGRAPath;
2234 multi: TBGRAMultishapeFiller;
2235 begin
2236 tempPath := TBGRAPath.Create(APath);
2237 multi := TBGRAMultishapeFiller.Create;
2238 multi.FillMode := FillMode;
2239 multi.PolygonOrder := poLastOnTop;
2240 multi.AddPathFill(tempPath,AMatrix,AFillTexture);
2241 multi.AddPathStroke(tempPath,AMatrix,AStrokeTexture,AWidth,GetInternalPen);
2242 multi.Draw(self);
2243 multi.Free;
2244 tempPath.Free;
2245 end;
2246
2247 procedure TBGRADefaultBitmap.ArrowStartAsNone;
2248 begin
2249 GetArrow.StartAsNone;
2250 end;
2251
2252 procedure TBGRADefaultBitmap.ArrowStartAsClassic(AFlipped: boolean;
2253 ACut: boolean; ARelativePenWidth: single);
2254 begin
2255 GetArrow.StartAsClassic(AFlipped,ACut,ARelativePenWidth);
2256 end;
2257
2258 procedure TBGRADefaultBitmap.ArrowStartAsTriangle(ABackOffset: single;
2259 ARounded: boolean; AHollow: boolean; AHollowPenWidth: single);
2260 begin
2261 GetArrow.StartAsTriangle(ABackOffset,ARounded,AHollow,AHollowPenWidth);
2262 end;
2263
2264 procedure TBGRADefaultBitmap.ArrowStartAsTail;
2265 begin
2266 GetArrow.StartAsTail;
2267 end;
2268
2269 procedure TBGRADefaultBitmap.ArrowEndAsNone;
2270 begin
2271 GetArrow.EndAsNone;
2272 end;
2273
2274 procedure TBGRADefaultBitmap.ArrowEndAsClassic(AFlipped: boolean;
2275 ACut: boolean; ARelativePenWidth: single);
2276 begin
2277 GetArrow.EndAsClassic(AFlipped,ACut,ARelativePenWidth);
2278 end;
2279
2280 procedure TBGRADefaultBitmap.ArrowEndAsTriangle(ABackOffset: single;
2281 ARounded: boolean; AHollow: boolean; AHollowPenWidth: single);
2282 begin
2283 GetArrow.EndAsTriangle(ABackOffset,ARounded,AHollow,AHollowPenWidth);
2284 end;
2285
2286 procedure TBGRADefaultBitmap.ArrowEndAsTail;
2287 begin
2288 GetArrow.EndAsTail;
2289 end;
2290
2291 {------------------------ Shapes ----------------------------------------------}
2292 { Call appropriate functions }
2293
2294 procedure TBGRADefaultBitmap.FillTriangleLinearColor(pt1, pt2, pt3: TPointF;
2295 c1, c2, c3: TBGRAPixel);
2296 begin
2297 FillPolyLinearColor([pt1,pt2,pt3],[c1,c2,c3]);
2298 end;
2299
2300 procedure TBGRADefaultBitmap.FillTriangleLinearColorAntialias(pt1, pt2,
2301 pt3: TPointF; c1, c2, c3: TBGRAPixel);
2302 var
2303 grad: TBGRAGradientTriangleScanner;
2304 begin
2305 grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3);
2306 FillPolyAntialias([pt1,pt2,pt3],grad);
2307 grad.Free;
2308 end;
2309
2310 procedure TBGRADefaultBitmap.FillTriangleLinearMapping(pt1, pt2, pt3: TPointF;
2311 texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True);
2312 begin
2313 FillPolyLinearMapping([pt1,pt2,pt3],texture,[tex1,tex2,tex3],TextureInterpolation);
2314 end;
2315
2316 procedure TBGRADefaultBitmap.FillTriangleLinearMappingLightness(pt1, pt2,
2317 pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,
2318 light2, light3: word; TextureInterpolation: Boolean);
2319 begin
2320 FillPolyLinearMappingLightness([pt1,pt2,pt3],texture,[tex1,tex2,tex3],[light1,light2,light3],TextureInterpolation);
2321 end;
2322
2323 procedure TBGRADefaultBitmap.FillTriangleLinearMappingAntialias(pt1, pt2,
2324 pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF);
2325 var
2326 mapping: TBGRATriangleLinearMapping;
2327 begin
2328 mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3);
2329 FillPolyAntialias([pt1,pt2,pt3],mapping);
2330 mapping.Free;
2331 end;
2332
2333 procedure TBGRADefaultBitmap.FillQuadLinearColor(pt1, pt2, pt3, pt4: TPointF;
2334 c1, c2, c3, c4: TBGRAPixel);
2335 var
2336 center: TPointF;
2337 centerColor: TBGRAPixel;
2338 multi: TBGRAMultishapeFiller;
2339 begin
2340 if not IsConvex([pt1,pt2,pt3,pt4]) then //need to merge colors
2341 begin
2342 multi := TBGRAMultishapeFiller.Create;
2343 multi.AddQuadLinearColor(pt1,pt2,pt3,pt4,c1,c2,c3,c4);
2344 multi.Antialiasing:= false;
2345 multi.Draw(self);
2346 multi.Free;
2347 exit;
2348 end;
2349 center := (pt1+pt2+pt3+pt4)*(1/4);
2350 centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)),
2351 MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) );
2352 FillTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor);
2353 FillTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor);
2354 FillTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor);
2355 FillTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor);
2356 end;
2357
2358 procedure TBGRADefaultBitmap.FillQuadLinearColorAntialias(pt1, pt2, pt3,
2359 pt4: TPointF; c1, c2, c3, c4: TBGRAPixel);
2360 var multi : TBGRAMultishapeFiller;
2361 begin
2362 multi := TBGRAMultishapeFiller.Create;
2363 multi.AddQuadLinearColor(pt1, pt2, pt3, pt4, c1, c2, c3, c4);
2364 multi.Draw(self);
2365 multi.free;
2366 end;
2367
2368 procedure TBGRADefaultBitmap.FillQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF;
2369 texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
2370 TextureInterpolation: Boolean; ACulling: TFaceCulling; ACropToPolygon: boolean);
2371 var
2372 scan: TBGRAQuadLinearScanner;
2373 r: TRect;
2374 begin
2375 if ((abs(pt1.y-pt2.y)<1e-6) and (abs(pt3.y-pt4.y)<1e-6)) or
2376 ((abs(pt3.y-pt2.y)<1e-6) and (abs(pt1.y-pt4.y)<1e-6)) then
2377 FillPolyLinearMapping([pt1,pt2,pt3,pt4], texture,
2378 [tex1,tex2,tex3,tex4], TextureInterpolation)
2379 else
2380 begin
2381 scan := TBGRAQuadLinearScanner.Create(texture,
2382 [tex1,tex2,tex3,tex4],
2383 [pt1,pt2,pt3,pt4],TextureInterpolation);
2384 scan.Culling := ACulling;
2385 if ACropToPolygon then
2386 begin
2387 scan.Padding := true;
2388 FillPoly([pt1,pt2,pt3,pt4],scan,dmDrawWithTransparency);
2389 end
2390 else
2391 begin
2392 r := RectWithSize(floor(pt1.x),floor(pt1.y),1,1);
2393 r.Union( RectWithSize(floor(pt2.x),floor(pt2.y),1,1) );
2394 r.Union( RectWithSize(floor(pt3.x),floor(pt3.y),1,1) );
2395 r.Union( RectWithSize(floor(pt4.x),floor(pt4.y),1,1) );
2396 FillRect(r,scan,dmDrawWithTransparency);
2397 end;
2398 scan.Free;
2399 end;
2400 end;
2401
2402 procedure TBGRADefaultBitmap.FillQuadLinearMappingLightness(pt1, pt2, pt3,
2403 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,
2404 light2, light3, light4: word; TextureInterpolation: Boolean);
2405 var
2406 center: TPointF;
2407 centerTex: TPointF;
2408 centerLight: word;
2409 begin
2410 center := (pt1+pt2+pt3+pt4)*(1/4);
2411 centerTex := (tex1+tex2+tex3+tex4)*(1/4);
2412 centerLight := (light1+light2+light3+light4) div 4;
2413 FillTriangleLinearMappingLightness(pt1,pt2,center, texture,tex1,tex2,centerTex, light1,light2,centerLight, TextureInterpolation);
2414 FillTriangleLinearMappingLightness(pt2,pt3,center, texture,tex2,tex3,centerTex, light2,light3,centerLight, TextureInterpolation);
2415 FillTriangleLinearMappingLightness(pt3,pt4,center, texture,tex3,tex4,centerTex, light3,light4,centerLight, TextureInterpolation);
2416 FillTriangleLinearMappingLightness(pt4,pt1,center, texture,tex4,tex1,centerTex, light4,light1,centerLight, TextureInterpolation);
2417 end;
2418
2419 procedure TBGRADefaultBitmap.FillQuadLinearMappingAntialias(pt1, pt2, pt3,
2420 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
2421 ACulling: TFaceCulling);
2422 var multi : TBGRAMultishapeFiller;
2423 begin
2424 multi := TBGRAMultishapeFiller.Create;
2425 multi.AddQuadLinearMapping(pt1, pt2, pt3, pt4, texture, tex1,tex2,tex3,tex4, ACulling);
2426 multi.Draw(self);
2427 multi.free;
2428 end;
2429
2430 procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3,
2431 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
2432 ADrawMode: TDrawMode);
2433 var
2434 persp: TBGRAPerspectiveScannerTransform;
2435 begin
2436 persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
2437 FillPoly([pt1,pt2,pt3,pt4],persp,ADrawMode);
2438 persp.Free;
2439 end;
2440
2441 procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3,
2442 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
2443 ACleanBorders: TRect; ADrawMode: TDrawMode);
2444 var
2445 persp: TBGRAPerspectiveScannerTransform;
2446 clean: TBGRAExtendedBorderScanner;
2447 begin
2448 clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders);
2449 persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
2450 FillPoly([pt1,pt2,pt3,pt4],persp,ADrawMode);
2451 persp.Free;
2452 clean.Free;
2453 end;
2454
2455 procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3,
2456 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
2457 var
2458 persp: TBGRAPerspectiveScannerTransform;
2459 begin
2460 persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
2461 FillPolyAntialias([pt1,pt2,pt3,pt4],persp);
2462 persp.Free;
2463 end;
2464
2465 procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3,
2466 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
2467 ACleanBorders: TRect);
2468 var
2469 persp: TBGRAPerspectiveScannerTransform;
2470 clean: TBGRAExtendedBorderScanner;
2471 begin
2472 clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders);
2473 persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
2474 FillPolyAntialias([pt1,pt2,pt3,pt4],persp);
2475 persp.Free;
2476 clean.Free;
2477 end;
2478
2479 procedure TBGRADefaultBitmap.FillQuadAffineMapping(Orig, HAxis, VAxis: TPointF;
2480 AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean; ADrawMode: TDrawMode; AOpacity: byte);
2481 var pts3: TPointF;
2482 affine: TBGRAAffineBitmapTransform;
2483 begin
2484 if not APixelCenteredCoordinates then
2485 begin
2486 Orig.Offset(-0.5,-0.5);
2487 HAxis.Offset(-0.5,-0.5);
2488 VAxis.Offset(-0.5,-0.5);
2489 end;
2490 pts3 := HAxis+(VAxis-Orig);
2491 affine := TBGRAAffineBitmapTransform.Create(AImage,False,AImage.ScanInterpolationFilter,not APixelCenteredCoordinates);
2492 affine.GlobalOpacity:= AOpacity;
2493 affine.Fit(Orig,HAxis,VAxis);
2494 FillPoly([Orig,HAxis,pts3,VAxis],affine,ADrawMode);
2495 affine.Free;
2496 end;
2497
2498 procedure TBGRADefaultBitmap.FillQuadAffineMappingAntialias(Orig, HAxis,
2499 VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean; AOpacity: byte);
2500 var pts3: TPointF;
2501 affine: TBGRAAffineBitmapTransform;
2502 begin
2503 if not APixelCenteredCoordinates then
2504 begin
2505 Orig.Offset(-0.5,-0.5);
2506 HAxis.Offset(-0.5,-0.5);
2507 VAxis.Offset(-0.5,-0.5);
2508 end;
2509 pts3 := HAxis+(VAxis-Orig);
2510 affine := TBGRAAffineBitmapTransform.Create(AImage,False,AImage.ScanInterpolationFilter,not APixelCenteredCoordinates);
2511 affine.GlobalOpacity:= AOpacity;
2512 affine.Fit(Orig,HAxis,VAxis);
2513 FillPolyAntialias([Orig,HAxis,pts3,VAxis],affine);
2514 affine.Free;
2515 end;
2516
2517 procedure TBGRADefaultBitmap.FillPolyLinearMapping(const points: array of TPointF;
2518 texture: IBGRAScanner; texCoords: array of TPointF;
2519 TextureInterpolation: Boolean);
2520 begin
2521 PolygonLinearTextureMappingAliased(self,points,texture,texCoords,TextureInterpolation, FillMode = fmWinding);
2522 end;
2523
2524 procedure TBGRADefaultBitmap.FillPolyLinearMappingLightness(
2525 const points: array of TPointF; texture: IBGRAScanner;
2526 texCoords: array of TPointF; lightnesses: array of word;
2527 TextureInterpolation: Boolean);
2528 begin
2529 PolygonLinearTextureMappingAliasedWithLightness(self,points,texture,texCoords,TextureInterpolation,lightnesses,FillMode = fmWinding);
2530 end;
2531
2532 procedure TBGRADefaultBitmap.FillPolyLinearColor(
2533 const points: array of TPointF; AColors: array of TBGRAPixel);
2534 begin
2535 PolygonLinearColorGradientAliased(self,points,AColors, FillMode = fmWinding);
2536 end;
2537
2538 procedure TBGRADefaultBitmap.FillPolyPerspectiveMapping(
2539 const points: array of TPointF; const pointsZ: array of single;
2540 texture: IBGRAScanner; texCoords: array of TPointF;
2541 TextureInterpolation: Boolean; zbuffer: psingle);
2542 begin
2543 PolygonPerspectiveTextureMappingAliased(self,points,pointsZ,texture,texCoords,TextureInterpolation, FillMode = fmWinding, zbuffer);
2544 end;
2545
2546 procedure TBGRADefaultBitmap.FillPolyPerspectiveMappingLightness(
2547 const points: array of TPointF; const pointsZ: array of single;
2548 texture: IBGRAScanner; texCoords: array of TPointF;
2549 lightnesses: array of word; TextureInterpolation: Boolean; zbuffer: psingle);
2550 begin
2551 PolygonPerspectiveTextureMappingAliasedWithLightness(self,points,pointsZ,texture,texCoords,TextureInterpolation,lightnesses, FillMode = fmWinding, zbuffer);
2552 end;
2553
2554 procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
2555 AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel);
2556 begin
2557 DrawPath(APath,AffineMatrixIdentity,AStrokeColor,AWidth,AFillColor);
2558 end;
2559
2560 procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
2561 AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel);
2562 begin
2563 DrawPath(APath,AffineMatrixIdentity,AStrokeTexture,AWidth,AFillColor);
2564 end;
2565
2566 procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
2567 AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner);
2568 begin
2569 DrawPath(APath,AffineMatrixIdentity,AStrokeColor,AWidth,AFillTexture);
2570 end;
2571
2572 procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
2573 AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner);
2574 begin
2575 DrawPath(APath,AffineMatrixIdentity,AStrokeTexture,AWidth,AFillTexture);
2576 end;
2577
2578 procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
2579 c: TBGRAPixel; w: single; back: TBGRAPixel);
2580 var multi: TBGRAMultishapeFiller;
2581 hw: single;
2582 begin
2583 if (w=0) or (PenStyle = psClear) or (c.alpha = 0) then
2584 begin
2585 FillEllipseAntialias(x, y, rx, ry, back);
2586 exit;
2587 end;
2588 rx := abs(rx);
2589 ry := abs(ry);
2590 hw := w/2;
2591 if (rx <= hw) or (ry <= hw) then
2592 begin
2593 FillEllipseAntialias(x,y,rx+hw,ry+hw,c);
2594 exit;
2595 end;
2596 { use multishape filler for fine junction between polygons }
2597 multi := TBGRAMultishapeFiller.Create;
2598 if (PenStyle = psSolid) then
2599 begin
2600 if back.alpha <> 0 then multi.AddEllipse(x,y,rx-hw,ry-hw,back);
2601 multi.AddEllipseBorder(x,y,rx,ry,w,c)
2602 end
2603 else
2604 begin
2605 if back.alpha <> 0 then multi.AddEllipse(x,y,rx,ry,back);
2606 multi.AddPolygon(ComputeWidePolygon(ComputeEllipseContour(x,y,rx,ry),w),c);
2607 end;
2608 multi.PolygonOrder := poLastOnTop;
2609 multi.Draw(self);
2610 multi.Free;
2611 end;
2612
2613 procedure TBGRADefaultBitmap.EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF;
2614 c: TBGRAPixel; w: single; back: TBGRAPixel);
2615 var multi: TBGRAMultishapeFiller;
2616 pts: ArrayOfTPointF;
2617 begin
2618 if (w=0) or (PenStyle = psClear) or (c.alpha = 0) then
2619 begin
2620 FillEllipseAntialias(AOrigin, AXAxis, AYAxis, back);
2621 exit;
2622 end;
2623 { use multishape filler for fine junction between polygons }
2624 multi := TBGRAMultishapeFiller.Create;
2625 pts := ComputeEllipseContour(AOrigin, AXAxis, AYAxis);
2626 if back.alpha <> 0 then multi.AddPolygon(pts, back);
2627 pts := ComputeWidePolygon(pts,w);
2628 multi.AddPolygon(pts,c);
2629 multi.PolygonOrder := poLastOnTop;
2630 multi.Draw(self);
2631 multi.Free;
2632 end;
2633
2634 procedure TBGRADefaultBitmap.FillEllipseLinearColorAntialias(x, y, rx,
2635 ry: single; outercolor, innercolor: TBGRAPixel);
2636 var
2637 grad: TBGRAGradientScanner;
2638 affine: TBGRAAffineScannerTransform;
2639 begin
2640 if (rx=0) or (ry=0) then exit;
2641 if rx=ry then
2642 begin
2643 grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(x,y),PointF(x+rx,y),True);
2644 FillEllipseAntialias(x,y,rx,ry,grad);
2645 grad.Free;
2646 end else
2647 begin
2648 grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(0,0),PointF(1,0),True);
2649 affine := TBGRAAffineScannerTransform.Create(grad);
2650 affine.Scale(rx,ry);
2651 affine.Translate(x,y);
2652 FillEllipseAntialias(x,y,rx,ry,affine);
2653 affine.Free;
2654 grad.Free;
2655 end;
2656 end;
2657
2658 procedure TBGRADefaultBitmap.FillEllipseLinearColorAntialias(AOrigin, AXAxis,
2659 AYAxis: TPointF; outercolor, innercolor: TBGRAPixel);
2660 var
2661 grad: TBGRAGradientScanner;
2662 affine: TBGRAAffineScannerTransform;
2663 begin
2664 grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(0,0),PointF(1,0),True);
2665 affine := TBGRAAffineScannerTransform.Create(grad);
2666 affine.Fit(AOrigin,AXAxis,AYAxis);
2667 FillEllipseAntialias(AOrigin,AXAxis,AYAxis,affine);
2668 affine.Free;
2669 grad.Free;
2670 end;
2671
2672 procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
2673 c: TBGRAPixel; w: single; back: TBGRAPixel);
2674 var
2675 bevel: single;
2676 multi: TBGRAMultishapeFiller;
2677 hw: single;
2678 begin
2679 if (PenStyle = psClear) or (c.alpha=0) or (w=0) then
2680 begin
2681 if back <> BGRAPixelTransparent then
2682 FillRectAntialias(x,y,x2,y2,back);
2683 exit;
2684 end;
2685
2686 hw := w/2;
2687 if not CheckAntialiasRectBounds(x,y,x2,y2,w) then
2688 begin
2689 if JoinStyle = pjsBevel then
2690 begin
2691 bevel := (2-sqrt(2))*hw;
2692 FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, c, [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]);
2693 end else
2694 if JoinStyle = pjsRound then
2695 FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, c)
2696 else
2697 FillRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, c);
2698 exit;
2699 end;
2700
2701 { use multishape filler for fine junction between polygons }
2702 multi := TBGRAMultishapeFiller.Create;
2703 multi.FillMode := FillMode;
2704 if (JoinStyle = pjsMiter) and (PenStyle = psSolid) then
2705 multi.AddRectangleBorder(x,y,x2,y2,w,c)
2706 else
2707 multi.AddPolygon(ComputeWidePolygon([Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)],w),c);
2708
2709 if (frac(x + hw) = 0.5) and (frac(y + hw)=0.5) and (frac(x2 - hw)=0.5) and (frac(y2 - hw)=0.5) then
2710 FillRect(ceil(x + hw), ceil(y + hw), ceil(x2 - hw), ceil(y2 - hw), back, dmDrawWithTransparency)
2711 else
2712 multi.AddRectangle(x + hw, y + hw, x2 - hw, y2 - hw, back);
2713 multi.Draw(self);
2714 multi.Free;
2715 end;
2716
2717 procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
2718 c: TBGRAPixel; w: single; options: TRoundRectangleOptions);
2719 begin
2720 if (PenStyle = psClear) or (c.alpha = 0) then exit;
2721 if (PenStyle = psSolid) then
2722 BGRAPolygon.BorderRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,c,False, LinearAntialiasing)
2723 else
2724 DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),c,w);
2725 end;
2726
2727 procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
2728 pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel;
2729 options: TRoundRectangleOptions);
2730 var
2731 multi: TBGRAMultishapeFiller;
2732 begin
2733 if (PenStyle = psClear) or (pencolor.alpha = 0) then
2734 begin
2735 FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillColor,options);
2736 exit;
2737 end;
2738 if (PenStyle = psSolid) then
2739 BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,pencolor,fillcolor,nil,nil,False)
2740 else
2741 begin
2742 multi := TBGRAMultishapeFiller.Create;
2743 multi.PolygonOrder := poLastOnTop;
2744 multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillColor,options);
2745 multi.AddPolygon(ComputeWidePolygon(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),pencolor);
2746 multi.Draw(self);
2747 multi.Free;
2748 end;
2749 end;
2750
2751 procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
2752 penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner;
2753 options: TRoundRectangleOptions);
2754 var
2755 multi: TBGRAMultishapeFiller;
2756 begin
2757 if (PenStyle = psClear) then
2758 begin
2759 FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillTexture,options);
2760 exit;
2761 end else
2762 if (PenStyle = psSolid) then
2763 BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,BGRAPixelTransparent,BGRAPixelTransparent,pentexture,filltexture,False)
2764 else
2765 begin
2766 multi := TBGRAMultishapeFiller.Create;
2767 multi.PolygonOrder := poLastOnTop;
2768 multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillTexture,options);
2769 multi.AddPolygon(ComputeWidePolygon(ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),penTexture);
2770 multi.Draw(self);
2771 multi.Free;
2772 end;
2773 end;
2774
2775 procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
2776 texture: IBGRAScanner; w: single; options: TRoundRectangleOptions);
2777 begin
2778 if (PenStyle = psClear) then exit;
2779 if (PenStyle = psSolid) then
2780 BGRAPolygon.BorderRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,w,options,texture, LinearAntialiasing)
2781 else
2782 DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),texture,w);
2783 end;
2784
CheckRectBoundsnull2785 function TBGRADefaultBitmap.CheckRectBounds(var x, y, x2, y2: integer; minsize: integer): boolean; inline;
2786 var
2787 temp: integer;
2788 begin
2789 //swap coordinates if needed
2790 if (x > x2) then
2791 begin
2792 temp := x;
2793 x := x2;
2794 x2 := temp;
2795 end;
2796 if (y > y2) then
2797 begin
2798 temp := y;
2799 y := y2;
2800 y2 := temp;
2801 end;
2802 if (x2 - x <= minsize) or (y2 - y <= minsize) then
2803 begin
2804 result := false;
2805 exit;
2806 end else
2807 result := true;
2808 end;
2809
2810 procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer;
2811 texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm);
2812 var dither: TDitheringTask;
2813 begin
2814 if not CheckClippedRectBounds(x,y,x2,y2) then exit;
2815 dither := CreateDitheringTask(ditheringAlgorithm, texture, self, rect(x,y,x2,y2));
2816 dither.ScanOffset := AScanOffset;
2817 dither.DrawMode := mode;
2818 dither.Execute;
2819 dither.Free;
2820 end;
2821
2822 {------------------------- Text functions ---------------------------------------}
2823
2824 procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; orientationTenthDegCCW: integer;
2825 const sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean);
2826 begin
2827 with (PointF(x,y)-GetFontAnchorRotatedOffset(orientationTenthDegCCW)) do
2828 FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),c,align,ARightToLeft);
2829 end;
2830
2831 procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; orientationTenthDegCCW: integer;
2832 const sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean);
2833 begin
2834 with (PointF(x,y)-GetFontAnchorRotatedOffset(orientationTenthDegCCW)) do
2835 FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),texture,align,ARightToLeft);
2836 end;
2837
2838 procedure TBGRADefaultBitmap.TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single);
2839 begin
2840 InternalTextOutCurved(ACursor, sUTF8, AColor, nil, AAlign, ALetterSpacing);
2841 end;
2842
2843 procedure TBGRADefaultBitmap.TextOutCurved(ACursor: TBGRACustomPathCursor; const sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
2844 begin
2845 InternalTextOutCurved(ACursor, sUTF8, BGRAPixelTransparent, ATexture, AAlign, ALetterSpacing);
2846 end;
2847
2848 procedure TBGRADefaultBitmap.TextMultiline(ALeft, ATop, AWidth: single; const sUTF8: string;
2849 c: TBGRAPixel; AAlign: TBidiTextAlignment; AVertAlign: TTextLayout; AParagraphSpacing: single);
2850 var
2851 layout: TBidiTextLayout;
2852 i: Integer;
2853 begin
2854 if FontBidiMode = fbmAuto then
2855 layout := TBidiTextLayout.Create(FontRenderer, sUTF8)
2856 else
2857 layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8));
2858 for i := 0 to layout.ParagraphCount-1 do
2859 layout.ParagraphAlignment[i] := AAlign;
2860 layout.ParagraphSpacingBelow:= AParagraphSpacing;
2861 layout.AvailableWidth := AWidth;
2862 case AVertAlign of
2863 tlBottom: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight);
2864 tlCenter: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight/2);
2865 else layout.TopLeft := PointF(ALeft,ATop);
2866 end;
2867 layout.DrawText(self, c);
2868 layout.Free;
2869 end;
2870
2871 procedure TBGRADefaultBitmap.TextMultiline(ALeft, ATop, AWidth: single;
2872 const sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment;
2873 AVertAlign: TTextLayout; AParagraphSpacing: single);
2874 var
2875 layout: TBidiTextLayout;
2876 i: Integer;
2877 begin
2878 if FontBidiMode = fbmAuto then
2879 layout := TBidiTextLayout.Create(FontRenderer, sUTF8)
2880 else
2881 layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8));
2882 for i := 0 to layout.ParagraphCount-1 do
2883 layout.ParagraphAlignment[i] := AAlign;
2884 layout.ParagraphSpacingBelow:= AParagraphSpacing;
2885 layout.AvailableWidth := AWidth;
2886 case AVertAlign of
2887 tlBottom: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight);
2888 tlCenter: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight/2);
2889 else layout.TopLeft := PointF(ALeft,ATop);
2890 end;
2891 layout.DrawText(self, ATexture);
2892 layout.Free;
2893 end;
2894
2895 procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string;
2896 texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean);
2897 begin
2898 FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),texture,align, ARightToLeft);
2899 end;
2900
2901 procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string;
2902 AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single);
2903 begin
2904 InternalTextOutLetterSpacing(x, y, sUTF8, AColor, nil, AAlign, ALetterSpacing);
2905 end;
2906
2907 procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string;
2908 ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
2909 begin
2910 InternalTextOutLetterSpacing(x, y, sUTF8, BGRAPixelTransparent, ATexture, AAlign, ALetterSpacing);
2911 end;
2912
2913 procedure TBGRADefaultBitmap.TextOut(x, y: single; const sUTF8: string;
2914 c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean);
2915 begin
2916 with (PointF(x,y)-GetFontAnchorRotatedOffset) do
2917 FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),c,align, ARightToLeft);
2918 end;
2919
2920 procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer;
2921 const sUTF8: string; style: TTextStyle; c: TBGRAPixel);
2922 begin
2923 with (PointF(x,y)-GetFontAnchorRotatedOffset(0)) do
2924 FontRenderer.TextRect(self,ARect,system.round(x),system.round(y),sUTF8,style,c);
2925 end;
2926
2927 procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer; const sUTF8: string;
2928 style: TTextStyle; texture: IBGRAScanner);
2929 begin
2930 with (PointF(x,y)-GetFontAnchorRotatedOffset(0)) do
2931 FontRenderer.TextRect(self,ARect,system.round(x),system.round(y),sUTF8,style,texture);
2932 end;
2933
2934 { Returns the total size of the string provided using the current font.
2935 Orientation is not taken into account, so that the width is along the text. }
TextSizenull2936 function TBGRADefaultBitmap.TextSize(const sUTF8: string): TSize;
2937 begin
2938 result := FontRenderer.TextSize(CleanTextOutString(sUTF8));
2939 end;
2940
TextSizeMultilinenull2941 function TBGRADefaultBitmap.TextSizeMultiline(const sUTF8: string; AMaxWidth: single;
2942 AParagraphSpacing: single): TSize;
2943 var
2944 layout: TBidiTextLayout;
2945 begin
2946 if FontBidiMode = fbmAuto then
2947 layout := TBidiTextLayout.Create(FontRenderer, sUTF8)
2948 else
2949 layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8));
2950 layout.ParagraphSpacingBelow:= AParagraphSpacing;
2951 layout.AvailableWidth := AMaxWidth;
2952 result := size(ceil(layout.UsedWidth), ceil(layout.TotalTextHeight));
2953 layout.Free;
2954 end;
2955
TBGRADefaultBitmap.TextAffineBoxnull2956 function TBGRADefaultBitmap.TextAffineBox(const sUTF8: string): TAffineBox;
2957 var size: TSize;
2958 m: TAffineMatrix;
2959 dy: single;
2960 begin
2961 dy := GetFontVerticalAnchorOffset;
2962 size := FontRenderer.TextSizeAngle(sUTF8, FontOrientation);
2963 m := AffineMatrixRotationDeg(-FontOrientation*0.1);
2964 result := TAffineBox.AffineBox(PointF(0,-dy), m*PointF(size.cx,-dy), m*PointF(0,size.cy-dy));
2965 end;
2966
TextSizenull2967 function TBGRADefaultBitmap.TextSize(const sUTF8: string; AMaxWidth: integer): TSize;
2968 begin
2969 result := FontRenderer.TextSize(sUTF8, AMaxWidth, GetFontRightToLeftFor(sUTF8));
2970 end;
2971
TextSizenull2972 function TBGRADefaultBitmap.TextSize(const sUTF8: string; AMaxWidth: integer;
2973 ARightToLeft: boolean): TSize;
2974 begin
2975 result := FontRenderer.TextSize(sUTF8, AMaxWidth, ARightToLeft);
2976 end;
2977
TBGRADefaultBitmap.TextFitInfonull2978 function TBGRADefaultBitmap.TextFitInfo(const sUTF8: string; AMaxWidth: integer
2979 ): integer;
2980 begin
2981 result := FontRenderer.TextFitInfo(sUTF8, AMaxWidth);
2982 end;
2983
2984 {---------------------------- Curves ----------------------------------------}
2985
TBGRADefaultBitmap.ComputeClosedSplinenull2986 function TBGRADefaultBitmap.ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF;
2987 begin
2988 result := BGRAPath.ComputeClosedSpline(APoints, AStyle);
2989 end;
2990
TBGRADefaultBitmap.ComputeOpenedSplinenull2991 function TBGRADefaultBitmap.ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF;
2992 begin
2993 result := BGRAPath.ComputeOpenedSpline(APoints, AStyle);
2994 end;
2995
TBGRADefaultBitmap.ComputeBezierCurvenull2996 function TBGRADefaultBitmap.ComputeBezierCurve(const ACurve: TCubicBezierCurve
2997 ): ArrayOfTPointF;
2998 begin
2999 Result:= BGRAPath.ComputeBezierCurve(ACurve);
3000 end;
3001
TBGRADefaultBitmap.ComputeBezierCurvenull3002 function TBGRADefaultBitmap.ComputeBezierCurve(
3003 const ACurve: TQuadraticBezierCurve): ArrayOfTPointF;
3004 begin
3005 Result:= BGRAPath.ComputeBezierCurve(ACurve);
3006 end;
3007
TBGRADefaultBitmap.ComputeBezierSplinenull3008 function TBGRADefaultBitmap.ComputeBezierSpline(
3009 const ASpline: array of TCubicBezierCurve): ArrayOfTPointF;
3010 begin
3011 Result:= BGRAPath.ComputeBezierSpline(ASpline);
3012 end;
3013
TBGRADefaultBitmap.ComputeBezierSplinenull3014 function TBGRADefaultBitmap.ComputeBezierSpline(
3015 const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF;
3016 begin
3017 Result:= BGRAPath.ComputeBezierSpline(ASpline);
3018 end;
3019
ComputeWidePolylinenull3020 function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF;
3021 w: single): ArrayOfTPointF;
3022 begin
3023 result := GetInternalPen.ComputePolyline(points,w);
3024 end;
3025
ComputeWidePolylinenull3026 function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF;
3027 w: single; ClosedCap: boolean): ArrayOfTPointF;
3028 begin
3029 result := GetInternalPen.ComputePolyline(points,w,ClosedCap);
3030 end;
3031
ComputeWidePolygonnull3032 function TBGRADefaultBitmap.ComputeWidePolygon(const points: array of TPointF;
3033 w: single): ArrayOfTPointF;
3034 begin
3035 result := GetInternalPen.ComputePolygon(points,w);
3036 end;
3037
ComputeEllipseContournull3038 function TBGRADefaultBitmap.ComputeEllipseContour(x, y, rx, ry: single; quality: single): ArrayOfTPointF;
3039 begin
3040 result := BGRAPath.ComputeEllipse(x,y,rx,ry, quality);
3041 end;
3042
ComputeEllipseContournull3043 function TBGRADefaultBitmap.ComputeEllipseContour(AOrigin, AXAxis,
3044 AYAxis: TPointF; quality: single): ArrayOfTPointF;
3045 begin
3046 result := BGRAPath.ComputeEllipse(AOrigin,AXAxis,AYAxis, quality);
3047 end;
3048
TBGRADefaultBitmap.ComputeEllipseBordernull3049 function TBGRADefaultBitmap.ComputeEllipseBorder(x, y, rx, ry, w: single; quality: single): ArrayOfTPointF;
3050 begin
3051 result := ComputeWidePolygon(ComputeEllipseContour(x,y,rx,ry, quality),w);
3052 end;
3053
TBGRADefaultBitmap.ComputeEllipseBordernull3054 function TBGRADefaultBitmap.ComputeEllipseBorder(AOrigin, AXAxis,
3055 AYAxis: TPointF; w: single; quality: single): ArrayOfTPointF;
3056 begin
3057 result := ComputeWidePolygon(ComputeEllipseContour(AOrigin,AXAxis,AYAxis, quality),w);
3058 end;
3059
ComputeArc65536null3060 function TBGRADefaultBitmap.ComputeArc65536(x, y, rx, ry: single; start65536,
3061 end65536: word; quality: single): ArrayOfTPointF;
3062 begin
3063 result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536,quality);
3064 end;
3065
TBGRADefaultBitmap.ComputeArcRadnull3066 function TBGRADefaultBitmap.ComputeArcRad(x, y, rx, ry: single; startRad,
3067 endRad: single; quality: single): ArrayOfTPointF;
3068 begin
3069 result := BGRAPath.ComputeArcRad(x,y,rx,ry,startRad,endRad,quality);
3070 end;
3071
TBGRADefaultBitmap.ComputeRoundRectnull3072 function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single; quality: single): ArrayOfTPointF;
3073 begin
3074 result := BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry,quality);
3075 end;
3076
TBGRADefaultBitmap.ComputeRoundRectnull3077 function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single;
3078 options: TRoundRectangleOptions; quality: single): ArrayOfTPointF;
3079 begin
3080 Result:= BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry,options,quality);
3081 end;
3082
ComputePie65536null3083 function TBGRADefaultBitmap.ComputePie65536(x, y, rx, ry: single; start65536,
3084 end65536: word; quality: single): ArrayOfTPointF;
3085 begin
3086 result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536,quality);
3087 if (start65536 <> end65536) then
3088 begin
3089 setlength(result,length(result)+1);
3090 result[high(result)] := PointF(x,y);
3091 end;
3092 end;
3093
ComputePieRadnull3094 function TBGRADefaultBitmap.ComputePieRad(x, y, rx, ry: single; startRad,
3095 endRad: single; quality: single): ArrayOfTPointF;
3096 begin
3097 result := self.ComputePie65536(x,y,rx,ry,round(startRad*32768/Pi),round(endRad*32768/Pi),quality);
3098 end;
3099
3100 {---------------------------------- Fill ---------------------------------}
3101
3102 procedure TBGRADefaultBitmap.Fill(c: TBGRAPixel; start, Count: integer);
3103 begin
3104 if start < 0 then
3105 begin
3106 inc(Count, start);
3107 start := 0;
3108 end;
3109 if start >= nbPixels then
3110 exit;
3111 if start + Count > nbPixels then
3112 Count := nbPixels - start;
3113
3114 FillInline(Data + start, c, Count);
3115 InvalidateBitmap;
3116 end;
3117
3118 procedure TBGRADefaultBitmap.AlphaFill(alpha: byte; start, Count: integer);
3119 begin
3120 if alpha = 0 then
3121 Fill(BGRAPixelTransparent, start, Count);
3122 if start < 0 then
3123 begin
3124 inc(Count, start);
3125 start := 0;
3126 end;
3127 if start >= nbPixels then
3128 exit;
3129 if start + Count > nbPixels then
3130 Count := nbPixels - start;
3131
3132 AlphaFillInline(Data + start, alpha, Count);
3133 InvalidateBitmap;
3134 end;
3135
3136 procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TCustomUniversalBitmap;
3137 const AColor: TBGRAPixel; ADrawMode: TDrawMode);
3138 var
3139 scan: TBGRACustomScanner;
3140 begin
3141 if (AMask = nil) or (AColor.alpha = 0) then exit;
3142 scan := TBGRASolidColorMaskScanner.Create(AMask, Point(-X,-Y), AColor);
3143 self.FillRect(X,Y, X+AMask.Width,Y+AMask.Height, scan, ADrawMode);
3144 scan.Free;
3145 end;
3146
3147 procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TCustomUniversalBitmap;
3148 ATexture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte);
3149 var
3150 scan: TBGRACustomScanner;
3151 begin
3152 if AMask = nil then exit;
3153 scan := TBGRATextureMaskScanner.Create(AMask, Point(-X,-Y), ATexture, AOpacity);
3154 self.FillRect(X,Y, X+AMask.Width,Y+AMask.Height, scan, ADrawMode);
3155 scan.Free;
3156 end;
3157
3158 procedure TBGRADefaultBitmap.EraseMask(x, y: integer; AMask: TBGRACustomBitmap;
3159 alpha: byte);
3160 var
3161 x0,y0,x2, y2, yb,xb, tx, delta: integer;
3162 p, psrc: PBGRAPixel;
3163 begin
3164 if (AMask = nil) or (alpha = 0) then exit;
3165 x0 := x;
3166 y0 := y;
3167 x2 := x+AMask.Width;
3168 y2 := y+AMask.Height;
3169 if not CheckClippedRectBounds(x,y,x2,y2) then exit;
3170 tx := x2 - x;
3171 Dec(x2);
3172 Dec(y2);
3173
3174 p := Scanline[y] + x;
3175 if FLineOrder = riloBottomToTop then
3176 delta := -Width
3177 else
3178 delta := Width;
3179
3180 for yb := y to y2 do
3181 begin
3182 psrc := AMask.ScanLine[yb-y0]+(x-x0);
3183 if alpha = 255 then
3184 begin
3185 for xb := tx-1 downto 0 do
3186 begin
3187 ErasePixelInline(p, psrc^.green);
3188 inc(p);
3189 inc(psrc);
3190 end;
3191 end else
3192 begin
3193 for xb := tx-1 downto 0 do
3194 begin
3195 ErasePixelInline(p, ApplyOpacity(psrc^.green,alpha));
3196 inc(p);
3197 inc(psrc);
3198 end;
3199 end;
3200 dec(p, tx);
3201 Inc(p, delta);
3202 end;
3203
3204 InvalidateBitmap;
3205 end;
3206
3207 procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer;
3208 AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean);
3209 begin
3210 BGRAFillClearTypeMask(self,x, y, xThird, AMask, color, nil, ARGBOrder);
3211 end;
3212
3213 procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer;
3214 AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean);
3215 begin
3216 BGRAFillClearTypeMask(self,x, y, xThird, AMask, BGRAPixelTransparent, texture, ARGBOrder);
3217 end;
3218
3219 { Replace color without taking alpha channel into account }
3220 procedure TBGRADefaultBitmap.ReplaceColor(before, after: TColor);
3221 var
3222 p: PLongWord;
3223 n: integer;
3224 colorMask,beforeBGR, afterBGR: LongWord;
3225 rAfter,gAfter,bAfter,rBefore,gBefore,bBefore: byte;
3226 begin
3227 colorMask := LongWord(BGRA(255,255,255,0));
3228 RedGreenBlue(before, rBefore,gBefore,bBefore);
3229 RedGreenBlue(after, rAfter,gAfter,bAfter);
3230 beforeBGR := LongWord(BGRA(rBefore,gBefore,bBefore,0));
3231 afterBGR := LongWord(BGRA(rAfter,gAfter,bAfter,0));
3232
3233 p := PLongWord(Data);
3234 for n := NbPixels - 1 downto 0 do
3235 begin
3236 if p^ and colorMask = beforeBGR then
3237 p^ := (p^ and not ColorMask) or afterBGR;
3238 Inc(p);
3239 end;
3240 InvalidateBitmap;
3241 end;
3242
3243 procedure TBGRADefaultBitmap.ReplaceColor(ABounds: TRect; before, after: TColor);
3244 var p: PLongWord;
3245 xb,yb,xcount: integer;
3246
3247 colorMask,beforeBGR, afterBGR: LongWord;
3248 rAfter,gAfter,bAfter,rBefore,gBefore,bBefore: byte;
3249 begin
3250 colorMask := LongWord(BGRA(255,255,255,0));
3251 RedGreenBlue(before, rBefore,gBefore,bBefore);
3252 RedGreenBlue(after, rAfter,gAfter,bAfter);
3253 beforeBGR := LongWord(BGRA(rBefore,gBefore,bBefore,0));
3254 afterBGR := LongWord(BGRA(rAfter,gAfter,bAfter,0));
3255
3256 ABounds.Intersect(ClipRect);
3257 if ABounds.IsEmpty then exit;
3258 xcount := ABounds.Right-ABounds.Left;
3259 for yb := ABounds.Top to ABounds.Bottom-1 do
3260 begin
3261 p := PLongWord(ScanLine[yb]+ABounds.Left);
3262 for xb := xcount-1 downto 0 do
3263 begin
3264 if p^ and colorMask = beforeBGR then
3265 p^ := (p^ and not ColorMask) or afterBGR;
3266 Inc(p);
3267 end;
3268 end;
3269 InvalidateBitmap;
3270 end;
3271
3272 procedure TBGRADefaultBitmap.ParallelFloodFill(X, Y: integer;
3273 Dest: TCustomUniversalBitmap; Color: TBGRAPixel; mode: TFloodfillMode;
3274 Tolerance: byte; DestOfsX: integer; DestOfsY: integer);
3275 var
3276 b: TUniversalBrush;
3277 begin
3278 case mode of
3279 fmSet: Dest.SolidBrushBGRA(b, Color, dmSet);
3280 fmDrawWithTransparency: Dest.SolidBrushBGRA(b, Color, dmDrawWithTransparency);
3281 fmLinearBlend: Dest.SolidBrushBGRA(b, Color, dmLinearBlend);
3282 fmXor: Dest.SolidBrushBGRA(b, Color, dmXor);
3283 fmProgressive: Dest.SolidBrushBGRA(b, Color, dmDrawWithTransparency);
3284 end;
3285 ParallelFloodFill(X,Y, Dest, b, mode=fmProgressive, (Tolerance shl 8)+$ff, DestOfsX, DestOfsY);
3286 end;
3287
3288 { General purpose FloodFill. It can be used to fill inplace or to
3289 fill a destination bitmap according to the content of the current bitmap.
3290
3291 The first pixel encountered is taken as a reference, further pixels
3292 are compared to this pixel. If the distance between next colors and
3293 the first color is lower than the tolerance, then the floodfill continues.
3294
3295 It uses an array of bits to store visited places to avoid filling twice
3296 the same area. It also uses a stack of positions to remember where
3297 to continue after a place is completely filled.
3298
3299 The first direction to be checked is horizontal, then
3300 it checks pixels on the line above and on the line below. }
3301 procedure TBGRADefaultBitmap.ParallelFloodFill(X, Y: integer;
3302 Dest: TCustomUniversalBitmap; const Brush: TUniversalBrush; Progressive: boolean;
3303 ToleranceW: Word; DestOfsX: integer; DestOfsY: integer);
3304 var
3305 S: TBGRAPixel;
3306 SExpand: TExpandedPixel;
3307 SX, EX, I: integer;
3308 Added: boolean;
3309
3310 Visited: array of LongWord;
3311 VisitedLineSize: integer;
3312
3313 Stack: array of integer;
3314 StackCount: integer;
3315 pScan: PBGRAPixel;
3316
CheckPixelnull3317 function CheckPixel(AX, AY: integer): boolean; inline;
3318 begin
3319 if Visited[AX shr 5 + AY * VisitedLineSize] and (1 shl (AX and 31)) <> 0 then
3320 Result := False
3321 else
3322 begin
3323 if (pScan+AX)^ = S then result := true else
3324 Result := ExpandedDiff(GammaExpansion((pScan+AX)^), SExpand) <= ToleranceW;
3325 end;
3326 end;
3327
3328 procedure SetVisited(X1, AY, X2: integer);
3329 var
3330 StartMask, EndMask: LongWord;
3331 StartPos, EndPos: integer;
3332 begin
3333 if X2 < X1 then
3334 exit;
3335 StartMask := $FFFFFFFF shl (X1 and 31);
3336 case X2 and 31 of
3337 31: EndMask := $FFFFFFFF;
3338 30: EndMask := $7FFFFFFF;
3339 else
3340 EndMask := 1 shl ((X2 and 31) + 1) - 1;
3341 end;
3342 StartPos := X1 shr 5 + AY * VisitedLineSize;
3343 EndPos := X2 shr 5 + AY * VisitedLineSize;
3344 if StartPos = EndPos then
3345 Visited[StartPos] := Visited[StartPos] or (StartMask and EndMask)
3346 else
3347 begin
3348 Visited[StartPos] := Visited[StartPos] or StartMask;
3349 Visited[EndPos] := Visited[EndPos] or EndMask;
3350 if EndPos - StartPos > 1 then
3351 FillDWord(Visited[StartPos + 1], EndPos - StartPos - 1, $FFFFFFFF);
3352 end;
3353 end;
3354
3355 procedure Push(AX, AY: integer); inline;
3356 begin
3357 if StackCount + 1 >= High(Stack) then
3358 SetLength(Stack, Length(Stack) shl 1);
3359
3360 Stack[StackCount] := AX;
3361 Inc(StackCount);
3362 Stack[StackCount] := AY;
3363 Inc(StackCount);
3364 end;
3365
3366 procedure Pop(var AX, AY: integer); inline;
3367 begin
3368 Dec(StackCount);
3369 AY := Stack[StackCount];
3370 Dec(StackCount);
3371 AX := Stack[StackCount];
3372 end;
3373
3374 begin
3375 if Brush.DoesNothing then exit;
3376 if Progressive and not (dest is TBGRACustomBitmap) then
3377 raise exception.Create('Progressive mode only available on TBGRACustomBitmap and derived classes');
3378 if PtInClipRect(X,Y) then
3379 begin
3380 S := GetPixel(X, Y);
3381 SExpand := s.ToExpanded;
3382
3383 VisitedLineSize := (Width + 31) shr 5;
3384 SetLength(Visited, VisitedLineSize * Height);
3385 FillDWord(Visited[0], Length(Visited), 0);
3386
3387 SetLength(Stack, 2);
3388 StackCount := 0;
3389
3390 Push(X, Y);
3391 repeat
3392 Pop(X, Y);
3393 pScan := GetScanlineFast(Y);
3394 if not CheckPixel(X, Y) then
3395 Continue;
3396
3397 SX := X;
3398 while (SX > FClipRect.Left) and CheckPixel(Pred(SX), Y) do
3399 Dec(SX);
3400 EX := X;
3401 while (EX < Pred(FClipRect.Right)) and CheckPixel(Succ(EX), Y) do
3402 Inc(EX);
3403
3404 SetVisited(SX, Y, EX);
3405 if Progressive then
3406 TBGRACustomBitmap(dest).HorizLineDiff(SX+DestOfsX, Y+DestOfsY, EX+DestOfsX, Brush, S, ToleranceW)
3407 else
3408 dest.HorizLine(SX+DestOfsX, Y+DestOfsY, EX+DestOfsX, Brush);
3409
3410 Added := False;
3411 if Y > FClipRect.Top then
3412 begin
3413 pScan := GetScanlineFast(Pred(Y));
3414 for I := SX to EX do
3415 if CheckPixel(I, Pred(Y)) then
3416 begin
3417 if Added then //do not add twice the same segment
3418 Continue;
3419 Push(I, Pred(Y));
3420 Added := True;
3421 end
3422 else
3423 Added := False;
3424 end;
3425
3426 Added := False;
3427 if Y < Pred(FClipRect.Bottom) then
3428 begin
3429 pScan := GetScanlineFast(Succ(Y));
3430 for I := SX to EX do
3431 if CheckPixel(I, Succ(Y)) then
3432 begin
3433 if Added then //do not add twice the same segment
3434 Continue;
3435 Push(I, Succ(Y));
3436 Added := True;
3437 end
3438 else
3439 Added := False;
3440 end;
3441 until StackCount <= 0;
3442 end;
3443 end;
3444
3445 procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer;
3446 c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
3447 gammaColorCorrection: boolean; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm);
3448 var
3449 scanner: TBGRAGradientScanner;
3450 begin
3451 if (c1.alpha = 0) and (c2.alpha = 0) then
3452 FillRect(x, y, x2, y2, BGRAPixelTransparent, mode)
3453 else
3454 if ditherAlgo <> daNearestNeighbor then
3455 GradientFillDithered(x,y,x2,y2,c1,c2,gtype,o1,o2,mode,gammaColorCorrection,sinus,ditherAlgo)
3456 else
3457 begin
3458 scanner := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus);
3459 FillRect(x,y,x2,y2,scanner,mode);
3460 scanner.Free;
3461 end;
3462 end;
3463
3464 procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer;
3465 gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF;
3466 mode: TDrawMode; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm);
3467 var
3468 scanner: TBGRAGradientScanner;
3469 begin
3470 if ditherAlgo <> daNearestNeighbor then
3471 GradientFillDithered(x,y,x2,y2,gradient,gtype,o1,o2,mode,sinus,ditherAlgo)
3472 else
3473 begin
3474 scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus);
3475 FillRect(x,y,x2,y2,scanner,mode);
3476 scanner.Free;
3477 end;
3478 end;
3479
3480 procedure TBGRADefaultBitmap.GradientFillDithered(x, y, x2, y2: integer; c1,
3481 c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF;
3482 mode: TDrawMode; gammaColorCorrection: boolean; Sinus: Boolean;
3483 ditherAlgo: TDitheringAlgorithm);
3484 var
3485 scanner: TBGRAGradientScanner;
3486 begin
3487 if (c1.alpha = 0) and (c2.alpha = 0) then
3488 begin
3489 if mode = dmSet then
3490 FillRect(x, y, x2, y2, BGRAPixelTransparent, dmSet);
3491 end
3492 else
3493 begin
3494 scanner := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus);
3495 FillRect(x,y,x2,y2,scanner,mode,ditherAlgo);
3496 scanner.Free;
3497 end;
3498 end;
3499
3500 procedure TBGRADefaultBitmap.GradientFillDithered(x, y, x2, y2: integer;
3501 gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF;
3502 mode: TDrawMode; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm);
3503 var
3504 scanner: TBGRAGradientScanner;
3505 begin
3506 scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus);
3507 FillRect(x,y,x2,y2,scanner,mode,ditherAlgo);
3508 scanner.Free;
3509 end;
3510
TBGRADefaultBitmap.ScanAtIntegernull3511 function TBGRADefaultBitmap.ScanAtInteger(X, Y: integer): TBGRAPixel;
3512 begin
3513 if (FScanWidth <> 0) and (FScanHeight <> 0) then
3514 result := (GetScanlineFast(PositiveMod(Y+ScanOffset.Y, FScanHeight))+PositiveMod(X+ScanOffset.X, FScanWidth))^
3515 else
3516 result := BGRAPixelTransparent;
3517 end;
3518
TBGRADefaultBitmap.ScanNextPixelnull3519 function TBGRADefaultBitmap.ScanNextPixel: TBGRAPixel;
3520 begin
3521 if (FScanWidth <> 0) and (FScanHeight <> 0) then
3522 begin
3523 result := PBGRAPixel(FScanPtr)^;
3524 inc(FScanCurX);
3525 inc(FScanPtr, sizeof(TBGRAPixel));
3526 if FScanCurX = FScanWidth then //cycle
3527 begin
3528 FScanCurX := 0;
3529 dec(FScanPtr, FRowSize);
3530 end;
3531 end
3532 else
3533 result := BGRAPixelTransparent;
3534 end;
3535
ScanAtnull3536 function TBGRADefaultBitmap.ScanAt(X, Y: Single): TBGRAPixel;
3537 var
3538 ix, iy: Int32or64;
3539 iFactX,iFactY: Int32or64;
3540 begin
3541 if (FScanWidth = 0) or (FScanHeight = 0) then
3542 begin
3543 result := BGRAPixelTransparent;
3544 exit;
3545 end;
3546 LoadFromBitmapIfNeeded;
3547 ix := round(x*256);
3548 iy := round(y*256);
3549 if ScanInterpolationFilter = rfBox then
3550 begin
3551 ix := PositiveMod((ix+128)+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8;
3552 iy := PositiveMod((iy+128)+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8;
3553 result := (GetScanlineFast(iy)+ix)^;
3554 exit;
3555 end;
3556 iFactX := ix and 255;
3557 iFactY := iy and 255;
3558 ix := PositiveMod(ix+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8;
3559 iy := PositiveMod(iy+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8;
3560 if (iFactX = 0) and (iFactY = 0) then
3561 begin
3562 result := (GetScanlineFast(iy)+ix)^;
3563 exit;
3564 end;
3565 if ScanInterpolationFilter <> rfLinear then
3566 begin
3567 iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter );
3568 iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter );
3569 end;
3570 result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY);
3571 end;
3572
IsScanPutPixelsDefinednull3573 function TBGRADefaultBitmap.IsScanPutPixelsDefined: boolean;
3574 begin
3575 Result:= true;
3576 end;
3577
3578 procedure TBGRADefaultBitmap.ScanPutPixels(pdest: PBGRAPixel; count: integer;
3579 mode: TDrawMode);
3580 var
3581 i,nbCopy: Integer;
3582 c: TBGRAPixel;
3583 begin
3584 if (FScanWidth <= 0) or (FScanHeight <= 0) then
3585 begin
3586 if mode = dmSet then
3587 FillDWord(pdest^, count, LongWord(BGRAPixelTransparent));
3588 exit;
3589 end;
3590 case mode of
3591 dmLinearBlend:
3592 for i := 0 to count-1 do
3593 begin
3594 FastBlendPixelInline(pdest, ScanNextPixel);
3595 inc(pdest);
3596 end;
3597 dmDrawWithTransparency:
3598 for i := 0 to count-1 do
3599 begin
3600 DrawPixelInlineWithAlphaCheck(pdest, ScanNextPixel);
3601 inc(pdest);
3602 end;
3603 dmSet:
3604 while count > 0 do
3605 begin
3606 nbCopy := FScanWidth-FScanCurX;
3607 if count < nbCopy then nbCopy := count;
3608 move(FScanPtr^,pdest^,nbCopy*sizeof(TBGRAPixel));
3609 inc(pdest,nbCopy);
3610 inc(FScanCurX,nbCopy);
3611 inc(FScanPtr,nbCopy*sizeof(TBGRAPixel));
3612 if FScanCurX = FScanWidth then
3613 begin
3614 FScanCurX := 0;
3615 dec(FScanPtr, RowSize);
3616 end;
3617 dec(count,nbCopy);
3618 end;
3619 dmSetExceptTransparent:
3620 for i := 0 to count-1 do
3621 begin
3622 c := ScanNextPixel;
3623 if c.alpha = 255 then pdest^ := c;
3624 inc(pdest);
3625 end;
3626 dmXor:
3627 for i := 0 to count-1 do
3628 begin
3629 PLongWord(pdest)^ := PLongWord(pdest)^ xor LongWord(ScanNextPixel);
3630 inc(pdest);
3631 end;
3632 end;
3633 end;
3634
3635 { General purpose pixel drawing function }
3636 procedure TBGRADefaultBitmap.DrawPixels(c: TBGRAPixel; start, Count: integer);
3637 var
3638 p: PBGRAPixel;
3639 begin
3640 if c.alpha = 0 then
3641 exit;
3642 if c.alpha = 255 then
3643 begin
3644 Fill(c,start,Count);
3645 exit;
3646 end;
3647
3648 if start < 0 then
3649 begin
3650 inc(Count, start);
3651 start := 0;
3652 end;
3653 if start >= nbPixels then
3654 exit;
3655 if start + Count > nbPixels then
3656 Count := nbPixels - start;
3657
3658 p := Data + start;
3659 DrawPixelsInline(p,c,Count);
3660 InvalidateBitmap;
3661 end;
3662
3663 {------------------------- End fill ------------------------------}
3664
3665 procedure TBGRADefaultBitmap.DoAlphaCorrection;
3666 var
3667 p: PBGRAPixel;
3668 n: integer;
3669 colormask: LongWord;
3670 changed: boolean;
3671 begin
3672 if CanvasAlphaCorrection then
3673 begin
3674 p := PBGRAPixel(FDataByte); // avoid Data to avoid reloading from bitmap and thus stack overflow
3675 colormask := $ffffffff - (255 shl TBGRAPixel_AlphaShift);
3676 changed := false;
3677 for n := NbPixels - 1 downto 0 do
3678 begin
3679 if (plongword(p)^ and colormask <> 0) and (p^.alpha = 0) then
3680 begin
3681 p^.alpha := FCanvasOpacity;
3682 changed := true;
3683 end;
3684 Inc(p);
3685 end;
3686 if changed then InvalidateBitmap;
3687 end;
3688 FAlphaCorrectionNeeded := False;
3689 end;
3690
3691 { Ensure that transparent pixels have all channels to zero }
3692 procedure TBGRADefaultBitmap.ClearTransparentPixels;
3693 var
3694 p: PBGRAPixel;
3695 n: integer;
3696 begin
3697 p := Data;
3698 for n := NbPixels - 1 downto 0 do
3699 begin
3700 if (p^.alpha = 0) then
3701 p^ := BGRAPixelTransparent;
3702 Inc(p);
3703 end;
3704 InvalidateBitmap;
3705 end;
3706
CheckAntialiasRectBoundsnull3707 function TBGRADefaultBitmap.CheckAntialiasRectBounds(var x, y, x2, y2: single;
3708 w: single): boolean;
3709 var
3710 temp: Single;
3711 begin
3712 if (x > x2) then
3713 begin
3714 temp := x;
3715 x := x2;
3716 x2 := temp;
3717 end;
3718 if (y > y2) then
3719 begin
3720 temp := y;
3721 y := y2;
3722 y2 := temp;
3723 end;
3724
3725 result := (x2 - x > w) and (y2 - y > w);
3726 end;
3727
TBGRADefaultBitmap.GetCanvasBGRAnull3728 function TBGRADefaultBitmap.GetCanvasBGRA: TBGRACanvas;
3729 begin
3730 if FCanvasBGRA = nil then
3731 FCanvasBGRA := TBGRACanvas.Create(self);
3732 result := FCanvasBGRA;
3733 end;
3734
TBGRADefaultBitmap.GetCanvas2Dnull3735 function TBGRADefaultBitmap.GetCanvas2D: TBGRACanvas2D;
3736 begin
3737 if FCanvas2D = nil then
3738 FCanvas2D := TBGRACanvas2D.Create(self);
3739 result := FCanvas2D;
3740 end;
3741
3742 procedure TBGRADefaultBitmap.PutImage(X, Y: integer; ASource: TCustomUniversalBitmap;
3743 AMode: TDrawMode; AOpacity: byte);
3744 begin
3745 inherited PutImage(X,Y, ASource, AMode, AOpacity);
3746 if (AMode in [dmSetExceptTransparent,dmDrawWithTransparency,dmLinearBlend]) and
3747 (ASource is TBGRACustomBitmap) and Assigned(TBGRACustomBitmap(ASource).XorMask) then
3748 PutImage(X,Y,TBGRACustomBitmap(ASource).XorMask,dmXor,AOpacity);
3749 end;
3750
3751 procedure TBGRADefaultBitmap.BlendImage(x, y: integer; ASource: TBGRACustomBitmap;
3752 AOperation: TBlendOperation);
3753 begin
3754 BlendImage(RectWithSize(x,y,ASource.Width,ASource.Height), ASource, -x,-y,AOperation);
3755 end;
3756
3757 procedure TBGRADefaultBitmap.BlendImage(ADest: TRect; ASource: IBGRAScanner;
3758 AOffsetX, AOffsetY: integer; AOperation: TBlendOperation);
3759 const BufSize = 8;
3760 var
3761 yb, remain, i, delta_dest: integer;
3762 psource, pdest: PBGRAPixel;
3763 sourceRect: TRect;
3764 sourceScanline, sourcePut: boolean;
3765 buf: packed array[0..BufSize-1] of TBGRAPixel;
3766 begin
3767 if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit;
3768
3769 sourceRect := ADest;
3770 sourceRect.Offset(AOffsetX, AOffsetY);
3771 sourceScanline := ASource.ProvidesScanline(sourceRect);
3772 sourcePut := ASource.IsScanPutPixelsDefined;
3773
3774 pdest := Scanline[ADest.Top] + ADest.Left;
3775 if LineOrder = riloBottomToTop then
3776 delta_dest := -Width
3777 else delta_dest := Width;
3778
3779 for yb := sourceRect.Top to sourceRect.Bottom-1 do
3780 begin
3781 if sourceScanline then
3782 begin
3783 psource := ASource.GetScanlineAt(sourceRect.Left, yb);
3784 BlendPixels(pdest, psource, AOperation, ADest.Width);
3785 end else
3786 begin
3787 ASource.ScanMoveTo(sourceRect.Left, yb);
3788 remain := ADest.Width;
3789 if sourcePut then
3790 while remain >= BufSize do
3791 begin
3792 ASource.ScanPutPixels(@buf, BufSize, dmSet);
3793 BlendPixels(pdest, @buf, AOperation, BufSize);
3794 inc(pdest, bufSize);
3795 dec(remain, bufSize);
3796 end;
3797 if remain > 0 then
3798 begin
3799 for i := 0 to remain-1 do
3800 buf[i] := ASource.ScanNextPixel;
3801 BlendPixels(pdest, @buf, AOperation, remain);
3802 inc(pdest, remain);
3803 end;
3804 dec(pdest, ADest.Width);
3805 end;
3806 Inc(pdest, delta_dest);
3807 end;
3808 InvalidateBitmap;
3809 end;
3810
3811 procedure TBGRADefaultBitmap.BlendImageOver(x, y: integer;
3812 ASource: TBGRACustomBitmap; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean);
3813 begin
3814 BlendImageOver(RectWithSize(x,y,ASource.Width,ASource.Height), ASource, -x,-y,
3815 AOperation, AOpacity, ALinearBlend);
3816 end;
3817
3818 procedure TBGRADefaultBitmap.BlendImageOver(ADest: TRect; ASource: IBGRAScanner;
3819 AOffsetX, AOffsetY: integer; AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean);
3820 const BufSize = 8;
3821 var
3822 yb, remain, i, delta_dest: integer;
3823 psource, pdest: PBGRAPixel;
3824 sourceRect: TRect;
3825 sourceScanline, sourcePut: boolean;
3826 buf: packed array[0..BufSize-1] of TBGRAPixel;
3827 begin
3828 if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit;
3829
3830 sourceRect := ADest;
3831 sourceRect.Offset(AOffsetX, AOffsetY);
3832 sourceScanline := ASource.ProvidesScanline(sourceRect);
3833 sourcePut := ASource.IsScanPutPixelsDefined;
3834
3835 pdest := Scanline[ADest.Top] + ADest.Left;
3836 if LineOrder = riloBottomToTop then
3837 delta_dest := -Width
3838 else delta_dest := Width;
3839
3840 for yb := sourceRect.Top to sourceRect.Bottom-1 do
3841 begin
3842 if sourceScanline then
3843 begin
3844 psource := ASource.GetScanlineAt(sourceRect.Left, yb);
3845 BlendPixelsOver(pdest, psource, AOperation, ADest.Width, AOpacity, ALinearBlend);
3846 end else
3847 begin
3848 ASource.ScanMoveTo(sourceRect.Left, yb);
3849 remain := ADest.Width;
3850 if sourcePut then
3851 while remain >= BufSize do
3852 begin
3853 ASource.ScanPutPixels(@buf, BufSize, dmSet);
3854 BlendPixelsOver(pdest, @buf, AOperation, BufSize, AOpacity, ALinearBlend);
3855 inc(pdest, bufSize);
3856 dec(remain, bufSize);
3857 end;
3858 if remain > 0 then
3859 begin
3860 for i := 0 to remain-1 do
3861 buf[i] := ASource.ScanNextPixel;
3862 BlendPixelsOver(pdest, @buf, AOperation, remain, AOpacity, ALinearBlend);
3863 inc(pdest, remain);
3864 end;
3865 dec(pdest, ADest.Width);
3866 end;
3867 Inc(pdest, delta_dest);
3868 end;
3869 InvalidateBitmap;
3870 end;
3871
3872 { Draw an image with an affine transformation (rotation, scale, translate).
3873 Parameters are the bitmap origin, the end of the horizontal axis and the end of the vertical axis.
3874 The output bounds correspond to the pixels that will be affected in the destination. }
3875 procedure TBGRADefaultBitmap.PutImageAffine(AMatrix: TAffineMatrix;
3876 Source: TBGRACustomBitmap; AOutputBounds: TRect;
3877 AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte; APixelCenteredCoords: boolean);
3878 var affine: TBGRAAffineBitmapTransform;
3879 sourceBounds: TRect;
3880 begin
3881 if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit;
3882 AOutputBounds.Intersect(ClipRect);
3883 if AOutputBounds.IsEmpty then exit;
3884
3885 if not APixelCenteredCoords then AMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5);
3886 if IsAffineRoughlyTranslation(AMatrix, rect(0,0,Source.Width,Source.Height)) then
3887 begin
3888 sourceBounds := AOutputBounds;
3889 sourceBounds.Offset(-round(AMatrix[1,3]), -round(AMatrix[2,3]));
3890 sourceBounds.Intersect( rect(0,0,Source.Width,Source.Height) );
3891 PutImagePart(round(AMatrix[1,3])+sourceBounds.Left,round(AMatrix[2,3])+sourceBounds.Top,Source,sourceBounds,AMode,AOpacity);
3892 end else
3893 begin
3894 affine := TBGRAAffineBitmapTransform.Create(Source, false, AResampleFilter);
3895 affine.GlobalOpacity := AOpacity;
3896 affine.ViewMatrix := AMatrix;
3897 FillRect(AOutputBounds,affine,AMode);
3898 affine.Free;
3899 end;
3900 end;
3901
GetImageAffineBoundsnull3902 function TBGRADefaultBitmap.GetImageAffineBounds(AMatrix: TAffineMatrix;
3903 ASourceBounds: TRect; AClipOutput: boolean; APixelCenteredCoords: boolean): TRect;
3904 const pointMargin = 0.5 - 1/512;
3905
3906 procedure FirstPoint(pt: TPointF);
3907 begin
3908 result.Left := round(pt.X);
3909 result.Top := round(pt.Y);
3910 result.Right := round(pt.X)+1;
3911 result.Bottom := round(pt.Y)+1;
3912 end;
3913
3914 //include specified point in the bounds
3915 procedure IncludePoint(pt: TPointF);
3916 begin
3917 if round(pt.X) < result.Left then result.Left := round(pt.X);
3918 if round(pt.Y) < result.Top then result.Top := round(pt.Y);
3919 if round(pt.X)+1 > result.Right then result.Right := round(pt.X)+1;
3920 if round(pt.Y)+1 > result.Bottom then result.Bottom := round(pt.Y)+1;
3921 end;
3922
3923 begin
3924 result := EmptyRect;
3925 if ASourceBounds.IsEmpty then exit;
3926
3927 if not APixelCenteredCoords then AMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5);
3928 if IsAffineRoughlyTranslation(AMatrix,ASourceBounds) then
3929 begin
3930 result := ASourceBounds;
3931 result.Offset(round(AMatrix[1,3]), round(AMatrix[2,3]));
3932 end else
3933 begin
3934 FirstPoint(AMatrix*PointF(ASourceBounds.Left-pointMargin,ASourceBounds.Top-pointMargin));
3935 IncludePoint(AMatrix*PointF(ASourceBounds.Right-1+pointMargin,ASourceBounds.Top-pointMargin));
3936 IncludePoint(AMatrix*PointF(ASourceBounds.Left-pointMargin,ASourceBounds.Bottom-1+pointMargin));
3937 IncludePoint(AMatrix*PointF(ASourceBounds.Right-1+pointMargin,ASourceBounds.Bottom-1+pointMargin));
3938 end;
3939 if AClipOutput then result.Intersect(ClipRect);
3940 end;
3941
3942 procedure TBGRADefaultBitmap.StretchPutImage(ARect: TRect;
3943 Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte);
3944 var noTransition: boolean;
3945 begin
3946 If (Source = nil) or (AOpacity = 0) then exit;
3947 if (ARect.Right-ARect.Left = Source.Width) and (ARect.Bottom-ARect.Top = Source.Height) then
3948 PutImage(ARect.Left,ARect.Top,Source,mode,AOpacity)
3949 else
3950 begin
3951 noTransition:= (mode = dmXor) or ((mode in [dmDrawWithTransparency,dmFastBlend,dmSetExceptTransparent]) and
3952 (Source is TBGRADefaultBitmap) and
3953 Assigned(TBGRADefaultBitmap(Source).XorMask));
3954 BGRAResample.StretchPutImage(Source, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, self, ARect.left,ARect.Top, mode, AOpacity, noTransition);
3955 if (mode in [dmDrawWithTransparency,dmFastBlend,dmSetExceptTransparent]) and Assigned(TBGRADefaultBitmap(Source).XorMask) then
3956 BGRAResample.StretchPutImage(TBGRADefaultBitmap(Source).XorMask, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, self, ARect.left,ARect.Top, dmXor, AOpacity, noTransition);
3957 end;
3958 end;
3959
3960 procedure TBGRADefaultBitmap.BlendRect(ADest: TRect; AColor: TBGRAPixel;
3961 AOperation: TBlendOperation; AExcludeChannels: TChannels);
3962 const BufSize = 8;
3963 var srcBuf: packed array[0..BufSize-1] of TBGRAPixel;
3964 i, yb, remain: Integer;
3965 p: PBGRAPixel;
3966 begin
3967 if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit;
3968 for i := 0 to BufSize-1 do
3969 srcBuf[i] := AColor;
3970 for yb := ADest.Top to ADest.Bottom-1 do
3971 begin
3972 remain := ADest.Width;
3973 p := PBGRAPixel(GetPixelAddress(ADest.Left, yb));
3974 while remain >= BufSize do
3975 begin
3976 BlendPixels(p, @srcBuf, AOperation, BufSize, AExcludeChannels);
3977 inc(p, BufSize);
3978 dec(remain, BufSize);
3979 end;
3980 if remain > 0 then
3981 BlendPixels(p, @srcBuf, AOperation, remain, AExcludeChannels);
3982 end;
3983 end;
3984
3985 procedure TBGRADefaultBitmap.BlendRectOver(ADest: TRect; AColor: TBGRAPixel;
3986 AOperation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean;
3987 AExcludeChannels: TChannels);
3988 const BufSize = 8;
3989 var srcBuf: packed array[0..BufSize-1] of TBGRAPixel;
3990 i, yb, remain: Integer;
3991 p: PBGRAPixel;
3992 begin
3993 if not CheckClippedRectBounds(ADest.Left, ADest.Top, ADest.Right, ADest.Bottom) then exit;
3994 for i := 0 to BufSize-1 do
3995 srcBuf[i] := AColor;
3996 for yb := ADest.Top to ADest.Bottom-1 do
3997 begin
3998 remain := ADest.Width;
3999 p := PBGRAPixel(GetPixelAddress(ADest.Left, yb));
4000 while remain >= BufSize do
4001 begin
4002 BlendPixelsOver(p, @srcBuf, AOperation, BufSize, AOpacity, ALinearBlend, AExcludeChannels);
4003 inc(p, BufSize);
4004 dec(remain, BufSize);
4005 end;
4006 if remain > 0 then
4007 BlendPixelsOver(p, @srcBuf, AOperation, remain, AOpacity, ALinearBlend, AExcludeChannels);
4008 end;
4009 end;
4010
4011 {----------------------------- Filters -----------------------------------------}
4012 { Call the appropriate function }
4013
TBGRADefaultBitmap.FilterSmartZoom3null4014 function TBGRADefaultBitmap.FilterSmartZoom3(Option: TMedianOption): TBGRADefaultBitmap;
4015 begin
4016 Result := BGRAFilters.FilterSmartZoom3(self, Option) as TBGRADefaultBitmap;
4017 end;
4018
TBGRADefaultBitmap.FilterMediannull4019 function TBGRADefaultBitmap.FilterMedian(Option: TMedianOption): TBGRADefaultBitmap;
4020 begin
4021 Result := BGRAFilters.FilterMedian(self, option) as TBGRADefaultBitmap;
4022 end;
4023
FilterSmoothnull4024 function TBGRADefaultBitmap.FilterSmooth: TBGRADefaultBitmap;
4025 begin
4026 Result := BGRAFilters.FilterBlurRadial(self, 3, rbPrecise) as TBGRADefaultBitmap;
4027 end;
4028
TBGRADefaultBitmap.FilterSpherenull4029 function TBGRADefaultBitmap.FilterSphere: TBGRADefaultBitmap;
4030 begin
4031 Result := BGRAFilters.FilterSphere(self) as TBGRADefaultBitmap;
4032 end;
4033
FilterTwirlnull4034 function TBGRADefaultBitmap.FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRADefaultBitmap;
4035 begin
4036 Result := BGRAFilters.FilterTwirl(self, ACenter, ARadius, ATurn, AExponent) as TBGRADefaultBitmap;
4037 end;
4038
FilterTwirlnull4039 function TBGRADefaultBitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint;
4040 ARadius: Single; ATurn: Single; AExponent: Single): TBGRADefaultBitmap;
4041 begin
4042 result := BGRAFilters.FilterTwirl(self, ABounds, ACenter, ARadius, ATurn, AExponent) as TBGRADefaultBitmap;
4043 end;
4044
FilterCylindernull4045 function TBGRADefaultBitmap.FilterCylinder: TBGRADefaultBitmap;
4046 begin
4047 Result := BGRAFilters.FilterCylinder(self) as TBGRADefaultBitmap;
4048 end;
4049
TBGRADefaultBitmap.FilterPlanenull4050 function TBGRADefaultBitmap.FilterPlane: TBGRADefaultBitmap;
4051 begin
4052 Result := BGRAFilters.FilterPlane(self) as TBGRADefaultBitmap;
4053 end;
4054
TBGRADefaultBitmap.FilterSharpennull4055 function TBGRADefaultBitmap.FilterSharpen(Amount: single = 1): TBGRADefaultBitmap;
4056 begin
4057 Result := BGRAFilters.FilterSharpen(self,round(Amount*256)) as TBGRADefaultBitmap;
4058 end;
4059
TBGRADefaultBitmap.FilterSharpennull4060 function TBGRADefaultBitmap.FilterSharpen(ABounds: TRect; Amount: single
4061 ): TBGRADefaultBitmap;
4062 begin
4063 Result := BGRAFilters.FilterSharpen(self,ABounds,round(Amount*256)) as TBGRADefaultBitmap;
4064 end;
4065
FilterContournull4066 function TBGRADefaultBitmap.FilterContour(AGammaCorrection: boolean = false): TBGRADefaultBitmap;
4067 begin
4068 Result := BGRAFilters.FilterContour(self, AGammaCorrection) as TBGRADefaultBitmap;
4069 end;
4070
TBGRADefaultBitmap.FilterPixelatenull4071 function TBGRADefaultBitmap.FilterPixelate(pixelSize: integer;
4072 useResample: boolean; filter: TResampleFilter): TBGRADefaultBitmap;
4073 begin
4074 Result:= BGRAFilters.FilterPixelate(self, pixelSize, useResample, filter) as TBGRADefaultBitmap;
4075 end;
4076
FilterEmbossnull4077 function TBGRADefaultBitmap.FilterEmboss(angle: single;
4078 AStrength: integer; AOptions: TEmbossOptions): TBGRADefaultBitmap;
4079 begin
4080 Result := BGRAFilters.FilterEmboss(self, angle, AStrength, AOptions) as TBGRADefaultBitmap;
4081 end;
4082
FilterEmbossnull4083 function TBGRADefaultBitmap.FilterEmboss(angle: single; ABounds: TRect;
4084 AStrength: integer; AOptions: TEmbossOptions): TBGRADefaultBitmap;
4085 begin
4086 Result := BGRAFilters.FilterEmboss(self, angle, ABounds, AStrength, AOptions) as TBGRADefaultBitmap;
4087 end;
4088
FilterEmbossHighlightnull4089 function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean):
4090 TBGRADefaultBitmap;
4091 begin
4092 Result := BGRAFilters.FilterEmbossHighlight(self, FillSelection, BGRAPixelTransparent) as TBGRADefaultBitmap;
4093 end;
4094
FilterEmbossHighlightnull4095 function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean;
4096 BorderColor: TBGRAPixel): TBGRADefaultBitmap;
4097 begin
4098 Result := BGRAFilters.FilterEmbossHighlight(self, FillSelection, BorderColor) as TBGRADefaultBitmap;
4099 end;
4100
FilterEmbossHighlightnull4101 function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean;
4102 BorderColor: TBGRAPixel; var Offset: TPoint): TBGRADefaultBitmap;
4103 begin
4104 Result := BGRAFilters.FilterEmbossHighlightOffset(self, FillSelection, BorderColor, Offset) as TBGRADefaultBitmap;
4105 end;
4106
TBGRADefaultBitmap.FilterGrayscalenull4107 function TBGRADefaultBitmap.FilterGrayscale: TBGRADefaultBitmap;
4108 begin
4109 Result := BGRAFilters.FilterGrayscale(self) as TBGRADefaultBitmap;
4110 end;
4111
TBGRADefaultBitmap.FilterGrayscalenull4112 function TBGRADefaultBitmap.FilterGrayscale(ABounds: TRect): TBGRADefaultBitmap;
4113 begin
4114 Result := BGRAFilters.FilterGrayscale(self, ABounds) as TBGRADefaultBitmap;
4115 end;
4116
FilterNormalizenull4117 function TBGRADefaultBitmap.FilterNormalize(eachChannel: boolean = True):
4118 TBGRADefaultBitmap;
4119 begin
4120 Result := BGRAFilters.FilterNormalize(self, eachChannel) as TBGRADefaultBitmap;
4121 end;
4122
FilterNormalizenull4123 function TBGRADefaultBitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean): TBGRADefaultBitmap;
4124 begin
4125 Result := BGRAFilters.FilterNormalize(self, ABounds, eachChannel) as TBGRADefaultBitmap;
4126 end;
4127
TBGRADefaultBitmap.FilterRotatenull4128 function TBGRADefaultBitmap.FilterRotate(origin: TPointF;
4129 angle: single; correctBlur: boolean): TBGRADefaultBitmap;
4130 begin
4131 Result := BGRAFilters.FilterRotate(self, origin, angle, correctBlur) as TBGRADefaultBitmap;
4132 end;
4133
FilterAffinenull4134 function TBGRADefaultBitmap.FilterAffine(AMatrix: TAffineMatrix;
4135 correctBlur: boolean): TBGRADefaultBitmap;
4136 begin
4137 Result := NewBitmap(Width,Height);
4138 Result.PutImageAffine(AMatrix,self,255,correctBlur);
4139 end;
4140
GetHasTransparentPixelsnull4141 function TBGRADefaultBitmap.GetHasTransparentPixels: boolean;
4142 var
4143 p: PBGRAPixel;
4144 n: integer;
4145 begin
4146 p := Data;
4147 for n := NbPixels - 1 downto 0 do
4148 begin
4149 if p^.alpha <> 255 then
4150 begin
4151 Result := True;
4152 exit;
4153 end;
4154 Inc(p);
4155 end;
4156 Result := False;
4157 end;
4158
TBGRADefaultBitmap.GetHasSemiTransparentPixelsnull4159 function TBGRADefaultBitmap.GetHasSemiTransparentPixels: boolean;
4160 var
4161 n: integer;
4162 p: PBGRAPixel;
4163 begin
4164 p := Data;
4165 for n := NbPixels - 1 downto 0 do
4166 begin
4167 if (p^.alpha > 0) and (p^.alpha < 255) then
4168 begin
4169 result := true;
4170 exit;
4171 end;
4172 inc(p);
4173 end;
4174 result := false;
4175 end;
4176
TBGRADefaultBitmap.GetAverageColornull4177 function TBGRADefaultBitmap.GetAverageColor: TColor;
4178 var
4179 pix: TBGRAPixel;
4180 begin
4181 pix := GetAveragePixel;
4182 {$hints off}
4183 if pix.alpha = 0 then
4184 result := clNone else
4185 result := RGBToColor(pix.red,pix.green,pix.blue);
4186 {$hints on}
4187 end;
4188
TBGRADefaultBitmap.GetAveragePixelnull4189 function TBGRADefaultBitmap.GetAveragePixel: TBGRAPixel;
4190 var
4191 n: integer;
4192 p: PBGRAPixel;
4193 r, g, b, sum: double;
4194 alpha: double;
4195 begin
4196 sum := 0;
4197 r := 0;
4198 g := 0;
4199 b := 0;
4200 p := Data;
4201 for n := NbPixels - 1 downto 0 do
4202 begin
4203 alpha := p^.alpha / 255;
4204 incF(sum, alpha);
4205 incF(r, p^.red * alpha);
4206 incF(g, p^.green * alpha);
4207 incF(b, p^.blue * alpha);
4208 Inc(p);
4209 end;
4210 if sum = 0 then
4211 Result := BGRAPixelTransparent
4212 else
4213 Result := BGRA(round(r / sum),round(g / sum),round(b / sum),round(sum*255/NbPixels));
4214 end;
4215
GetPenJoinStylenull4216 function TBGRADefaultBitmap.GetPenJoinStyle: TPenJoinStyle;
4217 begin
4218 result := GetInternalPen.JoinStyle;
4219 end;
4220
4221 procedure TBGRADefaultBitmap.SetPenJoinStyle(const AValue: TPenJoinStyle);
4222 begin
4223 GetInternalPen.JoinStyle := AValue;
4224 end;
4225
GetPenMiterLimitnull4226 function TBGRADefaultBitmap.GetPenMiterLimit: single;
4227 begin
4228 result := GetInternalPen.MiterLimit;
4229 end;
4230
4231 procedure TBGRADefaultBitmap.SetPenMiterLimit(const AValue: single);
4232 begin
4233 GetInternalPen.MiterLimit := AValue;
4234 end;
4235
4236 procedure TBGRADefaultBitmap.SetCanvasOpacity(AValue: byte);
4237 begin
4238 LoadFromBitmapIfNeeded;
4239 FCanvasOpacity := AValue;
4240 end;
4241
4242 {----------------------------- Resample ---------------------------------------}
4243
TBGRADefaultBitmap.FineResamplenull4244 function TBGRADefaultBitmap.FineResample(NewWidth, NewHeight: integer):
4245 TBGRACustomBitmap;
4246 begin
4247 Result := BGRAResample.FineResample(self, NewWidth, NewHeight, ResampleFilter);
4248 end;
4249
TBGRADefaultBitmap.SimpleStretchnull4250 function TBGRADefaultBitmap.SimpleStretch(NewWidth, NewHeight: integer):
4251 TBGRACustomBitmap;
4252 begin
4253 Result := BGRAResample.SimpleStretch(self, NewWidth, NewHeight);
4254 end;
4255
Resamplenull4256 function TBGRADefaultBitmap.Resample(newWidth, newHeight: integer;
4257 mode: TResampleMode): TBGRADefaultBitmap;
4258 begin
4259 case mode of
4260 rmFineResample: Result := FineResample(newWidth, newHeight) as TBGRADefaultBitmap;
4261 rmSimpleStretch: Result := SimpleStretch(newWidth, newHeight) as TBGRADefaultBitmap;
4262 else
4263 Result := nil;
4264 end;
4265 end;
4266
4267 {-------------------------------- Data functions ------------------------}
4268
4269 { Compute negative with gamma correction. A negative contains
4270 complentary colors (black becomes white etc.).
4271
4272 It is NOT EXACTLY an involution, when applied twice, some color information is lost }
4273 procedure TBGRADefaultBitmap.Negative;
4274 begin
4275 TBGRAFilterScannerNegative.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), True);
4276 end;
4277
4278 procedure TBGRADefaultBitmap.NegativeRect(ABounds: TRect);
4279 begin
4280 ABounds.Intersect(ClipRect);
4281 if ABounds.IsEmpty then exit;
4282 TBGRAFilterScannerNegative.ComputeFilterInplace(self, ABounds, True);
4283 end;
4284
4285 { Compute negative without gamma correction.
4286
4287 It is an involution, i.e it does nothing when applied twice }
4288 procedure TBGRADefaultBitmap.LinearNegative;
4289 begin
4290 TBGRAFilterScannerNegative.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), False);
4291 end;
4292
4293 procedure TBGRADefaultBitmap.LinearNegativeRect(ABounds: TRect);
4294 begin
4295 ABounds.Intersect(ClipRect);
4296 if ABounds.IsEmpty then exit;
4297 TBGRAFilterScannerNegative.ComputeFilterInplace(self, ABounds, False);
4298 end;
4299
4300 procedure TBGRADefaultBitmap.InplaceGrayscale(AGammaCorrection: boolean = true);
4301 begin
4302 TBGRAFilterScannerGrayscale.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), AGammaCorrection);
4303 end;
4304
4305 procedure TBGRADefaultBitmap.InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true);
4306 begin
4307 ABounds.Intersect(ClipRect);
4308 if ABounds.IsEmpty then exit;
4309 TBGRAFilterScannerGrayscale.ComputeFilterInplace(self, ABounds, AGammaCorrection);
4310 end;
4311
4312 procedure TBGRADefaultBitmap.InplaceNormalize(AEachChannel: boolean);
4313 begin
4314 InplaceNormalize(rect(0,0,Width,Height),AEachChannel);
4315 end;
4316
4317 procedure TBGRADefaultBitmap.InplaceNormalize(ABounds: TRect;
4318 AEachChannel: boolean);
4319 var scanner: TBGRAFilterScannerNormalize;
4320 begin
4321 ABounds.Intersect(ClipRect);
4322 if ABounds.IsEmpty then exit;
4323 scanner := TBGRAFilterScannerNormalize.Create(self,Point(0,0),ABounds,AEachChannel);
4324 FillRect(ABounds,scanner,dmSet);
4325 scanner.Free;
4326 end;
4327
4328 { Swap red and blue channels. Useful when RGB order is swapped.
4329
4330 It is an involution, i.e it does nothing when applied twice }
4331 procedure TBGRADefaultBitmap.SwapRedBlue;
4332 begin
4333 TBGRAFilterScannerSwapRedBlue.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), False);
4334 end;
4335
4336 procedure TBGRADefaultBitmap.SwapRedBlue(ARect: TRect);
4337 begin
4338 if not CheckClippedRectBounds(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom) then exit;
4339 TBGRAFilterScannerSwapRedBlue.ComputeFilterInplace(self, ARect, False);
4340 end;
4341
4342 { Convert a grayscale image into a black image with alpha value }
4343 procedure TBGRADefaultBitmap.GrayscaleToAlpha;
4344 var
4345 n: integer;
4346 p: PLongword;
4347 begin
4348 LoadFromBitmapIfNeeded;
4349 p := PLongword(Data);
4350 n := NbPixels;
4351 if n = 0 then
4352 exit;
4353 repeat
4354 p^ := (p^ shr TBGRAPixel_RedShift and $FF) shl TBGRAPixel_AlphaShift;
4355 Inc(p);
4356 Dec(n);
4357 until n = 0;
4358 InvalidateBitmap;
4359 end;
4360
4361 procedure TBGRADefaultBitmap.AlphaToGrayscale;
4362 var
4363 n: integer;
4364 temp: LongWord;
4365 p: PLongword;
4366 begin
4367 LoadFromBitmapIfNeeded;
4368 p := PLongword(Data);
4369 n := NbPixels;
4370 if n = 0 then
4371 exit;
4372 repeat
4373 temp := (p^ shr TBGRAPixel_AlphaShift) and $ff;
4374 p^ := (temp shl TBGRAPixel_RedShift) or (temp shl TBGRAPixel_GreenShift)
4375 or (temp shl TBGRAPixel_BlueShift) or ($ff shl TBGRAPixel_AlphaShift);
4376 Inc(p);
4377 Dec(n);
4378 until n = 0;
4379 InvalidateBitmap;
4380 end;
4381
GetMaskFromAlphanull4382 function TBGRADefaultBitmap.GetMaskFromAlpha: TBGRADefaultBitmap;
4383 var y,x: integer;
4384 psrc, pdest: PBGRAPixel;
4385 begin
4386 result := BGRABitmapFactory.Create(Width,Height) as TBGRADefaultBitmap;
4387 for y := 0 to self.Height-1 do
4388 begin
4389 psrc := self.ScanLine[y];
4390 pdest := result.ScanLine[y];
4391 for x := 0 to self.Width-1 do
4392 begin
4393 pdest^ := BGRA(psrc^.alpha,psrc^.alpha,psrc^.alpha);
4394 inc(psrc);
4395 inc(pdest);
4396 end;
4397 end;
4398 end;
4399
TBGRADefaultBitmap.GetGrayscaleMaskFromAlphanull4400 function TBGRADefaultBitmap.GetGrayscaleMaskFromAlpha: TGrayscaleMask;
4401 var
4402 psrc: PBGRAPixel;
4403 pdest: PByte;
4404 y, x: Integer;
4405 begin
4406 result := TGrayscaleMask.Create;
4407 result.SetSize(Width,Height);
4408 for y := 0 to self.Height-1 do
4409 begin
4410 psrc := self.ScanLine[y];
4411 pdest := result.ScanLine[y];
4412 for x := 0 to self.Width-1 do
4413 begin
4414 pdest^ := psrc^.alpha;
4415 inc(psrc);
4416 inc(pdest);
4417 end;
4418 end;
4419 end;
4420
4421 procedure TBGRADefaultBitmap.ConvertToLinearRGB;
4422 var p: PBGRAPixel;
4423 n: integer;
4424 begin
4425 p := Data;
4426 for n := NbPixels-1 downto 0 do
4427 begin
4428 p^.red := GammaExpansionTab[p^.red] shr 8;
4429 p^.green := GammaExpansionTab[p^.green] shr 8;
4430 p^.blue := GammaExpansionTab[p^.blue] shr 8;
4431 inc(p);
4432 end;
4433 end;
4434
4435 procedure TBGRADefaultBitmap.ConvertFromLinearRGB;
4436 var p: PBGRAPixel;
4437 n: integer;
4438 begin
4439 p := Data;
4440 for n := NbPixels-1 downto 0 do
4441 begin
4442 p^.red := GammaCompressionTab[p^.red shl 8 + p^.red];
4443 p^.green := GammaCompressionTab[p^.green shl 8 + p^.green];
4444 p^.blue := GammaCompressionTab[p^.blue shl 8 + p^.blue];
4445 inc(p);
4446 end;
4447 end;
4448
4449 { Make a copy of the transparent bitmap to a TBitmap with a background color
4450 instead of transparency }
MakeBitmapCopynull4451 function TBGRADefaultBitmap.MakeBitmapCopy(BackgroundColor: TColor): TBitmap;
4452 var
4453 opaqueCopy: TBGRACustomBitmap;
4454 begin
4455 Result := TBitmap.Create;
4456 Result.Width := Width;
4457 Result.Height := Height;
4458 opaqueCopy := NewBitmap(Width, Height);
4459 opaqueCopy.Fill(BackgroundColor);
4460 opaqueCopy.PutImage(0, 0, self, dmDrawWithTransparency);
4461 opaqueCopy.Draw(Result.canvas, 0, 0, True);
4462 opaqueCopy.Free;
4463 end;
4464
GetPtrBitmapnull4465 function TBGRADefaultBitmap.GetPtrBitmap(Top, Bottom: Integer
4466 ): TBGRACustomBitmap;
4467 var temp: integer;
4468 ptrbmp: TBGRAPtrBitmap;
4469 begin
4470 if Top > Bottom then
4471 begin
4472 temp := Top;
4473 Top := Bottom;
4474 Bottom := Temp;
4475 end;
4476 if Top < 0 then Top := 0;
4477 if Bottom > Height then Bottom := Height;
4478 if Top >= Bottom then
4479 result := nil
4480 else
4481 begin
4482 if LineOrder = riloTopToBottom then
4483 ptrbmp := CreatePtrBitmap(Width,Bottom-Top,ScanLine[Top]) else
4484 ptrbmp := CreatePtrBitmap(Width,Bottom-Top,ScanLine[Bottom-1]);
4485 ptrbmp.LineOrder := LineOrder;
4486 result := ptrbmp;
4487 end;
4488 end;
4489
4490 {-------------------------- Allocation routines -------------------------------}
4491
TBGRADefaultBitmap.CreatePtrBitmapnull4492 function TBGRADefaultBitmap.CreatePtrBitmap(AWidth, AHeight: integer;
4493 AData: PBGRAPixel): TBGRAPtrBitmap;
4494 begin
4495 result := TBGRAPtrBitmap.Create(AWidth,AHeight,AData);
4496 end;
4497
4498 procedure TBGRADefaultBitmap.FreeBitmap;
4499 begin
4500 FreeAndNil(FBitmap);
4501 end;
4502
TBGRADefaultBitmap.GetCanvasOpacitynull4503 function TBGRADefaultBitmap.GetCanvasOpacity: byte;
4504 begin
4505 result:= FCanvasOpacity;
4506 end;
4507
TBGRADefaultBitmap.GetFontHeightnull4508 function TBGRADefaultBitmap.GetFontHeight: integer;
4509 begin
4510 result := FFontHeight;
4511 end;
4512
4513 { TBGRAPtrBitmap }
4514
TBGRAPtrBitmap.GetLineOrdernull4515 function TBGRAPtrBitmap.GetLineOrder: TRawImageLineOrder;
4516 begin
4517 result := inherited GetLineOrder;
4518 end;
4519
4520 procedure TBGRAPtrBitmap.SetLineOrder(AValue: TRawImageLineOrder);
4521 begin
4522 inherited SetLineOrder(AValue);
4523 end;
4524
4525 procedure TBGRAPtrBitmap.ReallocData;
4526 begin
4527 //nothing
4528 end;
4529
4530 procedure TBGRAPtrBitmap.FreeData;
4531 begin
4532 FDataByte := nil;
4533 end;
4534
4535 procedure TBGRAPtrBitmap.CannotResize;
4536 begin
4537 raise exception.Create('A pointer bitmap cannot be resized');
4538 end;
4539
4540 procedure TBGRAPtrBitmap.NotImplemented;
4541 begin
4542 raise exception.Create('Not implemented');
4543 end;
4544
4545 procedure TBGRAPtrBitmap.RebuildBitmap;
4546 begin
4547 NotImplemented;
4548 end;
4549
CreateDefaultFontRenderernull4550 function TBGRAPtrBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer;
4551 begin
4552 result := nil;
4553 NotImplemented;
4554 end;
4555
TBGRAPtrBitmap.LoadFromRawImagenull4556 function TBGRAPtrBitmap.LoadFromRawImage(ARawImage: TRawImage;
4557 DefaultOpacity: byte; AlwaysReplaceAlpha: boolean;
4558 RaiseErrorOnInvalidPixelFormat: boolean): boolean;
4559 begin
4560 result := false;
4561 NotImplemented;
4562 end;
4563
4564 constructor TBGRAPtrBitmap.Create(AWidth, AHeight: integer; AData: Pointer);
4565 begin
4566 inherited Create(AWidth, AHeight);
4567 SetDataPtr(AData);
4568 end;
4569
4570 procedure TBGRAPtrBitmap.SetDataPtr(AData: Pointer);
4571 begin
4572 FDataByte := AData;
4573 end;
4574
4575 procedure TBGRAPtrBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
4576 AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
4577 begin
4578 NotImplemented;
4579 end;
4580
4581 procedure TBGRAPtrBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
4582 AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
4583 begin
4584 NotImplemented;
4585 end;
4586
4587 procedure TBGRAPtrBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer
4588 );
4589 begin
4590 NotImplemented;
4591 end;
4592
4593 procedure TBGRAPtrBitmap.Assign(Source: TPersistent);
4594 begin
4595 CannotResize;
4596 end;
4597
4598 procedure TBGRAPtrBitmap.TakeScreenshot(ARect: TRect);
4599 begin
4600 CannotResize;
4601 end;
4602
4603 procedure TBGRAPtrBitmap.TakeScreenshotOfPrimaryMonitor;
4604 begin
4605 CannotResize;
4606 end;
4607
4608 procedure TBGRAPtrBitmap.LoadFromDevice(DC: HDC);
4609 begin
4610 NotImplemented;
4611 end;
4612
4613 procedure TBGRAPtrBitmap.LoadFromDevice(DC: HDC; ARect: TRect);
4614 begin
4615 NotImplemented;
4616 end;
4617
4618 procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer;
4619 c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
4620 gammaColorCorrection: boolean = True; Sinus: Boolean=False);
4621 begin
4622 bmp.GradientFill(x,y,x2,y2,c1,c2,gtype,o1,o2,mode,gammaColorCorrection,sinus);
4623 end;
4624
4625 initialization
4626
4627 with DefaultTextStyle do
4628 begin
4629 Alignment := taLeftJustify;
4630 Layout := tlTop;
4631 WordBreak := True;
4632 SingleLine := True;
4633 Clipping := True;
4634 ShowPrefix := False;
4635 Opaque := False;
4636 end;
4637
4638 end.
4639
4640