source: trunk/Packages/bgrabitmap/bgradefaultbitmap.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 221.7 KB
Line 
1{
2 /**************************************************************************\
3 bgradefaultbitmap.pas
4 ---------------------
5 This unit defines basic operations on bitmaps.
6 It should NOT be added to the 'uses' clause.
7 Some operations may be slow, so there are
8 accelerated versions for some routines.
9
10 ****************************************************************************
11 * *
12 * This file is part of BGRABitmap library which is distributed under the *
13 * modified LGPL. *
14 * *
15 * See the file COPYING.modifiedLGPL.txt, included in this distribution, *
16 * for details about the copyright. *
17 * *
18 * This program is distributed in the hope that it will be useful, *
19 * but WITHOUT ANY WARRANTY; without even the implied warranty of *
20 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
21 * *
22 ****************************************************************************
23}
24
25unit BGRADefaultBitmap;
26
27{$mode objfpc}{$H+}
28
29interface
30
31{ This unit contains TBGRADefaultBitmap class. This class contains basic drawing routines,
32 and call functions from other units to perform advanced drawing functions. }
33
34uses
35 SysUtils, Classes, Types, FPImage, BGRAGraphics, BGRABitmapTypes, FPImgCanv,
36 BGRACanvas, BGRACanvas2D, BGRAArrow, BGRAPen, BGRATransform, BGRATextBidi;
37
38type
39 TBGRAPtrBitmap = class;
40 {=== TBGRABitmap reference ===}
41 { TBGRADefaultBitmap }
42 {* This class is the base for all ''TBGRABitmap'' classes. It implements most
43 function to the exception from implementations specific to the
44 widgetset }{ in the doc, it is presented as
45 TBGRABitmap = class(TBGRACustomBitmap)
46 }
47 TBGRADefaultBitmap = class(TBGRACustomBitmap)
48 private
49 { Bounds checking which are shared by drawing functions. These functions check
50 if the coordinates are visible and return true if it is the case, swap
51 coordinates if necessary and make them fit into the clipping rectangle }
52 function CheckHorizLineBounds(var x, y, x2: int32or64): boolean; inline;
53 function CheckVertLineBounds(var x, y, y2: int32or64; out delta: int32or64): boolean; inline;
54 function CheckRectBounds(var x,y,x2,y2: integer; minsize: integer): boolean; inline;
55 function CheckAntialiasRectBounds(var x,y,x2,y2: single; w: single): boolean;
56 function GetCanvasBGRA: TBGRACanvas;
57 function GetCanvas2D: TBGRACanvas2D;
58 procedure GradientFillDithered(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
59 gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
60 gammaColorCorrection: boolean = True; Sinus: Boolean=False;
61 ditherAlgo: TDitheringAlgorithm = daFloydSteinberg); overload;
62 procedure GradientFillDithered(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
63 gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
64 Sinus: Boolean=False;
65 ditherAlgo: TDitheringAlgorithm = daFloydSteinberg); overload;
66 protected
67 FRefCount: integer; //reference counter (not related to interface reference counter)
68
69 //Pixel data
70 FData: PBGRAPixel; //pointer to pixels
71 FWidth, FHeight, FNbPixels: integer; //dimensions
72 FScanWidth, FScanHeight: integer; //possibility to reduce the zone being scanned
73 FDataModified: boolean; //if data image has changed so TBitmap should be updated
74 FLineOrder: TRawImageLineOrder;
75 FClipRect: TRect; //clipping (can be the whole image if there is no clipping)
76
77 //Scan
78 FScanPtr : PBGRAPixel; //current scan address
79 FScanCurX,FScanCurY: integer; //current scan coordinates
80
81 //GUI bitmap object
82 FBitmap: TBitmap;
83 FBitmapModified: boolean; //if TBitmap has changed so pixel data should be updated
84 FCanvasOpacity: byte; //opacity used with standard canvas functions
85 FAlphaCorrectionNeeded: boolean; //the alpha channel is not correct because standard functions do not
86 //take it into account
87
88 //FreePascal drawing routines
89 FCanvasFP: TFPImageCanvas;
90 FCanvasDrawModeFP: TDrawMode;
91 FCanvasPixelProcFP: procedure(x, y: int32or64; col: TBGRAPixel) of object;
92
93 //canvas-like with antialiasing and texturing
94 FCanvasBGRA: TBGRACanvas;
95 FCanvas2D: TBGRACanvas2D;
96
97 //drawing options
98 FEraseMode: boolean; //when polygons are erased instead of drawn
99 FFontHeight: integer;
100 FFontRenderer: TBGRACustomFontRenderer;
101
102 FPenStroker: TBGRAPenStroker;
103
104 //Pixel data
105 function GetRefCount: integer; override;
106 function GetScanLine(y: integer): PBGRAPixel; override; //don't forget to call InvalidateBitmap after modifications
107 function LoadFromRawImage(ARawImage: TRawImage; DefaultOpacity: byte;
108 AlwaysReplaceAlpha: boolean = False; RaiseErrorOnInvalidPixelFormat: boolean = True): boolean; virtual; abstract;
109 function GetDataPtr: PBGRAPixel; override;
110 procedure ClearTransparentPixels; override;
111 function GetScanlineFast(y: integer): PBGRAPixel; inline;
112 function GetLineOrder: TRawImageLineOrder; override;
113 procedure SetLineOrder(AValue: TRawImageLineOrder); virtual;
114 function GetNbPixels: integer; override;
115 function GetWidth: integer; override;
116 function GetHeight: integer; override;
117
118 //GUI bitmap object
119 function GetBitmap: TBitmap; override;
120 function GetCanvas: TCanvas; override;
121 procedure DiscardBitmapChange; inline;
122 procedure DoAlphaCorrection;
123 procedure SetCanvasOpacity(AValue: byte); override;
124 function GetCanvasOpacity: byte; override;
125 function GetCanvasAlphaCorrection: boolean; override;
126 procedure SetCanvasAlphaCorrection(const AValue: boolean); override;
127 procedure DoLoadFromBitmap; virtual;
128
129 //FreePascal drawing routines
130 function GetCanvasFP: TFPImageCanvas; override;
131 procedure SetCanvasDrawModeFP(const AValue: TDrawMode); override;
132 function GetCanvasDrawModeFP: TDrawMode; override;
133
134 {Allocation routines}
135 procedure ReallocData; virtual;
136 procedure FreeData; virtual;
137 function CreatePtrBitmap(AWidth,AHeight: integer; AData: PBGRAPixel): TBGRAPtrBitmap; virtual;
138
139 procedure RebuildBitmap; virtual; abstract;
140 procedure FreeBitmap; virtual;
141
142 procedure Init; virtual;
143
144 {TFPCustomImage}
145 procedure SetInternalColor(x, y: integer; const Value: TFPColor); override;
146 function GetInternalColor(x, y: integer): TFPColor; override;
147 procedure SetInternalPixel(x, y: integer; Value: integer); override;
148 function GetInternalPixel(x, y: integer): integer; override;
149
150 {Image functions}
151 function FineResample(NewWidth, NewHeight: integer): TBGRACustomBitmap;
152 function SimpleStretch(NewWidth, NewHeight: integer): TBGRACustomBitmap;
153 function CheckEmpty: boolean; override;
154 function CheckIsZero: boolean; override;
155 function GetHasTransparentPixels: boolean; override;
156 function GetHasSemiTransparentPixels: boolean; override;
157 function GetAverageColor: TColor; override;
158 function GetAveragePixel: TBGRAPixel; override;
159
160 //drawing
161 function GetPenJoinStyle: TPenJoinStyle; override;
162 procedure SetPenJoinStyle(const AValue: TPenJoinStyle); override;
163 function GetPenMiterLimit: single; override;
164 procedure SetPenMiterLimit(const AValue: single); override;
165 function GetCustomPenStyle: TBGRAPenStyle; override;
166 procedure SetCustomPenStyle(const AValue: TBGRAPenStyle); override;
167 procedure SetPenStyle(const AValue: TPenStyle); override;
168 function GetPenStyle: TPenStyle; override;
169 function GetLineCap: TPenEndCap; override;
170 procedure SetLineCap(AValue: TPenEndCap); override;
171 function GetPenStroker: TBGRACustomPenStroker; override;
172
173 function GetArrowEndSize: TPointF; override;
174 function GetArrowStartSize: TPointF; override;
175 procedure SetArrowEndSize(AValue: TPointF); override;
176 procedure SetArrowStartSize(AValue: TPointF); override;
177 function GetArrowEndOffset: single; override;
178 function GetArrowStartOffset: single; override;
179 procedure SetArrowEndOffset(AValue: single); override;
180 procedure SetArrowStartOffset(AValue: single); override;
181 function GetArrowEndRepeat: integer; override;
182 function GetArrowStartRepeat: integer; override;
183 procedure SetArrowEndRepeat(AValue: integer); override;
184 procedure SetArrowStartRepeat(AValue: integer); override;
185
186 function GetFontHeight: integer; override;
187 procedure SetFontHeight(AHeight: integer); override;
188 function GetFontFullHeight: integer; override;
189 procedure SetFontFullHeight(AHeight: integer); override;
190 function GetFontPixelMetric: TFontPixelMetric; override;
191 function GetFontRenderer: TBGRACustomFontRenderer; override;
192 procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); override;
193 function CreateDefaultFontRenderer: TBGRACustomFontRenderer; virtual; abstract;
194 function GetFontVerticalAnchorOffset: single; override;
195 function GetFontAnchorRotatedOffset: TPointF; overload;
196 function GetFontAnchorRotatedOffset(ACustomOrientation: integer): TPointF; overload;
197
198 function GetClipRect: TRect; override;
199 procedure SetClipRect(const AValue: TRect); override;
200
201 function InternalGetPixelCycle256(ix,iy: int32or64; iFactX,iFactY: int32or64): TBGRAPixel;
202 function InternalGetPixel256(ix,iy: int32or64; iFactX,iFactY: int32or64; smoothBorder: boolean): TBGRAPixel;
203 function GetArrow: TBGRAArrow;
204 procedure InternalTextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
205 procedure InternalCrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePos: byte; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency);
206
207 function CheckClippedRectBounds(var x,y,x2,y2: integer): boolean;
208 procedure InternalArc(cx,cy,rx,ry: single; StartAngleRad,EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single;
209 AFillColor: TBGRAPixel; AOptions: TArcOptions; ADrawChord: boolean = false; ATexture: IBGRAScanner = nil); override;
210
211 public
212 {** Provides a canvas with opacity and antialiasing }
213 property CanvasBGRA: TBGRACanvas read GetCanvasBGRA;
214 {** Provides a canvas with 2d transformation and similar to HTML5. }
215 property Canvas2D: TBGRACanvas2D read GetCanvas2D;
216 {** For more properties, see parent class [[TBGRACustomBitmap and IBGRAScanner#TBGRACustomBitmap|TBGRACustomBitmap]] }
217
218 {==== Reference counting ====}
219
220 {** Adds a reference (this reference count is not the same as
221 the reference count of an interface, it changes only by
222 explicit calls }
223 function NewReference: TBGRACustomBitmap;
224 {** Free a reference. When the resulting reference count gets
225 to zero, the image is freed. The initial reference count
226 is equal to 1 }
227 procedure FreeReference;
228 {** Returns an object with a reference count equal to 1. Duplicate
229 this bitmap if necessary }
230 function GetUnique: TBGRACustomBitmap;
231
232 { ** Allocate xor mask }
233 procedure NeedXorMask; override;
234
235 { ** Free reference to xor mask }
236 procedure DiscardXorMask; override;
237
238 {==== Constructors ====}
239
240 {------------------------- Constructors from TFPCustomImage----------------}
241 {** Creates a new bitmap, initialize properties and bitmap data }
242 constructor Create(AWidth, AHeight: integer); overload; override;
243 {** Can only be called with an existing instance of ''TBGRABitmap''.
244 Sets the dimensions of an existing ''TBGRABitmap'' instance. }
245 procedure SetSize(AWidth, AHeight: integer); override;
246
247 {------------------------- Constructors from TBGRACustomBitmap-------------}
248 {** Creates an image of width and height equal to zero. In this case,
249 ''Data'' = '''nil''' }
250 constructor Create; overload; override;
251 {** Creates an image by copying the content of a ''TFPCustomImage'' }
252 constructor Create(AFPImage: TFPCustomImage); overload; override;
253 {** Creates an image by copying the content of a ''TBitmap'' }
254 constructor Create(ABitmap: TBitmap; AUseTransparent: boolean = true); overload; override;
255 {** Creates an image of dimensions ''AWidth'' and ''AHeight'' and fills it with the opaque color ''Color'' }
256 constructor Create(AWidth, AHeight: integer; Color: TColor); overload; override;
257 {** Creates an image of dimensions ''AWidth'' and ''AHeight'' and fills it with ''Color'' }
258 constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); overload; override;
259
260 {** Creates an image by loading its content from the file ''AFilename''.
261 The encoding of the string is the default one for the operating system.
262 It is recommended to use the next constructor and UTF8 encoding }
263 constructor Create(AFilename: string); overload; override;
264
265 {** Creates an image by loading its content from the file ''AFilename''.
266 The boolean ''AIsUtf8Filename'' specifies if UTF8 encoding is assumed
267 for the filename }
268 constructor Create(AFilename: string; AIsUtf8: boolean); overload; override;
269 constructor Create(AFilename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions); overload; override;
270
271 {** Creates an image by loading its content from the stream ''AStream'' }
272 constructor Create(AStream: TStream); overload; override;
273 {** Free the object and all its resources }
274 destructor Destroy; override;
275
276 {------------------------- Quasi-constructors -----------------------------}
277 {** Can only be called from an existing instance of ''TBGRABitmap''.
278 Creates a new instance with dimensions ''AWidth'' and ''AHeight'',
279 containing transparent pixels. }
280 function NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap; overload; override;
281
282 {** Can only be called from an existing instance of ''TBGRABitmap''.
283 Creates a new instance with dimensions ''AWidth'' and ''AHeight'',
284 and fills it with Color }
285 function NewBitmap(AWidth, AHeight: integer; Color: TBGRAPixel): TBGRACustomBitmap; overload; override;
286
287 {** Can only be called from an existing instance of ''TBGRABitmap''.
288 Creates a new instance with by loading its content
289 from the file ''Filename''. The encoding of the string
290 is the default one for the operating system }
291 function NewBitmap(Filename: string): TBGRACustomBitmap; overload; override;
292
293 {** Can only be called from an existing instance of ''TBGRABitmap''.
294 Creates a new instance with by loading its content
295 from the file ''Filename'' }
296 function NewBitmap(Filename: string; AIsUtf8: boolean): TBGRACustomBitmap; overload; override;
297 function NewBitmap(Filename: string; AIsUtf8: boolean; AOptions: TBGRALoadingOptions): TBGRACustomBitmap; overload; override;
298
299 {** Can only be called from an existing instance of ''TBGRABitmap''.
300 Creates an image by copying the content of a ''TFPCustomImage'' }
301 function NewBitmap(AFPImage: TFPCustomImage): TBGRACustomBitmap; overload; override;
302
303 {** Load image from a stream. The specified image reader is used }
304 procedure LoadFromStream(Str: TStream; Handler: TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload; override;
305
306 {** Load image from an embedded Lazarus resource. Format is detected automatically }
307 procedure LoadFromResource(AFilename: string; AOptions: TBGRALoadingOptions); overload; override;
308
309 {** Assign the content of the specified ''Source''. It can be a ''TBGRACustomBitmap'' or
310 a ''TFPCustomImage'' }
311 procedure Assign(Source: TPersistent); overload; override;
312 procedure Assign(Source: TBitmap; AUseTransparent: boolean); overload;
313 {** Stores the image in the stream without compression nor header }
314 procedure Serialize(AStream: TStream); override;
315 {** Reads the image in a stream that was previously serialized }
316 procedure Deserialize(AStream: TStream); override;
317 {** Stores an empty image (of size zero) }
318 class procedure SerializeEmpty(AStream: TStream);
319
320 {* Example:
321 <syntaxhighlight>
322 * var bmp1, bmp2: TBGRABitmap;
323 * begin
324 * bmp1 := TBGRABitmap.Create(100,100);
325 * bmp2 := bmp1.NewBitmap(100,100) as TBGRABitmap;
326 * ...
327 * end;</syntaxhighlight>
328 See tutorial 2 on [[BGRABitmap_tutorial_2|how to load and display an image]].
329 * See reference on [[TBGRACustomBitmap_and_IBGRAScanner#Load_and_save_files|loading and saving files]] }
330
331 {==== Pixel functions ====}
332 {** Checks if the specified point is in the clipping rectangle ''ClipRect'' }
333 function PtInClipRect(x, y: int32or64): boolean; inline;
334 {** Sets the pixel by replacing the content at (''x'',''y'') with the specified color.
335 Alpha value is set to 255 (opaque) }
336 procedure SetPixel(x, y: int32or64; c: TColor); overload; override;
337 {** Sets the pixel at (''x'',''y'') with the specified content }
338 procedure SetPixel(x, y: int32or64; c: TBGRAPixel); overload; override;
339 {** Applies a logical '''xor''' to the content of the pixel with the specified value.
340 This includes the alpha channel, so if you want to preserve the opacity, provide
341 a color ''c'' with alpha channel equal to zero }
342 procedure XorPixel(x, y: int32or64; c: TBGRAPixel); override;
343 {** Draws a pixel with gamma correction at (''x'',''y''). Pixel is supplied
344 in sRGB colorspace }
345 procedure DrawPixel(x, y: int32or64; c: TBGRAPixel); override;
346 {** Draws a pixel with the specified ''ADrawMode'' at (''x'',''y'').
347 Pixel is supplied in sRGB colorspace. Gamma correction may be applied
348 depending on the draw mode }{inherited
349 procedure DrawPixel(x, y: int32or64; c: TBGRAPixel; ADrawMode: TDrawMode); overload;
350 }{** Draws a pixel with gamma correction at (''x'',''y''). Pixel is supplied
351 in gamma expanded colorspace }
352 procedure DrawPixel(x, y: int32or64; ec: TExpandedPixel); override;
353 {** Draws a pixel without gamma correction at (''x'',''y''). Pixel is supplied
354 in sRGB colorspace }
355 procedure FastBlendPixel(x, y: int32or64; c: TBGRAPixel); override;
356 {** Erase the content of the pixel by reducing the value of the
357 alpha channel. ''alpha'' specifies how much to decrease.
358 If the resulting alpha reaches zero, the content
359 is replaced by ''BGRAPixelTransparent'' }
360 procedure ErasePixel(x, y: int32or64; alpha: byte); override;
361 {** Sets the alpha value at (''x'',''y''). If ''alpha'' = 0, the
362 pixel is replaced by ''BGRAPixelTransparent'' }
363 procedure AlphaPixel(x, y: int32or64; alpha: byte); override;
364 {** Returns the content of the specified pixel. If it is out of the
365 bounds of the picture, the result is ''BGRAPixelTransparent'' }
366 function GetPixel(x, y: int32or64): TBGRAPixel; override;
367 {** Computes the value of the pixel at a floating point coordiante
368 by interpolating the values of the pixels around it.
369 * There is a one pixel wide margin around the pixel where the pixels are
370 still considered inside. If ''smoothBorder'' is set to true, pixel fade
371 to transparent.
372 * If it is more out of the bounds, the result is ''BGRAPixelTransparent''.
373 * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted
374 values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' }
375 function GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; override;
376 {** Similar to previous ''GetPixel'' function, but the fractional part of
377 the coordinate is supplied with a number from 0 to 255. The actual
378 coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) }
379 function GetPixel256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel; override;
380 {** Computes the value of the pixel at a floating point coordiante
381 by interpolating the values of the pixels around it. If the pixel
382 is out of bounds, the image is repeated.
383 * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted
384 values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' }
385 function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; override;
386 {** Similar to previous ''GetPixel'' function, but the fractional part of
387 the coordinate is supplied with a number from 0 to 255. The actual
388 coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) }
389 function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel; overload; override;
390 {** Computes the value of the pixel at a floating point coordiante
391 by interpolating the values of the pixels around it. ''repeatX'' and
392 ''repeatY'' specifies if the image is to be repeated or not.
393 * ''AResampleFilter'' specifies how pixels must be interpolated. Accepted
394 values are ''rfBox'', ''rfLinear'', ''rfHalfCosine'' and ''rfCosine'' }
395 function GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; override;
396 {** Similar to previous ''GetPixel'' function, but the fractional part of
397 the coordinate is supplied with a number from 0 to 255. The actual
398 coordinate is (''x'' + ''fracX256''/256, ''y'' + ''fracY256''/256) }
399 function GetPixelCycle256(x, y, fracX256,fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean): TBGRAPixel; overload; override;
400
401 {==== Drawing lines and polylines (integer coordinates) ====}
402 {* These functions do not take into account current pen style/cap/join.
403 See [[BGRABitmap tutorial 13|coordinate system]]. }
404
405 {** Replaces the content of the pixels at line ''y'' and
406 at columns ''x'' to ''x2'' included, using specified color }
407 procedure SetHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
408 {** Applies xor to the pixels at line ''y'' and
409 at columns ''x'' to ''x2'' included, using specified color.
410 This includes the alpha channel, so if you want to preserve the
411 opacity, provide a color ''c'' with alpha channel equal to zero }
412 procedure XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
413 {** Draws an horizontal line with gamma correction at line ''y'' and
414 at columns ''x'' to ''x2'' included, using specified color }
415 procedure DrawHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
416 {** Draws an horizontal line with gamma correction at line ''y'' and
417 at columns ''x'' to ''x2'' included, using specified color }
418 procedure DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel); override;
419 {** Draws an horizontal line with gamma correction at line ''y'' and
420 at columns ''x'' to ''x2'' included, using specified scanner
421 to get the source colors }{inherited
422 procedure DrawHorizLine(x, y, x2: int32or64; texture: IBGRAScanner); overload;
423 }{** Draws an horizontal line without gamma correction at line ''y'' and
424 at columns ''x'' to ''x2'' included, using specified color }
425 procedure FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel); override;
426 {** Draws an horizontal line at line ''y'' and
427 at columns ''x'' to ''x2'' included, using specified scanner
428 and the specified ''ADrawMode'' }
429 procedure HorizLine(x, y, x2: int32or64; texture: IBGRAScanner; ADrawMode : TDrawMode); override;
430 {** Draws an horizontal line at line ''y'' and
431 at columns ''x'' to ''x2'' included, using specified color
432 and the specified ''ADrawMode'' }{inherited
433 procedure HorizLine(x,y,x2: Int32or64; c: TBGRAPixel; ADrawMode: TDrawMode); overload;
434 }
435 {** Replaces the alpha value of the pixels at line ''y'' and
436 at columns ''x'' to ''x2'' included }
437 procedure AlphaHorizLine(x, y, x2: int32or64; alpha: byte); override;
438 {** Draws an horizontal line with gamma correction at line ''y'' and
439 at columns ''x'' to ''x2'' included, using specified color,
440 and with a transparency that increases with the color difference
441 with ''compare''. If the difference is greater than ''maxDiff'',
442 pixels are not changed }
443 procedure DrawHorizLineDiff(x, y, x2: int32or64; c, compare: TBGRAPixel;
444 maxDiff: byte); override;
445
446 {** Replaces a vertical line at column ''x'' and at row ''y'' to ''y2'' }
447 procedure SetVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
448 {** Xors a vertical line at column ''x'' and at row ''y'' to ''y2'' }
449 procedure XorVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
450 {** Draws a vertical line with gamma correction at column ''x'' and at row ''y'' to ''y2'' }
451 procedure DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
452 {** Draws a vertical line without gamma correction at column ''x'' and at row ''y'' to ''y2'' }
453 procedure FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel); override;
454 {** Replace alpha values in a vertical line at column ''x'' and at row ''y'' to ''y2'' }
455 procedure AlphaVertLine(x, y, y2: int32or64; alpha: byte); override;
456 {** Draws a vertical line with the specified draw mode at column ''x'' and at row ''y'' to ''y2'' }{inherited
457 procedure VertLine(x,y,y2: Int32or64; c: TBGRAPixel; ADrawMode: TDrawMode);
458 }
459
460 {** Draws an aliased line from (x1,y1) to (x2,y2) using Bresenham's algorithm
461 ''c'' specifies the color. ''DrawLastPixel'' specifies if (x2,y2) must be drawn.
462 ''ADrawMode'' specifies the mode to use when drawing the pixels }
463 procedure DrawLine(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
464 {** Draws an antialiased line from (x1,y1) to (x2,y2) using an improved version of Bresenham's algorithm
465 ''c'' specifies the color. ''DrawLastPixel'' specifies if (x2,y2) must be drawn }
466 procedure DrawLineAntialias(x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean); overload; override;
467 {** Draws an antialiased line with two colors ''c1'' and ''c2'' as dashes of lenght ''dashLen'' }
468 procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean); overload; override;
469 {** Draws an antialiased line with two colors ''c1'' and ''c2'' as dashes of lenght ''dashLen''.
470 ''DashPos'' can be used to specify the start dash position and to retrieve the dash position at the end
471 of the line, in order to draw a polyline with consistent dashes }
472 procedure DrawLineAntialias(x1, y1, x2, y2: integer; c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer); override;
473
474 {** Erases the line from (x1,y1) to (x2,y2) using Bresenham's algorithm.
475 ''alpha'' specifies how much to decrease. If ''alpha'' = 0, nothing
476 is changed and if ''alpha'' = 255, all pixels become transparent.
477 ''DrawListPixel'' specifies if (x2,y2) must be changed }
478 procedure EraseLine(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); override;
479 {** Erases the line from (x1,y1) to (x2,y2) width antialiasing.
480 ''alpha'' specifies how much to decrease. If ''alpha'' = 0, nothing
481 is changed and if ''alpha'' = 255, all pixels become transparent.
482 ''DrawListPixel'' specifies if (x2,y2) must be changed }
483 procedure EraseLineAntialias(x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean); override;
484
485 {==== Drawing lines and polylines (floating point coordinates) ====}
486 {* These functions use the current pen style/cap/join. The parameter ''w''
487 specifies the width of the line and the base unit for dashes.
488 See [[BGRABitmap tutorial 13|coordinate system]]. }
489
490 {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join }
491 procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single); overload; override;
492 {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join.
493 ''texture'' specifies the source color to use when filling the line }
494 procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single); overload; override;
495 {** Draws a line from (x1,y1) to (x2,y2) using current pen style/cap/join.
496 ''Closed'' specifies if the end of the line is closed. If it is not closed,
497 a space is left so that the next line can fit }
498 procedure DrawLineAntialias(x1, y1, x2, y2: single; c: TBGRAPixel; w: single; ClosedCap: boolean); overload; override;
499 {** Same as above with ''texture'' specifying the source color to use when filling the line }
500 procedure DrawLineAntialias(x1, y1, x2, y2: single; texture: IBGRAScanner; w: single; ClosedCap: boolean); overload; override;
501
502 {** Draws a polyline using current pen style/cap/join }
503 procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); overload; override;
504 {** Draws a polyline using current pen style/cap/join.
505 ''texture'' specifies the source color to use when filling the line }
506 procedure DrawPolyLineAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); overload; override;
507 {** Draws a polyline using current pen style/cap/join.
508 ''Closed'' specifies if the end of the line is closed. If it is not closed,
509 a space is left so that the next line can fit }
510 procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; ClosedCap: boolean); overload; override;
511 procedure DrawPolyLineAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single; ClosedCap: boolean); overload; override;
512 {** Draws a polyline using current pen style/cap/join.
513 ''fillcolor'' specifies a color to fill the polygon formed by the points }
514 procedure DrawPolyLineAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; override;
515 {** Draws a polyline using current pen style/cap/join.
516 The last point considered as a join with the first point if it has
517 the same coordinate }
518 procedure DrawPolyLineAntialiasAutocycle(const points: array of TPointF; c: TBGRAPixel; w: single); override;
519 procedure DrawPolyLineAntialiasAutocycle(const points: array of TPointF; texture: IBGRAScanner; w: single); override;
520 {** Draws a polygon using current pen style/cap/join.
521 The polygon is always closed. You don't need to set the last point
522 to be the same as the first point }
523 procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single); overload; override;
524 {** Draws a polygon using current pen style/cap/join.
525 The polygon is always closed. You don't need to set the last point
526 to be the same as the first point }
527 procedure DrawPolygonAntialias(const points: array of TPointF; texture: IBGRAScanner; w: single); overload; override;
528 {** Draws a filled polygon using current pen style/cap/join.
529 The polygon is always closed. You don't need to set the last point
530 to be the same as the first point. }
531 procedure DrawPolygonAntialias(const points: array of TPointF; c: TBGRAPixel; w: single; fillcolor: TBGRAPixel); overload; override;
532
533 {** Erases a line from (x1,y1) to (x2,y2) using current pen style/cap/join }
534 procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single); override;
535 {** Erases a line from (x1,y1) to (x2,y2) using current pen style/cap/join.
536 ''Closed'' specifies if the end of the line is closed. If it is not closed,
537 a space is left so that the next line can fit }
538 procedure EraseLineAntialias(x1, y1, x2, y2: single; alpha: byte; w: single; Closed: boolean); override;
539 {** Erases a polyline using current pen style/cap/join }
540 procedure ErasePolyLineAntialias(const points: array of TPointF; alpha: byte; w: single); override;
541
542 {==== Rectangles (integer coordinates) ====}
543 {* The integer coordinates of rectangles interpreted such that
544 that the bottom/right pixels are not drawn. The width is equal
545 to x2-x, and pixels are drawn from x to x2-1. If x = x2, then nothing
546 is drawn. See [[BGRABitmap tutorial 13|coordinate system]].
547 * These functions do not take into account current pen style/cap/join.
548 They draw a continuous 1-pixel width border }
549
550 {** Draw a size border of a rectangle,
551 using the specified ''mode'' }
552 procedure Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); overload; override;
553 {** Draw a filled rectangle with a border of color ''BorderColor'',
554 using the specified ''mode'' }
555 procedure Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel; mode: TDrawMode); overload; override;
556 {** Fills completely a rectangle, without any border, with the specified ''mode'' }
557 procedure FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); overload; override;
558 {** Fills completely a rectangle, without any border, with the specified ''texture'' and
559 with the specified ''mode'' }
560 procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint); overload; override;
561 procedure FillRect(x, y, x2, y2: integer; texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm); overload; override;
562 {** Sets the alpha value within the specified rectangle }
563 procedure AlphaFillRect(x, y, x2, y2: integer; alpha: byte); override;
564 {** Draws a filled round rectangle, with corners having an elliptical diameter of ''DX'' and ''DY'' }
565 procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor, FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
566 {** Draws a round rectangle, with corners having an elliptical diameter of ''DX'' and ''DY'' }
567 procedure RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
568 procedure FillRoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; FillTexture: IBGRAScanner; ADrawMode: TDrawMode = dmDrawWithTransparency); override; overload;
569
570 {==== Rectangles and ellipses (floating point coordinates) ====}
571 {* These functions use the current pen style/cap/join. The parameter ''w''
572 specifies the width of the line and the base unit for dashes
573 * The coordinates are pixel-centered, so that when filling a rectangle,
574 if the supplied values are integers, the border will be half transparent.
575 If you want the border to be completely filled, you can subtract/add
576 0.5 to the coordinates to include the remaining thin border.
577 See [[BGRABitmap tutorial 13|coordinate system]]. }
578
579 {** Draws a rectangle with antialiasing and fills it with color ''back''.
580 Note that the pixel (x2,y2) is included contrary to integer coordinates }
581 procedure RectangleAntialias(x, y, x2, y2: single; c: TBGRAPixel; w: single; back: TBGRAPixel); override;
582 {** Draws a rectangle with antialiasing. Note that the pixel (x2,y2) is
583 included contrary to integer coordinates }
584 procedure RectangleAntialias(x, y, x2, y2: single; texture: IBGRAScanner; w: single); override;
585 {** Fills a rectangle with antialiasing. For example (-0.5,-0.5,0.5,0.5)
586 fills one pixel }
587 procedure FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel; pixelCenteredCoordinates: boolean = true); overload; override;
588 {** Fills a rectangle with a texture }
589 procedure FillRectAntialias(x, y, x2, y2: single; texture: IBGRAScanner; pixelCenteredCoordinates: boolean = true); overload; override;
590 {** Erases the content of a rectangle with antialiasing }
591 procedure EraseRectAntialias(x, y, x2, y2: single; alpha: byte; pixelCenteredCoordinates: boolean = true); override;
592
593 {** Draws a rounded rectangle border with antialiasing. The corners have an
594 elliptical radius of ''rx'' and ''ry''. ''options'' specifies how to
595 draw the corners. See [[BGRABitmap Geometry types|geometry types]] }
596 procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; w: single; options: TRoundRectangleOptions = []); overload; override;
597 {** Draws a rounded rectangle border with the specified texture.
598 The corners have an elliptical radius of ''rx'' and ''ry''.
599 ''options'' specifies how to draw the corners.
600 See [[BGRABitmap Geometry types|geometry types]] }
601 procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; w: single; options: TRoundRectangleOptions = []); overload; override;
602 {** Draws and fills a round rectangle }
603 procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel; options: TRoundRectangleOptions = []); overload; override;
604 {** Draws and fills a round rectangle with textures }
605 procedure RoundRectAntialias(x,y,x2,y2,rx,ry: single; penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner; options: TRoundRectangleOptions = []); overload; override;
606
607 {** Fills a rounded rectangle with antialiasing. The corners have an
608 elliptical radius of ''rx'' and ''ry''. ''options'' specifies how to
609 draw the corners. See [[BGRABitmap Geometry types|geometry types]] }
610 procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; c: TBGRAPixel; options: TRoundRectangleOptions = []; pixelCenteredCoordinates: boolean = true); overload; override;
611 {** Fills a rounded rectangle with a texture }
612 procedure FillRoundRectAntialias(x,y,x2,y2,rx,ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions = []; pixelCenteredCoordinates: boolean = true); overload; override;
613 {** Erases the content of a rounded rectangle with a texture }
614 procedure EraseRoundRectAntialias(x,y,x2,y2,rx,ry: single; alpha: byte; options: TRoundRectangleOptions = []; pixelCenteredCoordinates: boolean = true); overload; override;
615
616 {** Draws an ellipse without antialising. ''rx'' is the horizontal radius and
617 ''ry'' the vertical radius }
618 procedure Ellipse(x, y, rx, ry: single; c: TBGRAPixel; w: single; ADrawMode: TDrawMode); overload; override;
619 procedure Ellipse(AOrigin, AXAxis, AYAxis: TPointF; c: TBGRAPixel; w: single; ADrawMode: TDrawMode); overload; override;
620 {** Draws an ellipse with antialising. ''rx'' is the horizontal radius and
621 ''ry'' the vertical radius }
622 procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single); overload; override;
623 procedure EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; c: TBGRAPixel; w: single); overload; override;
624 {** Draws an ellipse border with a ''texture'' }
625 procedure EllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner; w: single); overload; override;
626 procedure EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; texture: IBGRAScanner; w: single); overload; override;
627 {** Draws and fills an ellipse }
628 procedure EllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override;
629 procedure EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; c: TBGRAPixel; w: single; back: TBGRAPixel); overload; override;
630 {** Fills an ellipse }
631 procedure FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel); overload; override;
632 procedure FillEllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; c: TBGRAPixel); overload; override;
633 {** Fills an ellipse with a ''texture'' }
634 procedure FillEllipseAntialias(x, y, rx, ry: single; texture: IBGRAScanner); overload; override;
635 procedure FillEllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; texture: IBGRAScanner); overload; override;
636 {** Fills an ellipse with a gradient of color. ''outercolor'' specifies
637 the end color of the gradient on the border of the ellipse and
638 ''innercolor'' the end color of the gradient at the center of the
639 ellipse }
640 procedure FillEllipseLinearColorAntialias(x, y, rx, ry: single; outercolor, innercolor: TBGRAPixel); overload; override;
641 procedure FillEllipseLinearColorAntialias(AOrigin, AXAxis, AYAxis: TPointF; outercolor, innercolor: TBGRAPixel); overload; override;
642 {** Erases the content of an ellipse }
643 procedure EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte); overload; override;
644 procedure EraseEllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF; alpha: byte); overload; override;
645
646 {==== Polygons and path ====}
647 procedure FillPoly(const points: array of TPointF; c: TBGRAPixel; drawmode: TDrawMode; APixelCenteredCoordinates: boolean = true); overload; override;
648 procedure FillPoly(const points: array of TPointF; texture: IBGRAScanner; drawmode: TDrawMode; APixelCenteredCoordinates: boolean = true); overload; override;
649 procedure FillPolyAntialias(const points: array of TPointF; c: TBGRAPixel; APixelCenteredCoordinates: boolean = true); overload; override;
650 procedure FillPolyAntialias(const points: array of TPointF; texture: IBGRAScanner; APixelCenteredCoordinates: boolean = true); overload; override;
651 procedure ErasePoly(const points: array of TPointF; alpha: byte; APixelCenteredCoordinates: boolean = true); override;
652 procedure ErasePolyAntialias(const points: array of TPointF; alpha: byte; APixelCenteredCoordinates: boolean = true); override;
653
654 procedure FillTriangleLinearColor(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
655 procedure FillTriangleLinearColorAntialias(pt1,pt2,pt3: TPointF; c1,c2,c3: TBGRAPixel); override;
656 procedure FillTriangleLinearMapping(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True); override;
657 procedure FillTriangleLinearMappingLightness(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,light2,light3: word; TextureInterpolation: Boolean= True); override;
658 procedure FillTriangleLinearMappingAntialias(pt1,pt2,pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF); override;
659
660 procedure FillQuadLinearColor(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
661 procedure FillQuadLinearColorAntialias(pt1,pt2,pt3,pt4: TPointF; c1,c2,c3,c4: TBGRAPixel); override;
662 procedure FillQuadLinearMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; TextureInterpolation: Boolean= True; ACulling: TFaceCulling = fcNone); override;
663 procedure FillQuadLinearMappingLightness(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,light2,light3,light4: word; TextureInterpolation: Boolean= True); override;
664 procedure FillQuadLinearMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACulling: TFaceCulling = fcNone); override;
665 procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
666 procedure FillQuadPerspectiveMapping(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
667 procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF); override;
668 procedure FillQuadPerspectiveMappingAntialias(pt1,pt2,pt3,pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; ACleanBorders: TRect); override;
669 procedure FillQuadAffineMapping(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; ADrawMode: TDrawMode = dmDrawWithTransparency; AOpacity: byte = 255); override;
670 procedure FillQuadAffineMappingAntialias(Orig,HAxis,VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean = true; AOpacity: byte = 255); override;
671
672 procedure FillPolyLinearMapping(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean); override;
673 procedure FillPolyLinearMappingLightness(const points: array of TPointF; texture: IBGRAScanner; texCoords: array of TPointF; lightnesses: array of word; TextureInterpolation: Boolean); override;
674 procedure FillPolyLinearColor(const points: array of TPointF; AColors: array of TBGRAPixel); override;
675 procedure FillPolyPerspectiveMapping(const points: array of TPointF; const pointsZ: array of single; texture: IBGRAScanner; texCoords: array of TPointF; TextureInterpolation: Boolean; zbuffer: psingle = nil); override;
676 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;
677
678 procedure FillShape(shape: TBGRACustomFillInfo; c: TBGRAPixel; drawmode: TDrawMode); overload; override;
679 procedure FillShape(shape: TBGRACustomFillInfo; texture: IBGRAScanner; drawmode: TDrawMode); overload; override;
680 procedure FillShapeAntialias(shape: TBGRACustomFillInfo; c: TBGRAPixel); overload; override;
681 procedure FillShapeAntialias(shape: TBGRACustomFillInfo; texture: IBGRAScanner); overload; override;
682 procedure EraseShape(shape: TBGRACustomFillInfo; alpha: byte); override;
683 procedure EraseShapeAntialias(shape: TBGRACustomFillInfo; alpha: byte); override;
684
685 procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; override;
686 procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; override;
687 procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; override;
688 procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; override;
689 procedure DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single); overload; override;
690 procedure DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single); overload; override;
691 procedure FillPath(APath: IBGRAPath; AFillColor: TBGRAPixel); overload; override;
692 procedure FillPath(APath: IBGRAPath; AFillTexture: IBGRAScanner); overload; override;
693 procedure ErasePath(APath: IBGRAPath; alpha: byte); overload; override;
694
695 procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel); overload; override;
696 procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel); overload; override;
697 procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner); overload; override;
698 procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner); overload; override;
699 procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeColor: TBGRAPixel; AWidth: single); overload; override;
700 procedure DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AStrokeTexture: IBGRAScanner; AWidth: single); overload; override;
701 procedure FillPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AFillColor: TBGRAPixel); overload; override;
702 procedure FillPath(APath: IBGRAPath; AMatrix: TAffineMatrix; AFillTexture: IBGRAScanner); overload; override;
703 procedure ErasePath(APath: IBGRAPath; AMatrix: TAffineMatrix; alpha: byte); overload; override;
704
705 procedure ArrowStartAsNone; override;
706 procedure ArrowStartAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
707 procedure ArrowStartAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
708 procedure ArrowStartAsTail; override;
709
710 procedure ArrowEndAsNone; override;
711 procedure ArrowEndAsClassic(AFlipped: boolean = false; ACut: boolean = false; ARelativePenWidth: single = 1); override;
712 procedure ArrowEndAsTriangle(ABackOffset: single = 0; ARounded: boolean = false; AHollow: boolean = false; AHollowPenWidth: single = 0.5); override;
713 procedure ArrowEndAsTail; override;
714
715 { Draws the UTF8 encoded string, with color c.
716 If align is taLeftJustify, (x,y) is the top-left corner.
717 If align is taCenter, (x,y) is at the top and middle of the text.
718 If align is taRightJustify, (x,y) is the top-right corner.
719 The value of FontOrientation is taken into account, so that the text may be rotated. }
720 procedure TextOut(x, y: single; sUTF8: string; c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean); overload; override;
721
722 { Same as above functions, except that the text is filled using texture.
723 The value of FontOrientation is taken into account, so that the text may be rotated. }
724 procedure TextOut(x, y: single; sUTF8: string; texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean); overload; override;
725
726 { Same as above, except that the orientation is specified, overriding the value of the property FontOrientation. }
727 procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; sUTF8: string; c: TBGRAPixel; align: TAlignment); overload; override;
728 procedure TextOutAngle(x, y: single; orientationTenthDegCCW: integer; sUTF8: string; texture: IBGRAScanner; align: TAlignment); overload; override;
729
730 procedure TextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single); overload; override;
731 procedure TextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single); overload; override;
732
733 procedure TextMultiline(ALeft,ATop,AWidth: single; sUTF8: string; c: TBGRAPixel; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; override;
734 procedure TextMultiline(ALeft,ATop,AWidth: single; sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment = btaNatural; AVertAlign: TTextLayout = tlTop; AParagraphSpacing: single = 0); overload; override;
735
736 { Draw the UTF8 encoded string at the coordinate (x,y), clipped inside the rectangle ARect.
737 Additional style information is provided by the style parameter.
738 The color c or texture is used to fill the text. No rotation is applied. }
739 procedure TextRect(ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; c: TBGRAPixel); overload; override;
740 procedure TextRect(ARect: TRect; x, y: integer; sUTF8: string; style: TTextStyle; texture: IBGRAScanner); overload; override;
741
742 { Returns the total size of the string provided using the current font.
743 Orientation is not taken into account, so that the width is along the text. End of lines are stripped from the string. }
744 function TextSize(sUTF8: string): TSize; override;
745
746 { Returns the affine box of the string provided using the current font.
747 Orientation is taken into account. End of lines are stripped from the string. }
748 function TextAffineBox(sUTF8: string): TAffineBox; override;
749
750 { Returns the total size of a paragraph i.e. with word break }
751 function TextSize(sUTF8: string; AMaxWidth: integer): TSize; override;
752 function TextSize(sUTF8: string; AMaxWidth: integer; ARightToLeft: boolean): TSize; override;
753 function TextFitInfo(sUTF8: string; AMaxWidth: integer): integer; override;
754
755 {Spline}
756 function ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override;
757 function ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF; override;
758
759 function ComputeBezierCurve(const ACurve: TCubicBezierCurve): ArrayOfTPointF; overload; override;
760 function ComputeBezierCurve(const ACurve: TQuadraticBezierCurve): ArrayOfTPointF; overload; override;
761 function ComputeBezierSpline(const ASpline: array of TCubicBezierCurve): ArrayOfTPointF; overload; override;
762 function ComputeBezierSpline(const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF; overload; override;
763
764 function ComputeWidePolyline(const points: array of TPointF; w: single): ArrayOfTPointF; overload; override;
765 function ComputeWidePolyline(const points: array of TPointF; w: single; ClosedCap: boolean): ArrayOfTPointF; overload; override;
766 function ComputeWidePolygon(const points: array of TPointF; w: single): ArrayOfTPointF; overload; override;
767
768 function ComputeEllipseContour(x,y,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; override;
769 function ComputeEllipseContour(AOrigin, AXAxis, AYAxis: TPointF; quality: single = 1): ArrayOfTPointF; overload; override;
770 function ComputeEllipseBorder(x,y,rx,ry,w: single; quality: single = 1): ArrayOfTPointF; overload; override;
771 function ComputeEllipseBorder(AOrigin, AXAxis, AYAxis: TPointF; w: single; quality: single = 1): ArrayOfTPointF; override; overload;
772 function ComputeArc65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; override;
773 function ComputeArcRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; override;
774 function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; quality: single = 1): ArrayOfTPointF; overload; override;
775 function ComputeRoundRect(x1,y1,x2,y2,rx,ry: single; options: TRoundRectangleOptions; quality: single = 1): ArrayOfTPointF; overload; override;
776 function ComputePie65536(x,y,rx,ry: single; start65536,end65536: word; quality: single = 1): ArrayOfTPointF; override;
777 function ComputePieRad(x,y,rx,ry: single; startRad,endRad: single; quality: single = 1): ArrayOfTPointF; override;
778
779 {Filling}
780 procedure NoClip; override;
781 procedure Fill(texture: IBGRAScanner; mode: TDrawMode); overload; override;
782 procedure Fill(texture: IBGRAScanner); overload; override;
783 procedure Fill(c: TBGRAPixel; start, Count: integer); overload; override;
784 procedure DrawPixels(c: TBGRAPixel; start, Count: integer); override;
785 procedure AlphaFill(alpha: byte; start, Count: integer); override;
786 procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ADrawMode: TDrawMode); override;
787 procedure FillMask(x,y: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte = 255); override;
788 procedure EraseMask(x,y: integer; AMask: TBGRACustomBitmap; alpha: byte=255); override;
789 procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean = true); override;
790 procedure FillClearTypeMask(x,y: integer; xThird: integer; AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean = true); override;
791 procedure ReplaceColor(before, after: TColor); override;
792 procedure ReplaceColor(before, after: TBGRAPixel); override;
793 procedure ReplaceColor(ABounds: TRect; before, after: TColor); override;
794 procedure ReplaceColor(ABounds: TRect; before, after: TBGRAPixel); override;
795 procedure ReplaceTransparent(after: TBGRAPixel); override;
796 procedure ReplaceTransparent(ABounds: TRect; after: TBGRAPixel); override;
797 procedure ParallelFloodFill(X, Y: integer; Dest: TBGRACustomBitmap; Color: TBGRAPixel;
798 mode: TFloodfillMode; Tolerance: byte = 0); override;
799 procedure GradientFill(x, y, x2, y2: integer; c1, c2: TBGRAPixel;
800 gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
801 gammaColorCorrection: boolean = True; Sinus: Boolean=False;
802 ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); override;
803 procedure GradientFill(x, y, x2, y2: integer; gradient: TBGRACustomGradient;
804 gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
805 Sinus: Boolean=False; ditherAlgo: TDitheringAlgorithm = daNearestNeighbor); override;
806 function CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
807 AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap; override;
808 function ScanAtInteger(X,Y: integer): TBGRAPixel; override;
809 procedure ScanMoveTo(X,Y: Integer); override;
810 function ScanNextPixel: TBGRAPixel; override;
811 function ScanAt(X,Y: Single): TBGRAPixel; override;
812 function IsScanPutPixelsDefined: boolean; override;
813 procedure ScanPutPixels(pdest: PBGRAPixel; count: integer; mode: TDrawMode); override;
814
815 {Canvas drawing functions}
816 procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); overload; override;
817 procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); overload; override;
818 procedure InvalidateBitmap; override; //call if you modify with Scanline
819 procedure LoadFromBitmapIfNeeded; override; //call to ensure that bitmap data is up to date
820
821 {BGRA bitmap functions}
822 procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency); overload; override;
823 procedure CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency); overload; override;
824 procedure PutImage(x, y: integer; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); overload; override;
825 procedure PutImageAffine(AMatrix: TAffineMatrix; Source: TBGRACustomBitmap; AOutputBounds: TRect; AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte=255); overload; override;
826 function GetImageAffineBounds(AMatrix: TAffineMatrix; ASourceBounds: TRect; AClipOutput: boolean = true): TRect; overload; override;
827 class function IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean; override;
828
829 procedure StretchPutImage(ARect: TRect; Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte = 255); override;
830
831 procedure BlendImage(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation); override;
832 procedure BlendImageOver(x, y: integer; Source: TBGRACustomBitmap; operation: TBlendOperation; AOpacity: byte = 255;
833 ALinearBlend: boolean = false); override;
834
835 function GetPart(ARect: TRect): TBGRACustomBitmap; override;
836 function GetPtrBitmap(Top,Bottom: Integer): TBGRACustomBitmap; override;
837 function Duplicate(DuplicateProperties: Boolean = False; DuplicateXorMask: Boolean = False) : TBGRACustomBitmap; override;
838 procedure CopyPropertiesTo(ABitmap: TBGRADefaultBitmap);
839 function Equals(comp: TBGRACustomBitmap): boolean; overload; override;
840 function Equals(comp: TBGRAPixel): boolean; overload; override;
841 function GetDifferenceBounds(ABitmap: TBGRACustomBitmap): TRect; override;
842 function MakeBitmapCopy(BackgroundColor: TColor): TBitmap; override;
843
844 function Resample(newWidth, newHeight: integer;
845 mode: TResampleMode = rmFineResample): TBGRACustomBitmap; override;
846 procedure VerticalFlip(ARect: TRect); overload; override;
847 procedure HorizontalFlip(ARect: TRect); overload; override;
848 function RotateCW: TBGRACustomBitmap; override;
849 function RotateCCW: TBGRACustomBitmap; override;
850 procedure Negative; override;
851 procedure NegativeRect(ABounds: TRect); override;
852 procedure LinearNegative; override;
853 procedure LinearNegativeRect(ABounds: TRect); override;
854 procedure InplaceGrayscale(AGammaCorrection: boolean = true); overload; override;
855 procedure InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true); overload; override;
856 procedure InplaceNormalize(AEachChannel: boolean = True); overload; override;
857 procedure InplaceNormalize(ABounds: TRect; AEachChannel: boolean = True); overload; override;
858 procedure SwapRedBlue; override;
859 procedure SwapRedBlue(ARect: TRect); override;
860 procedure GrayscaleToAlpha; override;
861 procedure AlphaToGrayscale; override;
862 procedure ApplyMask(mask: TBGRACustomBitmap; ARect: TRect; AMaskRectTopLeft: TPoint); overload; override;
863 function GetMaskFromAlpha: TBGRACustomBitmap; override;
864 procedure ApplyGlobalOpacity(alpha: byte); override;
865 procedure ApplyGlobalOpacity(ABounds: TRect; alpha: byte); override;
866 procedure ConvertToLinearRGB; override;
867 procedure ConvertFromLinearRGB; override;
868 procedure DrawCheckers(ARect: TRect; AColorEven,AColorOdd: TBGRAPixel); override;
869
870 {Filters}
871 function FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap; override;
872 function FilterMedian(Option: TMedianOption): TBGRACustomBitmap; override;
873 function FilterSmooth: TBGRACustomBitmap; override;
874 function FilterSharpen(Amount: single = 1): TBGRACustomBitmap; overload; override;
875 function FilterSharpen(ABounds: TRect; Amount: single = 1): TBGRACustomBitmap; overload; override;
876 function FilterContour: TBGRACustomBitmap; override;
877 function FilterPixelate(pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; override;
878 function FilterBlurRadial(radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override;
879 function FilterBlurRadial(ABounds: TRect; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override;
880 function FilterBlurRadial(radiusX, radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override;
881 function FilterBlurRadial(ABounds: TRect; radiusX, radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload; override;
882 function FilterBlurMotion(distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; overload; override;
883 function FilterBlurMotion(ABounds: TRect; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap; overload; override;
884 function FilterCustomBlur(mask: TBGRACustomBitmap): TBGRACustomBitmap; overload; override;
885 function FilterCustomBlur(ABounds: TRect; mask: TBGRACustomBitmap): TBGRACustomBitmap; overload; override;
886 function FilterEmboss(angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload; override;
887 function FilterEmboss(angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload; override;
888 function FilterEmbossHighlight(FillSelection: boolean): TBGRACustomBitmap; overload; override;
889 function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel): TBGRACustomBitmap; overload; override;
890 function FilterEmbossHighlight(FillSelection: boolean; BorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; overload; override;
891 function FilterGrayscale: TBGRACustomBitmap; overload; override;
892 function FilterGrayscale(ABounds: TRect): TBGRACustomBitmap; overload; override;
893 function FilterNormalize(eachChannel: boolean = True): TBGRACustomBitmap; overload; override;
894 function FilterNormalize(ABounds: TRect; eachChannel: boolean = True): TBGRACustomBitmap; overload; override;
895 function FilterRotate(origin: TPointF; angle: single; correctBlur: boolean = false): TBGRACustomBitmap; override;
896 function FilterAffine(AMatrix: TAffineMatrix; correctBlur: boolean = false): TBGRACustomBitmap; override;
897 function FilterSphere: TBGRACustomBitmap; override;
898 function FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload; override;
899 function FilterTwirl(ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload; override;
900 function FilterCylinder: TBGRACustomBitmap; override;
901 function FilterPlane: TBGRACustomBitmap; override;
902 end;
903
904 { TBGRAPtrBitmap }
905
906 TBGRAPtrBitmap = class(TBGRADefaultBitmap)
907 protected
908 function GetLineOrder: TRawImageLineOrder; override;
909 procedure SetLineOrder(AValue: TRawImageLineOrder); override;
910 procedure ReallocData; override;
911 procedure FreeData; override;
912 procedure CannotResize;
913 procedure NotImplemented;
914 procedure RebuildBitmap; override;
915
916 function CreateDefaultFontRenderer: TBGRACustomFontRenderer; override; //to override
917 function LoadFromRawImage({%H-}ARawImage: TRawImage; {%H-}DefaultOpacity: byte;
918 {%H-}AlwaysReplaceAlpha: boolean=False; {%H-}RaiseErrorOnInvalidPixelFormat: boolean
919 =True): boolean; override; //to override
920 public
921 constructor Create(AWidth, AHeight: integer; AData: Pointer); overload;
922 function Duplicate(DuplicateProperties: Boolean = False; DuplicateXorMask: Boolean = False): TBGRACustomBitmap; override;
923 procedure SetDataPtr(AData: Pointer);
924 property LineOrder: TRawImageLineOrder Read GetLineOrder Write SetLineOrder;
925
926 procedure DataDrawTransparent({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer;
927 {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; //to override
928 procedure DataDrawOpaque({%H-}ACanvas: TCanvas; {%H-}Rect: TRect; {%H-}AData: Pointer;
929 {%H-}ALineOrder: TRawImageLineOrder; {%H-}AWidth, {%H-}AHeight: integer); override; //to override
930 procedure GetImageFromCanvas({%H-}CanvasSource: TCanvas; {%H-}x, {%H-}y: integer); override; //to override
931
932 procedure Assign({%H-}Source: TPersistent); override;
933 procedure TakeScreenshot({%H-}ARect: TRect); override;
934 procedure TakeScreenshotOfPrimaryMonitor; override;
935 procedure LoadFromDevice({%H-}DC: HDC); override;
936 procedure LoadFromDevice({%H-}DC: HDC; {%H-}ARect: TRect); override;
937 end;
938
939var
940 DefaultTextStyle: TTextStyle;
941
942procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer;
943 c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
944 gammaColorCorrection: boolean = True; Sinus: Boolean=False);
945
946type
947
948 { TBitmapTracker }
949
950 TBitmapTracker = class(TBitmap)
951 protected
952 FUser: TBGRADefaultBitmap;
953 procedure Changed(Sender: TObject); override;
954 public
955 constructor Create(AUser: TBGRADefaultBitmap); overload;
956 end;
957
958implementation
959
960uses Math, BGRAUTF8, BGRABlend, BGRAFilters, BGRAGradientScanner,
961 BGRAResample, BGRAPolygon, BGRAPolygonAliased,
962 BGRAPath, FPReadPcx, FPWritePcx, FPReadXPM, FPWriteXPM,
963 BGRAReadBMP, BGRAReadJpeg,
964 BGRADithering, BGRAFilterScanner;
965
966{ TBitmapTracker }
967
968constructor TBitmapTracker.Create(AUser: TBGRADefaultBitmap);
969begin
970 FUser := AUser;
971 inherited Create;
972end;
973
974procedure TBitmapTracker.Changed(Sender: TObject);
975begin
976 if FUser <> nil then
977 begin
978 FUser.FBitmapModified := True;
979 FUser.FAlphaCorrectionNeeded := true;
980 end;
981 inherited Changed(Sender);
982end;
983
984{ TBGRADefaultBitmap }
985
986function TBGRADefaultBitmap.CheckEmpty: boolean;
987const
988 alphaMask = $ff shl TBGRAPixel_AlphaShift;
989var
990 i: integer;
991 p: PBGRAPixel;
992begin
993 p := Data;
994 for i := (NbPixels shr 1) - 1 downto 0 do
995 begin
996 if PInt64(p)^ and (alphaMask or (alphaMask shl 32)) <> 0 then
997 begin
998 Result := False;
999 exit;
1000 end;
1001 Inc(p,2);
1002 end;
1003 if Odd(NbPixels) and (p^.alpha <> 0) then
1004 begin
1005 Result := false;
1006 exit;
1007 end;
1008 Result := True;
1009end;
1010
1011function TBGRADefaultBitmap.CheckIsZero: boolean;
1012var
1013 i: integer;
1014 p: PBGRAPixel;
1015begin
1016 p := Data;
1017 for i := (NbPixels shr 1) - 1 downto 0 do
1018 begin
1019 if PInt64(p)^ <> 0 then
1020 begin
1021 Result := False;
1022 exit;
1023 end;
1024 Inc(p,2);
1025 end;
1026 if Odd(NbPixels) and (PDWord(p)^ <> 0) then
1027 begin
1028 Result := false;
1029 exit;
1030 end;
1031 Result := True;
1032end;
1033
1034function TBGRADefaultBitmap.GetCanvasAlphaCorrection: boolean;
1035begin
1036 Result := (FCanvasOpacity <> 0);
1037end;
1038
1039function TBGRADefaultBitmap.GetCustomPenStyle: TBGRAPenStyle;
1040begin
1041 result := DuplicatePenStyle(FPenStroker.CustomPenStyle);
1042end;
1043
1044procedure TBGRADefaultBitmap.SetCanvasAlphaCorrection(const AValue: boolean);
1045begin
1046 if AValue then
1047 begin
1048 if FCanvasOpacity = 0 then
1049 FCanvasOpacity := 255;
1050 end
1051 else
1052 FCanvasOpacity := 0;
1053end;
1054
1055procedure TBGRADefaultBitmap.DoLoadFromBitmap;
1056begin
1057 //nothing
1058end;
1059
1060procedure TBGRADefaultBitmap.SetCanvasDrawModeFP(const AValue: TDrawMode);
1061begin
1062 FCanvasDrawModeFP := AValue;
1063 Case AValue of
1064 dmLinearBlend: FCanvasPixelProcFP := @FastBlendPixel;
1065 dmDrawWithTransparency: FCanvasPixelProcFP := @DrawPixel;
1066 dmXor: FCanvasPixelProcFP:= @XorPixel;
1067 else FCanvasPixelProcFP := @SetPixel;
1068 end;
1069end;
1070
1071function TBGRADefaultBitmap.GetCanvasDrawModeFP: TDrawMode;
1072begin
1073 Result:= FCanvasDrawModeFP;
1074end;
1075
1076procedure TBGRADefaultBitmap.SetCustomPenStyle(const AValue: TBGRAPenStyle);
1077begin
1078 FPenStroker.CustomPenStyle := DuplicatePenStyle(AValue);
1079end;
1080
1081procedure TBGRADefaultBitmap.SetPenStyle(const AValue: TPenStyle);
1082begin
1083 FPenStroker.Style := AValue;
1084end;
1085
1086function TBGRADefaultBitmap.GetPenStyle: TPenStyle;
1087begin
1088 Result:= FPenStroker.Style;
1089end;
1090
1091function TBGRADefaultBitmap.GetLineCap: TPenEndCap;
1092begin
1093 result := FPenStroker.LineCap;
1094end;
1095
1096procedure TBGRADefaultBitmap.SetLineCap(AValue: TPenEndCap);
1097begin
1098 if AValue <> FPenStroker.LineCap then
1099 begin
1100 FPenStroker.LineCap := AValue;
1101 if Assigned(FPenStroker.Arrow) then
1102 FPenStroker.Arrow.LineCap := AValue;
1103 end;
1104end;
1105
1106function TBGRADefaultBitmap.GetPenStroker: TBGRACustomPenStroker;
1107begin
1108 result := FPenStroker;
1109end;
1110
1111function TBGRADefaultBitmap.GetArrowEndSize: TPointF;
1112begin
1113 result := GetArrow.EndSize;
1114end;
1115
1116function TBGRADefaultBitmap.GetArrowStartSize: TPointF;
1117begin
1118 result := GetArrow.StartSize;
1119end;
1120
1121procedure TBGRADefaultBitmap.SetArrowEndSize(AValue: TPointF);
1122begin
1123 {$PUSH}{$OPTIMIZATION OFF}
1124 GetArrow.EndSize := AValue;
1125 {$POP}
1126end;
1127
1128procedure TBGRADefaultBitmap.SetArrowStartSize(AValue: TPointF);
1129begin
1130 {$PUSH}{$OPTIMIZATION OFF}
1131 GetArrow.StartSize := AValue;
1132 {$POP}
1133end;
1134
1135function TBGRADefaultBitmap.GetArrowEndOffset: single;
1136begin
1137 result := GetArrow.EndOffsetX;
1138end;
1139
1140function TBGRADefaultBitmap.GetArrowStartOffset: single;
1141begin
1142 result := GetArrow.StartOffsetX;
1143end;
1144
1145procedure TBGRADefaultBitmap.SetArrowEndOffset(AValue: single);
1146begin
1147 GetArrow.EndOffsetX := AValue;
1148end;
1149
1150procedure TBGRADefaultBitmap.SetArrowStartOffset(AValue: single);
1151begin
1152 GetArrow.StartOffsetX := AValue;
1153end;
1154
1155function TBGRADefaultBitmap.GetArrowEndRepeat: integer;
1156begin
1157 result := GetArrow.EndRepeatCount;
1158end;
1159
1160function TBGRADefaultBitmap.GetArrowStartRepeat: integer;
1161begin
1162 result := GetArrow.StartRepeatCount;
1163end;
1164
1165procedure TBGRADefaultBitmap.SetArrowEndRepeat(AValue: integer);
1166begin
1167 GetArrow.EndRepeatCount := AValue;
1168end;
1169
1170procedure TBGRADefaultBitmap.SetArrowStartRepeat(AValue: integer);
1171begin
1172 GetArrow.StartRepeatCount := AValue;
1173end;
1174
1175procedure TBGRADefaultBitmap.SetFontHeight(AHeight: integer);
1176begin
1177 FFontHeight := AHeight;
1178end;
1179
1180function TBGRADefaultBitmap.GetFontFullHeight: integer;
1181begin
1182 if FontHeight < 0 then
1183 result := -FontHeight
1184 else
1185 result := TextSize('Hg').cy;
1186end;
1187
1188procedure TBGRADefaultBitmap.SetFontFullHeight(AHeight: integer);
1189begin
1190 if AHeight > 0 then
1191 FontHeight := -AHeight
1192 else
1193 FontHeight := 1;
1194end;
1195
1196function TBGRADefaultBitmap.GetFontPixelMetric: TFontPixelMetric;
1197begin
1198 result := FontRenderer.GetFontPixelMetric;
1199end;
1200
1201function TBGRADefaultBitmap.GetFontRenderer: TBGRACustomFontRenderer;
1202begin
1203 if FFontRenderer = nil then FFontRenderer := CreateDefaultFontRenderer;
1204 if FFontRenderer = nil then raise exception.Create('No font renderer');
1205 result := FFontRenderer;
1206 result.FontName := FontName;
1207 result.FontStyle := FontStyle;
1208 result.FontQuality := FontQuality;
1209 result.FontOrientation := FontOrientation;
1210 result.FontEmHeight := FFontHeight;
1211end;
1212
1213procedure TBGRADefaultBitmap.SetFontRenderer(AValue: TBGRACustomFontRenderer);
1214begin
1215 if AValue = FFontRenderer then exit;
1216 FFontRenderer.Free;
1217 FFontRenderer := AValue
1218end;
1219
1220function TBGRADefaultBitmap.GetFontVerticalAnchorOffset: single;
1221begin
1222 case FontVerticalAnchor of
1223 fvaTop: result := 0;
1224 fvaCenter: result := FontFullHeight*0.5;
1225 fvaCapLine: result := FontPixelMetric.CapLine;
1226 fvaCapCenter: result := (FontPixelMetric.CapLine+FontPixelMetric.Baseline)*0.5;
1227 fvaXLine: result := FontPixelMetric.xLine;
1228 fvaXCenter: result := (FontPixelMetric.xLine+FontPixelMetric.Baseline)*0.5;
1229 fvaBaseline: result := FontPixelMetric.Baseline;
1230 fvaDescentLine: result := FontPixelMetric.DescentLine;
1231 fvaBottom: result := FontFullHeight;
1232 else
1233 result := 0;
1234 end;
1235end;
1236
1237function TBGRADefaultBitmap.GetFontAnchorRotatedOffset: TPointF;
1238begin
1239 result := GetFontAnchorRotatedOffset(FontOrientation);
1240end;
1241
1242function TBGRADefaultBitmap.GetFontAnchorRotatedOffset(
1243 ACustomOrientation: integer): TPointF;
1244begin
1245 result := PointF(0, GetFontVerticalAnchorOffset);
1246 if ACustomOrientation <> 0 then
1247 result := AffineMatrixRotationDeg(-ACustomOrientation*0.1)*result;
1248end;
1249
1250{ Get scanline without checking bounds nor updated from TBitmap }
1251function TBGRADefaultBitmap.GetScanlineFast(y: integer): PBGRAPixel; inline;
1252begin
1253 Result := FData;
1254 if FLineOrder = riloBottomToTop then
1255 y := FHeight - 1 - y;
1256 Inc(Result, FWidth * y);
1257end;
1258
1259function TBGRADefaultBitmap.GetScanLine(y: integer): PBGRAPixel;
1260begin
1261 if (y < 0) or (y >= Height) then
1262 raise ERangeError.Create('Scanline: out of bounds')
1263 else
1264 begin
1265 LoadFromBitmapIfNeeded;
1266 Result := GetScanLineFast(y);
1267 end;
1268end;
1269
1270{------------------------- Reference counter functions ------------------------}
1271{ These functions are not related to reference counting for interfaces :
1272 a reference must be explicitely freed with FreeReference }
1273
1274{ Add a new reference and gives a pointer to it }
1275function TBGRADefaultBitmap.NewReference: TBGRACustomBitmap;
1276begin
1277 if self <> nil then Inc(FRefCount);
1278 Result := self;
1279end;
1280
1281{ Free the current reference, and free the bitmap if necessary }
1282procedure TBGRADefaultBitmap.FreeReference;
1283begin
1284 if self = nil then
1285 exit;
1286
1287 if FRefCount > 0 then
1288 begin
1289 Dec(FRefCount);
1290 if FRefCount = 0 then
1291 begin
1292 self.Destroy;
1293 end;
1294 end;
1295end;
1296
1297{ Make sure there is only one copy of the bitmap and return
1298 the new pointer for it. If the bitmap is already unique,
1299 then it does nothing }
1300function TBGRADefaultBitmap.GetUnique: TBGRACustomBitmap;
1301begin
1302 if FRefCount > 1 then
1303 begin
1304 Dec(FRefCount);
1305 Result := self.Duplicate;
1306 end
1307 else
1308 Result := self;
1309end;
1310
1311procedure TBGRADefaultBitmap.NeedXorMask;
1312begin
1313 if FXorMask = nil then
1314 FXorMask := BGRABitmapFactory.Create(Width,Height);
1315end;
1316
1317procedure TBGRADefaultBitmap.DiscardXorMask;
1318begin
1319 if Assigned(FXorMask) then
1320 begin
1321 if FXorMask is TBGRADefaultBitmap then
1322 begin
1323 TBGRADefaultBitmap(FXorMask).FreeReference;
1324 FXorMask := nil;
1325 end else
1326 FreeAndNil(FXorMask);
1327 end;
1328end;
1329
1330{ Creates a new bitmap with dimensions AWidth and AHeight and filled with
1331 transparent pixels. Internally, it uses the same type so that if you
1332 use an optimized version, you get a new bitmap with the same optimizations }
1333function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer): TBGRACustomBitmap;
1334var
1335 BGRAClass: TBGRABitmapAny;
1336begin
1337 BGRAClass := TBGRABitmapAny(self.ClassType);
1338 if BGRAClass = TBGRAPtrBitmap then
1339 BGRAClass := TBGRADefaultBitmap;
1340 Result := BGRAClass.Create(AWidth, AHeight);
1341end;
1342
1343{ Can only be called from an existing instance of TBGRABitmap.
1344 Creates a new instance with dimensions AWidth and AHeight,
1345 and fills it with Color. }
1346function TBGRADefaultBitmap.NewBitmap(AWidth, AHeight: integer;
1347 Color: TBGRAPixel): TBGRACustomBitmap;
1348var
1349 BGRAClass: TBGRABitmapAny;
1350begin
1351 BGRAClass := TBGRABitmapAny(self.ClassType);
1352 if BGRAClass = TBGRAPtrBitmap then
1353 BGRAClass := TBGRADefaultBitmap;
1354 Result := BGRAClass.Create(AWidth, AHeight, Color);
1355end;
1356
1357{ Creates a new bitmap and loads it contents from a file.
1358 The encoding of the string is the default one for the operating system.
1359 It is recommended to use the next function and UTF8 encoding }
1360function TBGRADefaultBitmap.NewBitmap(Filename: string): TBGRACustomBitmap;
1361var
1362 BGRAClass: TBGRABitmapAny;
1363begin
1364 BGRAClass := TBGRABitmapAny(self.ClassType);
1365 Result := BGRAClass.Create(Filename);
1366end;
1367
1368{ Creates a new bitmap and loads it contents from a file.
1369 It is recommended to use UTF8 encoding }
1370function TBGRADefaultBitmap.NewBitmap(Filename: string; AIsUtf8: boolean): TBGRACustomBitmap;
1371var
1372 BGRAClass: TBGRABitmapAny;
1373begin
1374 BGRAClass := TBGRABitmapAny(self.ClassType);
1375 Result := BGRAClass.Create(Filename,AIsUtf8);
1376end;
1377
1378function TBGRADefaultBitmap.NewBitmap(Filename: string; AIsUtf8: boolean;
1379 AOptions: TBGRALoadingOptions): TBGRACustomBitmap;
1380var
1381 BGRAClass: TBGRABitmapAny;
1382begin
1383 BGRAClass := TBGRABitmapAny(self.ClassType);
1384 Result := BGRAClass.Create(Filename,AIsUtf8,AOptions);
1385end;
1386
1387function TBGRADefaultBitmap.NewBitmap(AFPImage: TFPCustomImage): TBGRACustomBitmap;
1388var
1389 BGRAClass: TBGRABitmapAny;
1390begin
1391 BGRAClass := TBGRABitmapAny(self.ClassType);
1392 Result := BGRAClass.Create(AFPImage);
1393end;
1394
1395procedure TBGRADefaultBitmap.LoadFromStream(Str: TStream;
1396 Handler: TFPCustomImageReader; AOptions: TBGRALoadingOptions);
1397var OldBmpOption: TBMPTransparencyOption;
1398 OldJpegPerf: TJPEGReadPerformance;
1399begin
1400 DiscardXorMask;
1401 if (loBmpAutoOpaque in AOptions) and (Handler is TBGRAReaderBMP) then
1402 begin
1403 OldBmpOption := TBGRAReaderBMP(Handler).TransparencyOption;
1404 TBGRAReaderBMP(Handler).TransparencyOption := toAuto;
1405 inherited LoadFromStream(Str, Handler, AOptions);
1406 TBGRAReaderBMP(Handler).TransparencyOption := OldBmpOption;
1407 end else
1408 if (loJpegQuick in AOptions) and (Handler is TBGRAReaderJpeg) then
1409 begin
1410 OldJpegPerf := TBGRAReaderJpeg(Handler).Performance;
1411 TBGRAReaderJpeg(Handler).Performance := jpBestSpeed;
1412 inherited LoadFromStream(Str, Handler, AOptions);
1413 TBGRAReaderJpeg(Handler).Performance := OldJpegPerf;
1414 end else
1415 inherited LoadFromStream(Str, Handler, AOptions);
1416end;
1417
1418procedure TBGRADefaultBitmap.LoadFromResource(AFilename: string;
1419 AOptions: TBGRALoadingOptions);
1420var
1421 stream: TStream;
1422 format: TBGRAImageFormat;
1423 reader: TFPCustomImageReader;
1424 magic: array[1..2] of char;
1425 startPos: Int64;
1426 ext: String;
1427begin
1428 stream := BGRAResource.GetResourceStream(AFilename);
1429 try
1430 ext := Uppercase(ExtractFileExt(AFilename));
1431 if (ext = '.BMP') and BGRAResource.IsWinResource(AFilename) then
1432 begin
1433 reader := TBGRAReaderBMP.Create;
1434 TBGRAReaderBMP(reader).Subformat := bsfHeaderless;
1435 end else
1436 begin
1437 format := DetectFileFormat(stream, ext);
1438 reader := CreateBGRAImageReader(format);
1439 end;
1440 try
1441 LoadFromStream(stream, reader, AOptions);
1442 finally
1443 reader.Free;
1444 end;
1445 finally
1446 stream.Free;
1447 end;
1448end;
1449
1450{----------------------- TFPCustomImage override ------------------------------}
1451
1452{ Creates a new bitmap, initialize properties and bitmap data }
1453constructor TBGRADefaultBitmap.Create(AWidth, AHeight: integer);
1454begin
1455 Init;
1456 inherited Create(AWidth, AHeight);
1457 if FData <> nil then
1458 FillTransparent;
1459end;
1460
1461{ Set the size of the current bitmap. All data is lost during the process }
1462procedure TBGRADefaultBitmap.SetSize(AWidth, AHeight: integer);
1463begin
1464 if (AWidth = Width) and (AHeight = Height) then
1465 exit;
1466 inherited SetSize(AWidth, AHeight);
1467 if AWidth < 0 then
1468 AWidth := 0;
1469 if AHeight < 0 then
1470 AHeight := 0;
1471 FWidth := AWidth;
1472 FHeight := AHeight;
1473 FScanWidth := FWidth;
1474 FScanHeight:= FHeight;
1475 FNbPixels := AWidth * AHeight;
1476 if FNbPixels < 0 then // 2 Go limit
1477 raise EOutOfMemory.Create('Image too big');
1478 FreeBitmap;
1479 ReallocData;
1480 NoClip;
1481 DiscardXorMask;
1482end;
1483
1484{---------------------- Constructors ---------------------------------}
1485
1486{ Creates an image of width and height equal to zero. }
1487constructor TBGRADefaultBitmap.Create;
1488begin
1489 Init;
1490 inherited Create(0, 0);
1491end;
1492
1493constructor TBGRADefaultBitmap.Create(AFPImage: TFPCustomImage);
1494begin
1495 Init;
1496 inherited Create(AFPImage.Width, AFPImage.Height);
1497 Assign(AFPImage);
1498end;
1499
1500{ Creates an image of dimensions AWidth and AHeight and filled with transparent pixels. }
1501constructor TBGRADefaultBitmap.Create(ABitmap: TBitmap; AUseTransparent: boolean);
1502begin
1503 Init;
1504 inherited Create(ABitmap.Width, ABitmap.Height);
1505 Assign(ABitmap, AUseTransparent);
1506end;
1507
1508{ Creates an image of dimensions AWidth and AHeight and fills it with the opaque color Color. }
1509constructor TBGRADefaultBitmap.Create(AWidth, AHeight: integer; Color: TColor);
1510begin
1511 Init;
1512 inherited Create(AWidth, AHeight);
1513 Fill(Color);
1514end;
1515
1516{ Creates an image of dimensions AWidth and AHeight and fills it with Color. }
1517constructor TBGRADefaultBitmap.Create(AWidth, AHeight: integer; Color: TBGRAPixel);
1518begin
1519 Init;
1520 inherited Create(AWidth, AHeight);
1521 Fill(Color);
1522end;
1523
1524{ Creates an image by loading its content from the file AFilename.
1525 The encoding of the string is the default one for the operating system.
1526 It is recommended to use the next constructor and UTF8 encoding. }
1527constructor TBGRADefaultBitmap.Create(AFilename: string);
1528begin
1529 Init;
1530 inherited Create(0, 0);
1531 LoadFromFile(Afilename);
1532end;
1533
1534{ Free the object and all its resources }
1535destructor TBGRADefaultBitmap.Destroy;
1536begin
1537 DiscardXorMask;
1538 FPenStroker.Free;
1539 FFontRenderer.Free;
1540 FCanvasFP.Free;
1541 FCanvasBGRA.Free;
1542 FCanvas2D.Free;
1543 FreeData;
1544 FreeBitmap;
1545 inherited Destroy;
1546end;
1547
1548{------------------------- Loading functions ----------------------------------}
1549
1550{ Creates an image by loading its content from the file AFilename.
1551 The boolean AIsUtf8Filename specifies if UTF8 encoding is assumed for the filename. }
1552constructor TBGRADefaultBitmap.Create(AFilename: string; AIsUtf8: boolean);
1553begin
1554 Init;
1555 inherited Create(0, 0);
1556 if AIsUtf8 then
1557 LoadFromFileUTF8(Afilename)
1558 else
1559 LoadFromFile(Afilename);
1560end;
1561
1562constructor TBGRADefaultBitmap.Create(AFilename: string; AIsUtf8: boolean;
1563 AOptions: TBGRALoadingOptions);
1564begin
1565 Init;
1566 inherited Create(0, 0);
1567 if AIsUtf8 then
1568 LoadFromFileUTF8(Afilename, AOptions)
1569 else
1570 LoadFromFile(Afilename, AOptions);
1571end;
1572
1573{ Creates an image by loading its content from the stream AStream. }
1574constructor TBGRADefaultBitmap.Create(AStream: TStream);
1575begin
1576 Init;
1577 inherited Create(0, 0);
1578 LoadFromStream(AStream);
1579end;
1580
1581procedure TBGRADefaultBitmap.Serialize(AStream: TStream);
1582var lWidth,lHeight,y: integer;
1583begin
1584 lWidth := NtoLE(Width);
1585 lHeight := NtoLE(Height);
1586 AStream.Write(lWidth,sizeof(lWidth));
1587 AStream.Write(lHeight,sizeof(lHeight));
1588 If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(FData,FData,FNbPixels,False);
1589 for y := 0 to Height-1 do
1590 AStream.Write(ScanLine[y]^, Width*sizeof(TBGRAPixel));
1591 If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(FData,FData,FNbPixels,False);
1592end;
1593
1594procedure TBGRADefaultBitmap.Deserialize(AStream: TStream);
1595var lWidth,lHeight,y: integer;
1596begin
1597 AStream.Read({%H-}lWidth,sizeof(lWidth));
1598 AStream.Read({%H-}lHeight,sizeof(lHeight));
1599 lWidth := LEtoN(lWidth);
1600 lHeight := LEtoN(lHeight);
1601 SetSize(lWidth,lHeight);
1602 for y := 0 to Height-1 do
1603 AStream.Read(ScanLine[y]^, Width*sizeof(TBGRAPixel));
1604 If TBGRAPixel_RGBAOrder then TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(FData,FData,FNbPixels,False);
1605 InvalidateBitmap;
1606end;
1607
1608class procedure TBGRADefaultBitmap.SerializeEmpty(AStream: TStream);
1609var zero: integer;
1610begin
1611 zero := 0;
1612 AStream.Write(zero,sizeof(zero));
1613 AStream.Write(zero,sizeof(zero));
1614end;
1615
1616procedure TBGRADefaultBitmap.Assign(Source: TPersistent);
1617var pdest: PBGRAPixel;
1618 x,y: NativeInt;
1619begin
1620 if Source is TBGRACustomBitmap then
1621 begin
1622 DiscardBitmapChange;
1623 SetSize(TBGRACustomBitmap(Source).Width, TBGRACustomBitmap(Source).Height);
1624 PutImage(0, 0, TBGRACustomBitmap(Source), dmSet);
1625 if Source is TBGRADefaultBitmap then
1626 begin
1627 HotSpot := TBGRADefaultBitmap(Source).HotSpot;
1628 if XorMask <> TBGRADefaultBitmap(Source).XorMask then
1629 begin
1630 DiscardXorMask;
1631 if TBGRADefaultBitmap(Source).XorMask is TBGRADefaultBitmap then
1632 FXorMask := TBGRADefaultBitmap(TBGRADefaultBitmap(Source).XorMask).NewReference as TBGRADefaultBitmap
1633 else
1634 FXorMask := TBGRADefaultBitmap(Source).XorMask.Duplicate;
1635 end;
1636 end;
1637 end else
1638 if Source is TFPCustomImage then
1639 begin
1640 DiscardBitmapChange;
1641 SetSize(TFPCustomImage(Source).Width, TFPCustomImage(Source).Height);
1642 for y := 0 to TFPCustomImage(Source).Height-1 do
1643 begin
1644 pdest := ScanLine[y];
1645 for x := 0 to TFPCustomImage(Source).Width-1 do
1646 begin
1647 pdest^ := FPColorToBGRA(TFPCustomImage(Source).Colors[x,y]);
1648 inc(pdest);
1649 end;
1650 end;
1651 end else
1652 inherited Assign(Source);
1653end;
1654
1655procedure TBGRADefaultBitmap.Assign(Source: TBitmap; AUseTransparent: boolean);
1656var
1657 transpColor: TBGRAPixel;
1658begin
1659 Assign(Source);
1660 if AUseTransparent and TBitmap(Source).Transparent then
1661 begin
1662 if TBitmap(Source).TransparentMode = tmFixed then
1663 transpColor := ColorToBGRA(TBitmap(Source).TransparentColor)
1664 else
1665 transpColor := GetPixel(0,Height-1);
1666 ReplaceColor(transpColor, BGRAPixelTransparent);
1667 end;
1668end;
1669
1670{------------------------- Clipping -------------------------------}
1671
1672{ Check if a point is in the clipping rectangle }
1673function TBGRADefaultBitmap.PtInClipRect(x, y: int32or64): boolean;
1674begin
1675 result := (x >= FClipRect.Left) and (y >= FClipRect.Top) and (x < FClipRect.Right) and (y < FClipRect.Bottom);
1676end;
1677
1678procedure TBGRADefaultBitmap.NoClip;
1679begin
1680 FClipRect := rect(0,0,FWidth,FHeight);
1681end;
1682
1683procedure TBGRADefaultBitmap.Fill(texture: IBGRAScanner; mode: TDrawMode);
1684begin
1685 FillRect(FClipRect.Left,FClipRect.Top,FClipRect.Right,FClipRect.Bottom,texture,mode);
1686end;
1687
1688function TBGRADefaultBitmap.GetClipRect: TRect;
1689begin
1690 Result:= FClipRect;
1691end;
1692
1693procedure TBGRADefaultBitmap.SetClipRect(const AValue: TRect);
1694begin
1695 IntersectRect(FClipRect,AValue,Rect(0,0,FWidth,FHeight));
1696end;
1697
1698function TBGRADefaultBitmap.InternalGetPixelCycle256(ix, iy: int32or64; iFactX,
1699 iFactY: int32or64): TBGRAPixel;
1700var
1701 ixMod2: int32or64;
1702 pUpLeft, pUpRight, pDownLeft, pDownRight: PBGRAPixel;
1703 scan: PBGRAPixel;
1704begin
1705 scan := GetScanlineFast(iy);
1706
1707 pUpLeft := (scan + ix);
1708 ixMod2 := ix+1;
1709 if ixMod2=Width then ixMod2 := 0;
1710 pUpRight := (scan + ixMod2);
1711
1712 Inc(iy);
1713 if iy = Height then iy := 0;
1714 scan := GetScanlineFast(iy);
1715 pDownLeft := (scan + ix);
1716 pDownRight := (scan + ixMod2);
1717
1718 InterpolateBilinear(pUpLeft, pUpRight, pDownLeft,
1719 pDownRight, iFactX, iFactY, @result);
1720end;
1721
1722function TBGRADefaultBitmap.InternalGetPixel256(ix, iy: int32or64; iFactX,
1723 iFactY: int32or64; smoothBorder: boolean): TBGRAPixel;
1724var
1725 pUpLeft, pUpRight, pDownLeft, pDownRight: PBGRAPixel;
1726 scan: PBGRAPixel;
1727begin
1728 if (iy >= 0) and (iy < Height) then
1729 begin
1730 scan := GetScanlineFast(iy);
1731
1732 if (ix >= 0) and (ix < Width) then
1733 pUpLeft := scan+ix
1734 else if smoothBorder then
1735 pUpLeft := @BGRAPixelTransparent
1736 else
1737 pUpLeft := nil;
1738
1739 if (ix+1 >= 0) and (ix+1 < Width) then
1740 pUpRight := scan+(ix+1)
1741 else if smoothBorder then
1742 pUpRight := @BGRAPixelTransparent
1743 else
1744 pUpRight := nil;
1745 end else
1746 if smoothBorder then
1747 begin
1748 pUpLeft := @BGRAPixelTransparent;
1749 pUpRight := @BGRAPixelTransparent;
1750 end else
1751 begin
1752 pUpLeft := nil;
1753 pUpRight := nil;
1754 end;
1755
1756 if (iy+1 >= 0) and (iy+1 < Height) then
1757 begin
1758 scan := GetScanlineFast(iy+1);
1759
1760 if (ix >= 0) and (ix < Width) then
1761 pDownLeft := scan+ix
1762 else if smoothBorder then
1763 pDownLeft := @BGRAPixelTransparent
1764 else
1765 pDownLeft := nil;
1766
1767 if (ix+1 >= 0) and (ix+1 < Width) then
1768 pDownRight := scan+(ix+1)
1769 else if smoothBorder then
1770 pDownRight := @BGRAPixelTransparent
1771 else
1772 pDownRight := nil;
1773 end else
1774 if smoothBorder then
1775 begin
1776 pDownLeft := @BGRAPixelTransparent;
1777 pDownRight := @BGRAPixelTransparent;
1778 end else
1779 begin
1780 pDownLeft := nil;
1781 pDownRight := nil;
1782 end;
1783
1784 InterpolateBilinear(pUpLeft, pUpRight, pDownLeft,
1785 pDownRight, iFactX, iFactY, @result);
1786end;
1787
1788function TBGRADefaultBitmap.GetArrow: TBGRAArrow;
1789begin
1790 if FPenStroker.Arrow = nil then
1791 begin
1792 FPenStroker.Arrow := TBGRAArrow.Create;
1793 FPenStroker.Arrow.LineCap := LineCap;
1794 FPenStroker.ArrowOwned := true;
1795 end;
1796 result := FPenStroker.Arrow as TBGRAArrow;
1797end;
1798
1799{-------------------------- Pixel functions -----------------------------------}
1800
1801procedure TBGRADefaultBitmap.SetPixel(x, y: int32or64; c: TBGRAPixel);
1802begin
1803 if not PtInClipRect(x,y) then exit;
1804 LoadFromBitmapIfNeeded;
1805 (GetScanlineFast(y) +x)^ := c;
1806 InvalidateBitmap;
1807end;
1808
1809procedure TBGRADefaultBitmap.XorPixel(x, y: int32or64; c: TBGRAPixel);
1810var
1811 p : PDWord;
1812begin
1813 if not PtInClipRect(x,y) then exit;
1814 LoadFromBitmapIfNeeded;
1815 p := PDWord(GetScanlineFast(y) +x);
1816 p^ := p^ xor DWord(c);
1817 InvalidateBitmap;
1818end;
1819
1820procedure TBGRADefaultBitmap.SetPixel(x, y: int32or64; c: TColor);
1821var
1822 p: PBGRAPixel;
1823begin
1824 if not PtInClipRect(x,y) then exit;
1825 LoadFromBitmapIfNeeded;
1826 p := GetScanlineFast(y) + x;
1827 RedGreenBlue(c, p^.red,p^.green,p^.blue);
1828 p^.alpha := 255;
1829 InvalidateBitmap;
1830end;
1831
1832procedure TBGRADefaultBitmap.DrawPixel(x, y: int32or64; c: TBGRAPixel);
1833begin
1834 if not PtInClipRect(x,y) then exit;
1835 LoadFromBitmapIfNeeded;
1836 DrawPixelInlineWithAlphaCheck(GetScanlineFast(y) + x, c);
1837 InvalidateBitmap;
1838end;
1839
1840procedure TBGRADefaultBitmap.DrawPixel(x, y: int32or64; ec: TExpandedPixel);
1841begin
1842 if not PtInClipRect(x,y) then exit;
1843 LoadFromBitmapIfNeeded;
1844 DrawExpandedPixelInlineWithAlphaCheck(GetScanlineFast(y) + x, ec);
1845 InvalidateBitmap;
1846end;
1847
1848procedure TBGRADefaultBitmap.FastBlendPixel(x, y: int32or64; c: TBGRAPixel);
1849begin
1850 if not PtInClipRect(x,y) then exit;
1851 LoadFromBitmapIfNeeded;
1852 FastBlendPixelInline(GetScanlineFast(y) + x, c);
1853 InvalidateBitmap;
1854end;
1855
1856procedure TBGRADefaultBitmap.ErasePixel(x, y: int32or64; alpha: byte);
1857begin
1858 if not PtInClipRect(x,y) then exit;
1859 LoadFromBitmapIfNeeded;
1860 ErasePixelInline(GetScanlineFast(y) + x, alpha);
1861 InvalidateBitmap;
1862end;
1863
1864procedure TBGRADefaultBitmap.AlphaPixel(x, y: int32or64; alpha: byte);
1865begin
1866 if not PtInClipRect(x,y) then exit;
1867 LoadFromBitmapIfNeeded;
1868 if alpha = 0 then
1869 (GetScanlineFast(y) +x)^ := BGRAPixelTransparent
1870 else
1871 (GetScanlineFast(y) +x)^.alpha := alpha;
1872 InvalidateBitmap;
1873end;
1874
1875function TBGRADefaultBitmap.GetPixel(x, y: int32or64): TBGRAPixel;
1876begin
1877 if (x < 0) or (x >= Width) or (y < 0) or (y >= Height) then //it is possible to read pixels outside of the cliprect
1878 Result := BGRAPixelTransparent
1879 else
1880 begin
1881 LoadFromBitmapIfNeeded;
1882 Result := (GetScanlineFast(y) + x)^;
1883 end;
1884end;
1885
1886function TBGRADefaultBitmap.GetPixel256(x, y, fracX256, fracY256: int32or64;
1887 AResampleFilter: TResampleFilter; smoothBorder: boolean = true): TBGRAPixel;
1888begin
1889 if (fracX256 = 0) and (fracY256 = 0) then
1890 result := GetPixel(x,y)
1891 else if AResampleFilter = rfBox then
1892 begin
1893 if fracX256 >= 128 then inc(x);
1894 if fracY256 >= 128 then inc(y);
1895 result := GetPixel(x,y);
1896 end else
1897 begin
1898 LoadFromBitmapIfNeeded;
1899 result := InternalGetPixel256(x,y,FineInterpolation256(fracX256,AResampleFilter),FineInterpolation256(fracY256,AResampleFilter),smoothBorder);
1900 end;
1901end;
1902
1903{$hints off}
1904{ This function compute an interpolated pixel at floating point coordinates }
1905function TBGRADefaultBitmap.GetPixel(x, y: single; AResampleFilter: TResampleFilter = rfLinear; smoothBorder: boolean = true): TBGRAPixel;
1906var
1907 ix, iy: Int32or64;
1908 iFactX,iFactY: Int32or64;
1909begin
1910 ix := round(x*256);
1911 if (ix<= -256) or (ix>=Width shl 8) then
1912 begin
1913 result := BGRAPixelTransparent;
1914 exit;
1915 end;
1916 iy := round(y*256);
1917 if (iy<= -256) or (iy>=Height shl 8) then
1918 begin
1919 result := BGRAPixelTransparent;
1920 exit;
1921 end;
1922
1923 iFactX := ix and 255; //distance from integer coordinate
1924 iFactY := iy and 255;
1925 if ix<0 then ix := -1 else ix := ix shr 8;
1926 if iy<0 then iy := -1 else iy := iy shr 8;
1927
1928 //if the coordinate is integer, then call standard GetPixel function
1929 if (iFactX = 0) and (iFactY = 0) then
1930 begin
1931 Result := (GetScanlineFast(iy)+ix)^;
1932 exit;
1933 end;
1934
1935 LoadFromBitmapIfNeeded;
1936 result := InternalGetPixel256(ix,iy,FineInterpolation256(iFactX,AResampleFilter),FineInterpolation256(iFactY,AResampleFilter),smoothBorder);
1937end;
1938
1939{ Same as GetPixel(single,single,TResampleFilter) but with coordinate cycle, supposing the image repeats itself in both directions }
1940function TBGRADefaultBitmap.GetPixelCycle(x, y: single; AResampleFilter: TResampleFilter = rfLinear): TBGRAPixel;
1941var
1942 ix, iy: Int32or64;
1943 iFactX,iFactY: Int32or64;
1944begin
1945 if FData = nil then
1946 begin
1947 result := BGRAPixelTransparent;
1948 exit;
1949 end;
1950 LoadFromBitmapIfNeeded;
1951 ix := round(x*256);
1952 iy := round(y*256);
1953 iFactX := ix and 255;
1954 iFactY := iy and 255;
1955 ix := PositiveMod(ix, FWidth shl 8) shr 8;
1956 iy := PositiveMod(iy, FHeight shl 8) shr 8;
1957 if (iFactX = 0) and (iFactY = 0) then
1958 begin
1959 result := (GetScanlineFast(iy)+ix)^;
1960 exit;
1961 end;
1962 if ScanInterpolationFilter <> rfLinear then
1963 begin
1964 iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter );
1965 iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter );
1966 end;
1967 result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY);
1968end;
1969
1970function TBGRADefaultBitmap.GetPixelCycle(x, y: single;
1971 AResampleFilter: TResampleFilter; repeatX: boolean; repeatY: boolean
1972 ): TBGRAPixel;
1973var
1974 ix, iy: Int32or64;
1975 iFactX,iFactY: Int32or64;
1976begin
1977 if FData = nil then
1978 begin
1979 result := BGRAPixelTransparent;
1980 exit;
1981 end;
1982 ix := round(x*256);
1983 iy := round(y*256);
1984 iFactX := ix and 255;
1985 iFactY := iy and 255;
1986 if ix < 0 then ix := -((iFactX-ix) shr 8)
1987 else ix := ix shr 8;
1988 if iy < 0 then iy := -((iFactY-iy) shr 8)
1989 else iy := iy shr 8;
1990 result := GetPixelCycle256(ix,iy,iFactX,iFactY,AResampleFilter,repeatX,repeatY);
1991end;
1992
1993function TBGRADefaultBitmap.GetPixelCycle256(x, y, fracX256,
1994 fracY256: int32or64; AResampleFilter: TResampleFilter): TBGRAPixel;
1995begin
1996 if (fracX256 = 0) and (fracY256 = 0) then
1997 result := GetPixelCycle(x,y)
1998 else if AResampleFilter = rfBox then
1999 begin
2000 if fracX256 >= 128 then inc(x);
2001 if fracY256 >= 128 then inc(y);
2002 result := GetPixelCycle(x,y);
2003 end else
2004 begin
2005 LoadFromBitmapIfNeeded;
2006 result := InternalGetPixelCycle256(PositiveMod(x,FWidth),PositiveMod(y,FHeight),FineInterpolation256(fracX256,AResampleFilter),FineInterpolation256(fracY256,AResampleFilter));
2007 end;
2008end;
2009
2010function TBGRADefaultBitmap.GetPixelCycle256(x, y, fracX256,
2011 fracY256: int32or64; AResampleFilter: TResampleFilter; repeatX: boolean;
2012 repeatY: boolean): TBGRAPixel;
2013begin
2014 if not repeatX and not repeatY then
2015 result := GetPixel256(x,y,fracX256,fracY256,AResampleFilter)
2016 else if repeatX and repeatY then
2017 result := GetPixelCycle256(x,y,fracX256,fracY256,AResampleFilter)
2018 else
2019 begin
2020 if not repeatX then
2021 begin
2022 if x < 0 then
2023 begin
2024 if x < -1 then
2025 begin
2026 result := BGRAPixelTransparent;
2027 exit;
2028 end;
2029 result := GetPixelCycle256(0,y,0,fracY256,AResampleFilter);
2030 result.alpha:= result.alpha*fracX256 shr 8;
2031 if result.alpha = 0 then
2032 result := BGRAPixelTransparent;
2033 exit;
2034 end;
2035 if x >= FWidth-1 then
2036 begin
2037 if x >= FWidth then
2038 begin
2039 result := BGRAPixelTransparent;
2040 exit;
2041 end;
2042 result := GetPixelCycle256(FWidth-1,y,0,fracY256,AResampleFilter);
2043 result.alpha:= result.alpha*(256-fracX256) shr 8;
2044 if result.alpha = 0 then
2045 result := BGRAPixelTransparent;
2046 exit;
2047 end;
2048 end else
2049 begin
2050 if y < 0 then
2051 begin
2052 if y < -1 then
2053 begin
2054 result := BGRAPixelTransparent;
2055 exit;
2056 end;
2057 result := GetPixelCycle256(x,0,fracX256,0,AResampleFilter);
2058 result.alpha:= result.alpha*fracY256 shr 8;
2059 if result.alpha = 0 then
2060 result := BGRAPixelTransparent;
2061 exit;
2062 end;
2063 if y >= FHeight-1 then
2064 begin
2065 if y >= FHeight then
2066 begin
2067 result := BGRAPixelTransparent;
2068 exit;
2069 end;
2070 result := GetPixelCycle256(x,FHeight-1,fracX256,0,AResampleFilter);
2071 result.alpha:= result.alpha*(256-fracY256) shr 8;
2072 if result.alpha = 0 then
2073 result := BGRAPixelTransparent;
2074 exit;
2075 end;
2076 end;
2077 result := GetPixelCycle256(x,y,fracX256,fracY256,AResampleFilter);
2078 end;
2079end;
2080
2081{$hints on}
2082
2083procedure TBGRADefaultBitmap.InvalidateBitmap;
2084begin
2085 FDataModified := True;
2086end;
2087
2088function TBGRADefaultBitmap.GetBitmap: TBitmap;
2089begin
2090 if FAlphaCorrectionNeeded and CanvasAlphaCorrection then
2091 LoadFromBitmapIfNeeded;
2092 if FDataModified or (FBitmap = nil) then
2093 begin
2094 RebuildBitmap;
2095 FDataModified := False;
2096 end;
2097 Result := FBitmap;
2098end;
2099
2100function TBGRADefaultBitmap.GetCanvas: TCanvas;
2101begin
2102 if FDataModified or (FBitmap = nil) then
2103 begin
2104 RebuildBitmap;
2105 FDataModified := False;
2106 end;
2107 Result := FBitmap.Canvas;
2108end;
2109
2110function TBGRADefaultBitmap.GetCanvasFP: TFPImageCanvas;
2111begin
2112 {$warnings off}
2113 if FCanvasFP = nil then
2114 FCanvasFP := TFPImageCanvas.Create(self);
2115 {$warnings on}
2116 result := FCanvasFP;
2117end;
2118
2119procedure TBGRADefaultBitmap.LoadFromBitmapIfNeeded;
2120begin
2121 if FBitmapModified then
2122 begin
2123 DoLoadFromBitmap;
2124 DiscardBitmapChange;
2125 end;
2126 if FAlphaCorrectionNeeded then
2127 begin
2128 DoAlphaCorrection;
2129 end;
2130end;
2131
2132procedure TBGRADefaultBitmap.CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadePosition: byte; mode: TDrawMode = dmDrawWithTransparency);
2133begin
2134 if AFadePosition = 0 then
2135 FillRect(ARect, Source1, mode) else
2136 if AFadePosition = 255 then
2137 FillRect(ARect, Source2, mode) else
2138 InternalCrossFade(ARect, Source1,Source2, AFadePosition,nil, mode);
2139end;
2140
2141procedure TBGRADefaultBitmap.CrossFade(ARect: TRect; Source1, Source2: IBGRAScanner; AFadeMask: IBGRAScanner; mode: TDrawMode = dmDrawWithTransparency);
2142begin
2143 InternalCrossFade(ARect, Source1,Source2, 0,AFadeMask, mode);
2144end;
2145
2146procedure TBGRADefaultBitmap.DiscardBitmapChange; inline;
2147begin
2148 FBitmapModified := False;
2149end;
2150
2151{ Initialize properties }
2152procedure TBGRADefaultBitmap.Init;
2153begin
2154 FRefCount := 1;
2155 FBitmap := nil;
2156 FCanvasFP := nil;
2157 FCanvasBGRA := nil;
2158 CanvasDrawModeFP := dmDrawWithTransparency;
2159 FData := nil;
2160 FWidth := 0;
2161 FHeight := 0;
2162 FScanWidth := FWidth;
2163 FScanHeight:= FHeight;
2164 FLineOrder := riloTopToBottom;
2165 FCanvasOpacity := 255;
2166 FAlphaCorrectionNeeded := False;
2167 FEraseMode := False;
2168 FillMode := fmWinding;
2169
2170 FontName := 'Arial';
2171 FontStyle := [];
2172 FontAntialias := False;
2173 FontVerticalAnchor:= fvaTop;
2174 FFontHeight := 20;
2175
2176 ResampleFilter := rfHalfCosine;
2177 ScanInterpolationFilter := rfLinear;
2178 ScanOffset := Point(0,0);
2179
2180 FPenStroker := TBGRAPenStroker.Create;
2181 FPenStroker.Arrow := TBGRAArrow.Create;
2182 FPenStroker.Arrow.LineCap := LineCap;
2183 FPenStroker.ArrowOwned := true;
2184end;
2185
2186procedure TBGRADefaultBitmap.SetInternalColor(x, y: integer; const Value: TFPColor);
2187begin
2188 FCanvasPixelProcFP(x,y, FPColorToBGRA(Value));
2189end;
2190
2191function TBGRADefaultBitmap.GetInternalColor(x, y: integer): TFPColor;
2192begin
2193 if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
2194 result := colTransparent
2195 else
2196 result := BGRAToFPColor((Scanline[y] + x)^);
2197end;
2198
2199procedure TBGRADefaultBitmap.SetInternalPixel(x, y: integer; Value: integer);
2200var
2201 c: TFPColor;
2202begin
2203 if not PtInClipRect(x,y) then exit;
2204 c := Palette.Color[Value];
2205 (Scanline[y] + x)^ := FPColorToBGRA(c);
2206 InvalidateBitmap;
2207end;
2208
2209function TBGRADefaultBitmap.GetInternalPixel(x, y: integer): integer;
2210var
2211 c: TFPColor;
2212begin
2213 if (x < 0) or (y < 0) or (x >= Width) or (y >= Height) then
2214 result := 0
2215 else
2216 begin
2217 c := BGRAToFPColor((Scanline[y] + x)^);
2218 Result := palette.IndexOf(c);
2219 end;
2220end;
2221
2222procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
2223begin
2224 if (self = nil) or (Width = 0) or (Height = 0) then exit;
2225 if Opaque then
2226 DataDrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height), Data,
2227 FLineOrder, FWidth, FHeight)
2228 else
2229 begin
2230 LoadFromBitmapIfNeeded;
2231 if Empty then
2232 exit;
2233 ACanvas.Draw(X, Y, Bitmap);
2234 end;
2235end;
2236
2237procedure TBGRADefaultBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean);
2238begin
2239 if (self = nil) or (Width = 0) or (Height = 0) then exit;
2240 if Opaque then
2241 DataDrawOpaque(ACanvas, Rect, Data, FLineOrder, FWidth, FHeight)
2242 else
2243 begin
2244 LoadFromBitmapIfNeeded;
2245 ACanvas.StretchDraw(Rect, Bitmap);
2246 end;
2247end;
2248
2249{---------------------------- Line primitives ---------------------------------}
2250
2251function TBGRADefaultBitmap.CheckHorizLineBounds(var x,y,x2: int32or64): boolean; inline;
2252var
2253 temp: int32or64;
2254begin
2255 if (x2 < x) then
2256 begin
2257 temp := x;
2258 x := x2;
2259 x2 := temp;
2260 end;
2261 if (x >= FClipRect.Right) or (x2 < FClipRect.Left) or (y < FClipRect.Top) or (y >= FClipRect.Bottom) then
2262 begin
2263 result := false;
2264 exit;
2265 end;
2266 if x < FClipRect.Left then
2267 x := FClipRect.Left;
2268 if x2 >= FClipRect.Right then
2269 x2 := FClipRect.Right - 1;
2270 result := true;
2271end;
2272
2273procedure TBGRADefaultBitmap.SetHorizLine(x, y, x2: int32or64; c: TBGRAPixel);
2274begin
2275 if not CheckHorizLineBounds(x,y,x2) then exit;
2276 FillInline(scanline[y] + x, c, x2 - x + 1);
2277 InvalidateBitmap;
2278end;
2279
2280procedure TBGRADefaultBitmap.XorHorizLine(x, y, x2: int32or64; c: TBGRAPixel);
2281begin
2282 if not CheckHorizLineBounds(x,y,x2) then exit;
2283 XorInline(scanline[y] + x, c, x2 - x + 1);
2284 InvalidateBitmap;
2285end;
2286
2287procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: int32or64; c: TBGRAPixel);
2288begin
2289 if not CheckHorizLineBounds(x,y,x2) then exit;
2290 DrawPixelsInline(scanline[y] + x, c, x2 - x + 1);
2291 InvalidateBitmap;
2292end;
2293
2294procedure TBGRADefaultBitmap.DrawHorizLine(x, y, x2: int32or64; ec: TExpandedPixel
2295 );
2296begin
2297 if not CheckHorizLineBounds(x,y,x2) then exit;
2298 DrawExpandedPixelsInline(scanline[y] + x, ec, x2 - x + 1);
2299 InvalidateBitmap;
2300end;
2301
2302procedure TBGRADefaultBitmap.HorizLine(x, y, x2: int32or64;
2303 texture: IBGRAScanner; ADrawMode : TDrawMode);
2304begin
2305 if not CheckHorizLineBounds(x,y,x2) then exit;
2306 texture.ScanMoveTo(x,y);
2307 ScannerPutPixels(texture,scanline[y] + x, x2 - x + 1,ADrawMode);
2308 InvalidateBitmap;
2309end;
2310
2311procedure TBGRADefaultBitmap.FastBlendHorizLine(x, y, x2: int32or64; c: TBGRAPixel);
2312begin
2313 if not CheckHorizLineBounds(x,y,x2) then exit;
2314 FastBlendPixelsInline(scanline[y] + x, c, x2 - x + 1);
2315 InvalidateBitmap;
2316end;
2317
2318procedure TBGRADefaultBitmap.AlphaHorizLine(x, y, x2: int32or64; alpha: byte);
2319begin
2320 if alpha = 0 then
2321 begin
2322 SetHorizLine(x, y, x2, BGRAPixelTransparent);
2323 exit;
2324 end;
2325 if not CheckHorizLineBounds(x,y,x2) then exit;
2326 AlphaFillInline(scanline[y] + x, alpha, x2 - x + 1);
2327 InvalidateBitmap;
2328end;
2329
2330function TBGRADefaultBitmap.CheckVertLineBounds(var x,y,y2: int32or64; out delta: int32or64): boolean; inline;
2331var
2332 temp: int32or64;
2333begin
2334 if FLineOrder = riloBottomToTop then
2335 delta := -Width
2336 else
2337 delta := Width;
2338
2339 if (y2 < y) then
2340 begin
2341 temp := y;
2342 y := y2;
2343 y2 := temp;
2344 end;
2345
2346 if y < FClipRect.Top then
2347 y := FClipRect.Top;
2348 if y2 >= FClipRect.Bottom then
2349 y2 := FClipRect.Bottom - 1;
2350
2351 if (y >= FClipRect.Bottom) or (y2 < FClipRect.Top) or (x < FClipRect.Left) or (x >= FClipRect.Right) then
2352 begin
2353 result := false;
2354 exit;
2355 end;
2356
2357 result := true;
2358end;
2359
2360procedure TBGRADefaultBitmap.SetVertLine(x, y, y2: int32or64; c: TBGRAPixel);
2361var
2362 n, delta: int32or64;
2363 p: PBGRAPixel;
2364begin
2365 if not CheckVertLineBounds(x,y,y2,delta) then exit;
2366 p := scanline[y] + x;
2367 for n := y2 - y downto 0 do
2368 begin
2369 p^ := c;
2370 Inc(p, delta);
2371 end;
2372 InvalidateBitmap;
2373end;
2374
2375procedure TBGRADefaultBitmap.XorVertLine(x, y, y2: int32or64; c: TBGRAPixel);
2376var
2377 n, delta: int32or64;
2378 p: PBGRAPixel;
2379begin
2380 if not CheckVertLineBounds(x,y,y2,delta) then exit;
2381 p := scanline[y] + x;
2382 for n := y2 - y downto 0 do
2383 begin
2384 PDword(p)^ := PDword(p)^ xor DWord(c);
2385 Inc(p, delta);
2386 end;
2387 InvalidateBitmap;
2388end;
2389
2390procedure TBGRADefaultBitmap.DrawVertLine(x, y, y2: int32or64; c: TBGRAPixel);
2391var
2392 n, delta: int32or64;
2393 p: PBGRAPixel;
2394begin
2395 if c.alpha = 255 then
2396 begin
2397 SetVertLine(x,y,y2,c);
2398 exit;
2399 end;
2400 if not CheckVertLineBounds(x,y,y2,delta) or (c.alpha=0) then exit;
2401 p := scanline[y] + x;
2402 for n := y2 - y downto 0 do
2403 begin
2404 DrawPixelInlineNoAlphaCheck(p, c);
2405 Inc(p, delta);
2406 end;
2407 InvalidateBitmap;
2408end;
2409
2410procedure TBGRADefaultBitmap.AlphaVertLine(x, y, y2: int32or64; alpha: byte);
2411var
2412 n, delta: int32or64;
2413 p: PBGRAPixel;
2414begin
2415 if alpha = 0 then
2416 begin
2417 SetVertLine(x, y, y2, BGRAPixelTransparent);
2418 exit;
2419 end;
2420 if not CheckVertLineBounds(x,y,y2,delta) then exit;
2421 p := scanline[y] + x;
2422 for n := y2 - y downto 0 do
2423 begin
2424 p^.alpha := alpha;
2425 Inc(p, delta);
2426 end;
2427 InvalidateBitmap;
2428end;
2429
2430procedure TBGRADefaultBitmap.FastBlendVertLine(x, y, y2: int32or64; c: TBGRAPixel);
2431var
2432 n, delta: int32or64;
2433 p: PBGRAPixel;
2434begin
2435 if not CheckVertLineBounds(x,y,y2,delta) then exit;
2436 p := scanline[y] + x;
2437 for n := y2 - y downto 0 do
2438 begin
2439 FastBlendPixelInline(p, c);
2440 Inc(p, delta);
2441 end;
2442 InvalidateBitmap;
2443end;
2444
2445procedure TBGRADefaultBitmap.DrawHorizLineDiff(x, y, x2: int32or64;
2446 c, compare: TBGRAPixel; maxDiff: byte);
2447begin
2448 if not CheckHorizLineBounds(x,y,x2) then exit;
2449 DrawPixelsInlineDiff(scanline[y] + x, c, x2 - x + 1, compare, maxDiff);
2450 InvalidateBitmap;
2451end;
2452
2453procedure TBGRADefaultBitmap.InternalTextOutCurved(
2454 ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel;
2455 ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
2456var
2457 pstr: pchar;
2458 left,charlen: integer;
2459 nextchar: string;
2460 charwidth, angle, textlen: single;
2461begin
2462 if (ATexture = nil) and (AColor.alpha = 0) then exit;
2463 sUTF8 := CleanTextOutString(sUTF8);
2464 if sUTF8 = '' then exit;
2465 pstr := @sUTF8[1];
2466 left := length(sUTF8);
2467 if AALign<> taLeftJustify then
2468 begin
2469 textlen := TextSize(sUTF8).cx + (UTF8Length(sUTF8)-1)*ALetterSpacing;
2470 case AAlign of
2471 taCenter: ACursor.MoveBackward(textlen*0.5);
2472 taRightJustify: ACursor.MoveBackward(textlen);
2473 end;
2474 end;
2475 while left > 0 do
2476 begin
2477 charlen := UTF8CharacterLength(pstr);
2478 setlength(nextchar, charlen);
2479 move(pstr^, nextchar[1], charlen);
2480 inc(pstr,charlen);
2481 dec(left,charlen);
2482 charwidth := TextSize(nextchar).cx;
2483 ACursor.MoveForward(charwidth);
2484 ACursor.MoveBackward(charwidth, false);
2485 ACursor.MoveForward(charwidth*0.5);
2486 with ACursor.CurrentTangent do angle := arctan2(y,x);
2487 with ACursor.CurrentCoordinate do
2488 begin
2489 if ATexture = nil then
2490 TextOutAngle(x,y, system.round(-angle*1800/Pi), nextchar, AColor, taCenter)
2491 else
2492 TextOutAngle(x,y, system.round(-angle*1800/Pi), nextchar, ATexture, taCenter);
2493 end;
2494 ACursor.MoveForward(charwidth*0.5 + ALetterSpacing);
2495 end;
2496end;
2497
2498procedure TBGRADefaultBitmap.InternalCrossFade(ARect: TRect; Source1,
2499 Source2: IBGRAScanner; AFadePos: byte; AFadeMask: IBGRAScanner; mode: TDrawMode);
2500var xb,yb: NativeInt;
2501 pdest: PBGRAPixel;
2502 c: TBGRAPixel;
2503 buf1,buf2: ArrayOfTBGRAPixel;
2504begin
2505 if not IntersectRect(ARect,ARect,ClipRect) then exit;
2506 setlength(buf1, ARect.Width);
2507 setlength(buf2, ARect.Width);
2508 for yb := ARect.top to ARect.Bottom-1 do
2509 begin
2510 pdest := GetScanlineFast(yb)+ARect.Left;
2511 Source1.ScanMoveTo(ARect.left, yb);
2512 Source1.ScanPutPixels(@buf1[0], length(buf1), dmSet);
2513 Source2.ScanMoveTo(ARect.left, yb);
2514 Source2.ScanPutPixels(@buf2[0], length(buf2), dmSet);
2515 if AFadeMask<>nil then AFadeMask.ScanMoveTo(ARect.left, yb);
2516 for xb := 0 to ARect.Right-ARect.left-1 do
2517 begin
2518 if AFadeMask<>nil then AFadePos := AFadeMask.ScanNextPixel.green;
2519 c := MergeBGRAWithGammaCorrection(buf1[xb],not AFadePos,buf2[xb],AFadePos);
2520 case mode of
2521 dmSet: pdest^ := c;
2522 dmDrawWithTransparency: DrawPixelInlineWithAlphaCheck(pdest, c);
2523 dmLinearBlend: FastBlendPixelInline(pdest,c);
2524 dmSetExceptTransparent: if c.alpha = 255 then pdest^ := c;
2525 end;
2526 inc(pdest);
2527 end;
2528 end;
2529 InvalidateBitmap;
2530end;
2531
2532procedure TBGRADefaultBitmap.InternalArc(cx, cy, rx, ry: single; StartAngleRad,
2533 EndAngleRad: Single; ABorderColor: TBGRAPixel; w: single; AFillColor: TBGRAPixel; AOptions: TArcOptions;
2534 ADrawChord: boolean; ATexture: IBGRAScanner);
2535var
2536 pts, ptsFill: array of TPointF;
2537 temp: single;
2538 multi: TBGRAMultishapeFiller;
2539begin
2540 if (rx = 0) or (ry = 0) then exit;
2541 if ADrawChord then AOptions := AOptions+[aoClosePath];
2542 if not (aoFillPath in AOptions) then
2543 AFillColor := BGRAPixelTransparent;
2544
2545 if (ABorderColor.alpha = 0) and (AFillColor.alpha = 0) then exit;
2546
2547 if abs(StartAngleRad-EndAngleRad) >= 2*PI - 1e-6 then
2548 begin
2549 if aoPie in AOptions then
2550 EndAngleRad:= StartAngleRad+2*PI
2551 else
2552 EllipseAntialias(cx,cy,rx,ry,ABorderColor,w,AFillColor);
2553 exit;
2554 end;
2555
2556 if EndAngleRad < StartAngleRad then
2557 begin
2558 temp := StartAngleRad;
2559 StartAngleRad:= EndAngleRad;
2560 EndAngleRad:= temp;
2561 end;
2562
2563 pts := ComputeArcRad(cx,cy,rx,ry,StartAngleRad,EndAngleRad);
2564 if aoPie in AOptions then pts := ConcatPointsF([PointsF([PointF(cx,cy)]),pts]);
2565
2566 multi := TBGRAMultishapeFiller.Create;
2567 multi.PolygonOrder := poLastOnTop;
2568 if AFillColor.alpha <> 0 then
2569 begin
2570 if not (aoPie in AOptions) and (length(pts)>=2) then ptsFill := ConcatPointsF([PointsF([(pts[0]+pts[high(pts)])*0.5]),pts])
2571 else ptsFill := pts;
2572 if ATexture <> nil then
2573 multi.AddPolygon(ptsFill, ATexture)
2574 else
2575 multi.AddPolygon(ptsFill, AFillColor);
2576 end;
2577 if ABorderColor.alpha <> 0 then
2578 begin
2579 if [aoPie,aoClosePath]*AOptions <> [] then
2580 multi.AddPolygon(ComputeWidePolygon(pts,w), ABorderColor)
2581 else
2582 multi.AddPolygon(ComputeWidePolyline(pts,w), ABorderColor);
2583 end;
2584 multi.Antialiasing := true;
2585 multi.Draw(self);
2586 multi.Free;
2587end;
2588
2589class function TBGRADefaultBitmap.IsAffineRoughlyTranslation(AMatrix: TAffineMatrix; ASourceBounds: TRect): boolean;
2590const oneOver512 = 1/512;
2591var Orig,HAxis,VAxis: TPointF;
2592begin
2593 Orig := AMatrix*PointF(ASourceBounds.Left,ASourceBounds.Top);
2594 if (abs(Orig.x-round(Orig.x)) > oneOver512) or
2595 (abs(Orig.y-round(Orig.y)) > oneOver512) then
2596 begin
2597 result := false;
2598 exit;
2599 end;
2600 HAxis := AMatrix*PointF(ASourceBounds.Right-1,ASourceBounds.Top);
2601 if (abs(HAxis.x - (round(Orig.x)+ASourceBounds.Right-1 - ASourceBounds.Left)) > oneOver512) or
2602 (abs(HAxis.y - round(Orig.y)) > oneOver512) then
2603 begin
2604 result := false;
2605 exit;
2606 end;
2607 VAxis := AMatrix*PointF(ASourceBounds.Left,ASourceBounds.Bottom-1);
2608 if (abs(VAxis.y - (round(Orig.y)+ASourceBounds.Bottom-1 - ASourceBounds.Top)) > oneOver512) or
2609 (abs(VAxis.x - round(Orig.x)) > oneOver512) then
2610 begin
2611 result := false;
2612 exit;
2613 end;
2614 result := true;
2615end;
2616
2617{---------------------------- Lines ---------------------------------}
2618{ Call appropriate functions }
2619
2620procedure TBGRADefaultBitmap.DrawLine(x1, y1, x2, y2: integer;
2621 c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode);
2622begin
2623 BGRADrawLineAliased(self,x1,y1,x2,y2,c,DrawLastPixel,ADrawMode);
2624end;
2625
2626procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer;
2627 c: TBGRAPixel; DrawLastPixel: boolean);
2628begin
2629 BGRADrawLineAntialias(self,x1,y1,x2,y2,c,DrawLastPixel,LinearAntialiasing);
2630end;
2631
2632procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer;
2633 c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean);
2634var DashPos: integer;
2635begin
2636 DashPos := 0;
2637 BGRADrawLineAntialias(self,x1,y1,x2,y2,c1,c2,dashLen,DrawLastPixel,DashPos,LinearAntialiasing);
2638end;
2639
2640procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: integer; c1,
2641 c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer);
2642begin
2643 BGRADrawLineAntialias(self,x1,y1,x2,y2,c1,c2,dashLen,DrawLastPixel,DashPos,LinearAntialiasing);
2644end;
2645
2646procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
2647 c: TBGRAPixel; w: single);
2648begin
2649 FillPolyAntialias( FPenStroker.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],w,c), c);
2650end;
2651
2652procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
2653 texture: IBGRAScanner; w: single);
2654begin
2655 FillPolyAntialias( FPenStroker.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],w), texture);
2656end;
2657
2658procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
2659 c: TBGRAPixel; w: single; ClosedCap: boolean);
2660begin
2661 FillPolyAntialias( FPenStroker.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],w,c,ClosedCap), c);
2662end;
2663
2664procedure TBGRADefaultBitmap.DrawLineAntialias(x1, y1, x2, y2: single;
2665 texture: IBGRAScanner; w: single; ClosedCap: boolean);
2666begin
2667 FillPolyAntialias( FPenStroker.ComputePolyline([PointF(x1,y1),PointF(x2,y2)],w,ClosedCap), texture);
2668end;
2669
2670procedure TBGRADefaultBitmap.DrawPolyLineAntialias(const points: array of TPointF;
2671 c: TBGRAPixel; w: single);
2672begin
2673 FillPolyAntialias( FPenStroker.ComputePolyline(points,w,c), c);
2674end;
2675
2676procedure TBGRADefaultBitmap.DrawPolyLineAntialias(
2677 const points: array of TPointF; texture: IBGRAScanner; w: single);
2678begin
2679 FillPolyAntialias( FPenStroker.ComputePolyline(points,w), texture);
2680end;
2681
2682procedure TBGRADefaultBitmap.DrawPolyLineAntialias(const points: array of TPointF;
2683 c: TBGRAPixel; w: single; ClosedCap: boolean);
2684begin
2685 FillPolyAntialias( FPenStroker.ComputePolyline(points,w,c,ClosedCap), c);
2686end;
2687
2688procedure TBGRADefaultBitmap.DrawPolyLineAntialias(
2689 const points: array of TPointF; texture: IBGRAScanner; w: single;
2690 ClosedCap: boolean);
2691begin
2692 FillPolyAntialias( FPenStroker.ComputePolyline(points,w,ClosedCap), texture);
2693end;
2694
2695procedure TBGRADefaultBitmap.DrawPolyLineAntialias(
2696 const points: array of TPointF; c: TBGRAPixel; w: single;
2697 fillcolor: TBGRAPixel);
2698var multi: TBGRAMultishapeFiller;
2699begin
2700 multi := TBGRAMultishapeFiller.Create;
2701 multi.PolygonOrder := poLastOnTop;
2702 multi.AddPolygon(points,fillcolor);
2703 multi.AddPolygon(ComputeWidePolyline(points,w),c);
2704 if LinearAntialiasing then
2705 multi.Draw(self,dmLinearBlend)
2706 else
2707 multi.Draw(self,dmDrawWithTransparency);
2708 multi.Free;
2709end;
2710
2711procedure TBGRADefaultBitmap.DrawPolyLineAntialiasAutocycle(
2712 const points: array of TPointF; c: TBGRAPixel; w: single);
2713begin
2714 FillPolyAntialias( FPenStroker.ComputePolylineAutocycle(points,w), c);
2715end;
2716
2717procedure TBGRADefaultBitmap.DrawPolyLineAntialiasAutocycle(
2718 const points: array of TPointF; texture: IBGRAScanner; w: single);
2719begin
2720 FillPolyAntialias( FPenStroker.ComputePolylineAutocycle(points,w), texture);
2721end;
2722
2723procedure TBGRADefaultBitmap.DrawPolygonAntialias(const points: array of TPointF;
2724 c: TBGRAPixel; w: single);
2725begin
2726 FillPolyAntialias( FPenStroker.ComputePolygon(points,w), c);
2727end;
2728
2729procedure TBGRADefaultBitmap.DrawPolygonAntialias(
2730 const points: array of TPointF; texture: IBGRAScanner; w: single);
2731begin
2732 FillPolyAntialias( FPenStroker.ComputePolygon(points,w), texture);
2733end;
2734
2735procedure TBGRADefaultBitmap.DrawPolygonAntialias(
2736 const points: array of TPointF; c: TBGRAPixel; w: single;
2737 fillcolor: TBGRAPixel);
2738var multi: TBGRAMultishapeFiller;
2739begin
2740 multi := TBGRAMultishapeFiller.Create;
2741 multi.PolygonOrder := poLastOnTop;
2742 multi.AddPolygon(points,fillcolor);
2743 multi.AddPolygon(ComputeWidePolygon(points,w),c);
2744 if LinearAntialiasing then
2745 multi.Draw(self,dmLinearBlend)
2746 else
2747 multi.Draw(self,dmDrawWithTransparency);
2748 multi.Free;
2749end;
2750
2751procedure TBGRADefaultBitmap.EraseLine(x1, y1, x2, y2: integer; alpha: byte;
2752 DrawLastPixel: boolean);
2753begin
2754 BGRAEraseLineAliased(self,x1,y1,x2,y2,alpha,DrawLastPixel);
2755end;
2756
2757procedure TBGRADefaultBitmap.EraseLineAntialias(x1, y1, x2, y2: integer;
2758 alpha: byte; DrawLastPixel: boolean);
2759begin
2760 BGRAEraseLineAntialias(self,x1,y1,x2,y2,alpha,DrawLastPixel);
2761end;
2762
2763procedure TBGRADefaultBitmap.EraseLineAntialias(x1, y1, x2, y2: single;
2764 alpha: byte; w: single; Closed: boolean);
2765begin
2766 FEraseMode := True;
2767 DrawLineAntialias(x1, y1, x2, y2, BGRA(0, 0, 0, alpha), w, Closed);
2768 FEraseMode := False;
2769end;
2770
2771procedure TBGRADefaultBitmap.ErasePolyLineAntialias(const points: array of TPointF;
2772 alpha: byte; w: single);
2773begin
2774 FEraseMode := True;
2775 DrawPolyLineAntialias(points, BGRA(0,0,0,alpha),w);
2776 FEraseMode := False;
2777end;
2778
2779procedure TBGRADefaultBitmap.FillPath(APath: IBGRAPath; AFillColor: TBGRAPixel);
2780begin
2781 FillPolyAntialias(APath.getPoints,AFillColor);
2782end;
2783
2784procedure TBGRADefaultBitmap.FillPath(APath: IBGRAPath; AFillTexture: IBGRAScanner);
2785begin
2786 FillPolyAntialias(APath.getPoints,AFillTexture);
2787end;
2788
2789procedure TBGRADefaultBitmap.ErasePath(APath: IBGRAPath; alpha: byte);
2790begin
2791 ErasePolyAntialias(APath.getPoints,alpha);
2792end;
2793
2794procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2795 AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel);
2796var tempPath: TBGRAPath;
2797 multi: TBGRAMultishapeFiller;
2798begin
2799 tempPath := TBGRAPath.Create(APath);
2800 multi := TBGRAMultishapeFiller.Create;
2801 multi.FillMode := FillMode;
2802 multi.PolygonOrder := poLastOnTop;
2803 multi.AddPathFill(tempPath,AMatrix,AFillColor);
2804 multi.AddPathStroke(tempPath,AMatrix,AStrokeColor,AWidth,FPenStroker);
2805 multi.Draw(self);
2806 multi.Free;
2807 tempPath.Free;
2808end;
2809
2810procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2811 AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel);
2812var tempPath: TBGRAPath;
2813 multi: TBGRAMultishapeFiller;
2814begin
2815 tempPath := TBGRAPath.Create(APath);
2816 multi := TBGRAMultishapeFiller.Create;
2817 multi.FillMode := FillMode;
2818 multi.PolygonOrder := poLastOnTop;
2819 multi.AddPathFill(tempPath,AMatrix,AFillColor);
2820 multi.AddPathStroke(tempPath,AMatrix,AStrokeTexture,AWidth,FPenStroker);
2821 multi.Draw(self);
2822 multi.Free;
2823 tempPath.Free;
2824end;
2825
2826procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2827 AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner);
2828var tempPath: TBGRAPath;
2829 multi: TBGRAMultishapeFiller;
2830begin
2831 tempPath := TBGRAPath.Create(APath);
2832 multi := TBGRAMultishapeFiller.Create;
2833 multi.FillMode := FillMode;
2834 multi.PolygonOrder := poLastOnTop;
2835 multi.AddPathFill(tempPath,AMatrix,AFillTexture);
2836 multi.AddPathStroke(tempPath,AMatrix,AStrokeColor,AWidth,FPenStroker);
2837 multi.Draw(self);
2838 multi.Free;
2839 tempPath.Free;
2840end;
2841
2842procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2843 AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner);
2844var
2845 tempPath: TBGRAPath;
2846 multi: TBGRAMultishapeFiller;
2847begin
2848 tempPath := TBGRAPath.Create(APath);
2849 multi := TBGRAMultishapeFiller.Create;
2850 multi.FillMode := FillMode;
2851 multi.PolygonOrder := poLastOnTop;
2852 multi.AddPathFill(tempPath,AMatrix,AFillTexture);
2853 multi.AddPathStroke(tempPath,AMatrix,AStrokeTexture,AWidth,FPenStroker);
2854 multi.Draw(self);
2855 multi.Free;
2856 tempPath.Free;
2857end;
2858
2859procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2860 AStrokeColor: TBGRAPixel; AWidth: single);
2861var tempPath: TBGRAPath;
2862begin
2863 tempPath := TBGRAPath.Create(APath);
2864 tempPath.stroke(self, AMatrix, AStrokeColor, AWidth);
2865 tempPath.Free;
2866end;
2867
2868procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2869 AStrokeTexture: IBGRAScanner; AWidth: single);
2870var tempPath: TBGRAPath;
2871begin
2872 tempPath := TBGRAPath.Create(APath);
2873 tempPath.stroke(self, AMatrix, AStrokeTexture, AWidth);
2874 tempPath.Free;
2875end;
2876
2877procedure TBGRADefaultBitmap.FillPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2878 AFillColor: TBGRAPixel);
2879begin
2880 FillPolyAntialias(APath.getPoints(AMatrix),AFillColor);
2881end;
2882
2883procedure TBGRADefaultBitmap.FillPath(APath: IBGRAPath; AMatrix: TAffineMatrix;
2884 AFillTexture: IBGRAScanner);
2885begin
2886 FillPolyAntialias(APath.getPoints(AMatrix),AFillTexture);
2887end;
2888
2889procedure TBGRADefaultBitmap.ErasePath(APath: IBGRAPath;
2890 AMatrix: TAffineMatrix; alpha: byte);
2891begin
2892 ErasePolyAntialias(APath.getPoints(AMatrix),alpha);
2893end;
2894
2895procedure TBGRADefaultBitmap.ArrowStartAsNone;
2896begin
2897 GetArrow.StartAsNone;
2898end;
2899
2900procedure TBGRADefaultBitmap.ArrowStartAsClassic(AFlipped: boolean;
2901 ACut: boolean; ARelativePenWidth: single);
2902begin
2903 GetArrow.StartAsClassic(AFlipped,ACut,ARelativePenWidth);
2904end;
2905
2906procedure TBGRADefaultBitmap.ArrowStartAsTriangle(ABackOffset: single;
2907 ARounded: boolean; AHollow: boolean; AHollowPenWidth: single);
2908begin
2909 GetArrow.StartAsTriangle(ABackOffset,ARounded,AHollow,AHollowPenWidth);
2910end;
2911
2912procedure TBGRADefaultBitmap.ArrowStartAsTail;
2913begin
2914 GetArrow.StartAsTail;
2915end;
2916
2917procedure TBGRADefaultBitmap.ArrowEndAsNone;
2918begin
2919 GetArrow.EndAsNone;
2920end;
2921
2922procedure TBGRADefaultBitmap.ArrowEndAsClassic(AFlipped: boolean;
2923 ACut: boolean; ARelativePenWidth: single);
2924begin
2925 GetArrow.EndAsClassic(AFlipped,ACut,ARelativePenWidth);
2926end;
2927
2928procedure TBGRADefaultBitmap.ArrowEndAsTriangle(ABackOffset: single;
2929 ARounded: boolean; AHollow: boolean; AHollowPenWidth: single);
2930begin
2931 GetArrow.EndAsTriangle(ABackOffset,ARounded,AHollow,AHollowPenWidth);
2932end;
2933
2934procedure TBGRADefaultBitmap.ArrowEndAsTail;
2935begin
2936 GetArrow.EndAsTail;
2937end;
2938
2939{------------------------ Shapes ----------------------------------------------}
2940{ Call appropriate functions }
2941
2942procedure TBGRADefaultBitmap.FillTriangleLinearColor(pt1, pt2, pt3: TPointF;
2943 c1, c2, c3: TBGRAPixel);
2944begin
2945 FillPolyLinearColor([pt1,pt2,pt3],[c1,c2,c3]);
2946end;
2947
2948procedure TBGRADefaultBitmap.FillTriangleLinearColorAntialias(pt1, pt2,
2949 pt3: TPointF; c1, c2, c3: TBGRAPixel);
2950var
2951 grad: TBGRAGradientTriangleScanner;
2952begin
2953 grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3);
2954 FillPolyAntialias([pt1,pt2,pt3],grad);
2955 grad.Free;
2956end;
2957
2958procedure TBGRADefaultBitmap.FillTriangleLinearMapping(pt1, pt2, pt3: TPointF;
2959 texture: IBGRAScanner; tex1, tex2, tex3: TPointF; TextureInterpolation: Boolean= True);
2960begin
2961 FillPolyLinearMapping([pt1,pt2,pt3],texture,[tex1,tex2,tex3],TextureInterpolation);
2962end;
2963
2964procedure TBGRADefaultBitmap.FillTriangleLinearMappingLightness(pt1, pt2,
2965 pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF; light1,
2966 light2, light3: word; TextureInterpolation: Boolean);
2967begin
2968 FillPolyLinearMappingLightness([pt1,pt2,pt3],texture,[tex1,tex2,tex3],[light1,light2,light3],TextureInterpolation);
2969end;
2970
2971procedure TBGRADefaultBitmap.FillTriangleLinearMappingAntialias(pt1, pt2,
2972 pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF);
2973var
2974 mapping: TBGRATriangleLinearMapping;
2975begin
2976 mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3);
2977 FillPolyAntialias([pt1,pt2,pt3],mapping);
2978 mapping.Free;
2979end;
2980
2981procedure TBGRADefaultBitmap.FillQuadLinearColor(pt1, pt2, pt3, pt4: TPointF;
2982 c1, c2, c3, c4: TBGRAPixel);
2983var
2984 center: TPointF;
2985 centerColor: TBGRAPixel;
2986 multi: TBGRAMultishapeFiller;
2987begin
2988 if not IsConvex([pt1,pt2,pt3,pt4]) then //need to merge colors
2989 begin
2990 multi := TBGRAMultishapeFiller.Create;
2991 multi.AddQuadLinearColor(pt1,pt2,pt3,pt4,c1,c2,c3,c4);
2992 multi.Antialiasing:= false;
2993 multi.Draw(self);
2994 multi.Free;
2995 exit;
2996 end;
2997 center := (pt1+pt2+pt3+pt4)*(1/4);
2998 centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)),
2999 MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) );
3000 FillTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor);
3001 FillTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor);
3002 FillTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor);
3003 FillTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor);
3004end;
3005
3006procedure TBGRADefaultBitmap.FillQuadLinearColorAntialias(pt1, pt2, pt3,
3007 pt4: TPointF; c1, c2, c3, c4: TBGRAPixel);
3008var multi : TBGRAMultishapeFiller;
3009begin
3010 multi := TBGRAMultishapeFiller.Create;
3011 multi.AddQuadLinearColor(pt1, pt2, pt3, pt4, c1, c2, c3, c4);
3012 multi.Draw(self);
3013 multi.free;
3014end;
3015
3016procedure TBGRADefaultBitmap.FillQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF;
3017 texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
3018 TextureInterpolation: Boolean; ACulling: TFaceCulling);
3019var
3020 scan: TBGRAQuadLinearScanner;
3021begin
3022 if ((abs(pt1.y-pt2.y)<1e-6) and (abs(pt3.y-pt4.y)<1e-6)) or
3023 ((abs(pt3.y-pt2.y)<1e-6) and (abs(pt1.y-pt4.y)<1e-6)) then
3024 FillPolyLinearMapping([pt1,pt2,pt3,pt4], texture,
3025 [tex1,tex2,tex3,tex4], TextureInterpolation)
3026 else
3027 begin
3028 scan := TBGRAQuadLinearScanner.Create(texture,
3029 [tex1,tex2,tex3,tex4],
3030 [pt1,pt2,pt3,pt4],TextureInterpolation);
3031 scan.Culling := ACulling;
3032 FillPoly([pt1,pt2,pt3,pt4],scan,dmDrawWithTransparency);
3033 scan.Free;
3034 end;
3035end;
3036
3037procedure TBGRADefaultBitmap.FillQuadLinearMappingLightness(pt1, pt2, pt3,
3038 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF; light1,
3039 light2, light3, light4: word; TextureInterpolation: Boolean);
3040var
3041 center: TPointF;
3042 centerTex: TPointF;
3043 centerLight: word;
3044begin
3045 center := (pt1+pt2+pt3+pt4)*(1/4);
3046 centerTex := (tex1+tex2+tex3+tex4)*(1/4);
3047 centerLight := (light1+light2+light3+light4) div 4;
3048 FillTriangleLinearMappingLightness(pt1,pt2,center, texture,tex1,tex2,centerTex, light1,light2,centerLight, TextureInterpolation);
3049 FillTriangleLinearMappingLightness(pt2,pt3,center, texture,tex2,tex3,centerTex, light2,light3,centerLight, TextureInterpolation);
3050 FillTriangleLinearMappingLightness(pt3,pt4,center, texture,tex3,tex4,centerTex, light3,light4,centerLight, TextureInterpolation);
3051 FillTriangleLinearMappingLightness(pt4,pt1,center, texture,tex4,tex1,centerTex, light4,light1,centerLight, TextureInterpolation);
3052end;
3053
3054procedure TBGRADefaultBitmap.FillQuadLinearMappingAntialias(pt1, pt2, pt3,
3055 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
3056 ACulling: TFaceCulling);
3057var multi : TBGRAMultishapeFiller;
3058begin
3059 multi := TBGRAMultishapeFiller.Create;
3060 multi.AddQuadLinearMapping(pt1, pt2, pt3, pt4, texture, tex1,tex2,tex3,tex4, ACulling);
3061 multi.Draw(self);
3062 multi.free;
3063end;
3064
3065procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3,
3066 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
3067 ADrawMode: TDrawMode);
3068var
3069 persp: TBGRAPerspectiveScannerTransform;
3070begin
3071 persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
3072 FillPoly([pt1,pt2,pt3,pt4],persp,ADrawMode);
3073 persp.Free;
3074end;
3075
3076procedure TBGRADefaultBitmap.FillQuadPerspectiveMapping(pt1, pt2, pt3,
3077 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
3078 ACleanBorders: TRect; ADrawMode: TDrawMode);
3079var
3080 persp: TBGRAPerspectiveScannerTransform;
3081 clean: TBGRAExtendedBorderScanner;
3082begin
3083 clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders);
3084 persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
3085 FillPoly([pt1,pt2,pt3,pt4],persp,ADrawMode);
3086 persp.Free;
3087 clean.Free;
3088end;
3089
3090procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3,
3091 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
3092var
3093 persp: TBGRAPerspectiveScannerTransform;
3094begin
3095 persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
3096 FillPolyAntialias([pt1,pt2,pt3,pt4],persp);
3097 persp.Free;
3098end;
3099
3100procedure TBGRADefaultBitmap.FillQuadPerspectiveMappingAntialias(pt1, pt2, pt3,
3101 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
3102 ACleanBorders: TRect);
3103var
3104 persp: TBGRAPerspectiveScannerTransform;
3105 clean: TBGRAExtendedBorderScanner;
3106begin
3107 clean := TBGRAExtendedBorderScanner.Create(texture,ACleanBorders);
3108 persp := TBGRAPerspectiveScannerTransform.Create(clean,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
3109 FillPolyAntialias([pt1,pt2,pt3,pt4],persp);
3110 persp.Free;
3111 clean.Free;
3112end;
3113
3114procedure TBGRADefaultBitmap.FillQuadAffineMapping(Orig, HAxis, VAxis: TPointF;
3115 AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean; ADrawMode: TDrawMode; AOpacity: byte);
3116var pts3: TPointF;
3117 affine: TBGRAAffineBitmapTransform;
3118begin
3119 if not APixelCenteredCoordinates then
3120 begin
3121 Orig -= PointF(0.5,0.5);
3122 HAxis -= PointF(0.5,0.5);
3123 VAxis -= PointF(0.5,0.5);
3124 end;
3125 pts3 := HAxis+(VAxis-Orig);
3126 affine := TBGRAAffineBitmapTransform.Create(AImage,False,AImage.ScanInterpolationFilter,not APixelCenteredCoordinates);
3127 affine.GlobalOpacity:= AOpacity;
3128 affine.Fit(Orig,HAxis,VAxis);
3129 FillPoly([Orig,HAxis,pts3,VAxis],affine,ADrawMode);
3130 affine.Free;
3131end;
3132
3133procedure TBGRADefaultBitmap.FillQuadAffineMappingAntialias(Orig, HAxis,
3134 VAxis: TPointF; AImage: TBGRACustomBitmap; APixelCenteredCoordinates: boolean; AOpacity: byte);
3135var pts3: TPointF;
3136 affine: TBGRAAffineBitmapTransform;
3137begin
3138 if not APixelCenteredCoordinates then
3139 begin
3140 Orig -= PointF(0.5,0.5);
3141 HAxis -= PointF(0.5,0.5);
3142 VAxis -= PointF(0.5,0.5);
3143 end;
3144 pts3 := HAxis+(VAxis-Orig);
3145 affine := TBGRAAffineBitmapTransform.Create(AImage,False,AImage.ScanInterpolationFilter,not APixelCenteredCoordinates);
3146 affine.GlobalOpacity:= AOpacity;
3147 affine.Fit(Orig,HAxis,VAxis);
3148 FillPolyAntialias([Orig,HAxis,pts3,VAxis],affine);
3149 affine.Free;
3150end;
3151
3152procedure TBGRADefaultBitmap.FillPolyLinearMapping(const points: array of TPointF;
3153 texture: IBGRAScanner; texCoords: array of TPointF;
3154 TextureInterpolation: Boolean);
3155begin
3156 PolygonLinearTextureMappingAliased(self,points,texture,texCoords,TextureInterpolation, FillMode = fmWinding);
3157end;
3158
3159procedure TBGRADefaultBitmap.FillPolyLinearMappingLightness(
3160 const points: array of TPointF; texture: IBGRAScanner;
3161 texCoords: array of TPointF; lightnesses: array of word;
3162 TextureInterpolation: Boolean);
3163begin
3164 PolygonLinearTextureMappingAliasedWithLightness(self,points,texture,texCoords,TextureInterpolation,lightnesses,FillMode = fmWinding);
3165end;
3166
3167procedure TBGRADefaultBitmap.FillPolyLinearColor(
3168 const points: array of TPointF; AColors: array of TBGRAPixel);
3169begin
3170 PolygonLinearColorGradientAliased(self,points,AColors, FillMode = fmWinding);
3171end;
3172
3173procedure TBGRADefaultBitmap.FillPolyPerspectiveMapping(
3174 const points: array of TPointF; const pointsZ: array of single;
3175 texture: IBGRAScanner; texCoords: array of TPointF;
3176 TextureInterpolation: Boolean; zbuffer: psingle);
3177begin
3178 PolygonPerspectiveTextureMappingAliased(self,points,pointsZ,texture,texCoords,TextureInterpolation, FillMode = fmWinding, zbuffer);
3179end;
3180
3181procedure TBGRADefaultBitmap.FillPolyPerspectiveMappingLightness(
3182 const points: array of TPointF; const pointsZ: array of single;
3183 texture: IBGRAScanner; texCoords: array of TPointF;
3184 lightnesses: array of word; TextureInterpolation: Boolean; zbuffer: psingle);
3185begin
3186 PolygonPerspectiveTextureMappingAliasedWithLightness(self,points,pointsZ,texture,texCoords,TextureInterpolation,lightnesses, FillMode = fmWinding, zbuffer);
3187end;
3188
3189procedure TBGRADefaultBitmap.FillPoly(const points: array of TPointF;
3190 c: TBGRAPixel; drawmode: TDrawMode; APixelCenteredCoordinates: boolean);
3191begin
3192 BGRAPolygon.FillPolyAliased(self, points, c, FEraseMode, FillMode = fmWinding, drawmode, APixelCenteredCoordinates);
3193end;
3194
3195procedure TBGRADefaultBitmap.FillPoly(const points: array of TPointF;
3196 texture: IBGRAScanner; drawmode: TDrawMode; APixelCenteredCoordinates: boolean);
3197begin
3198 BGRAPolygon.FillPolyAliasedWithTexture(self, points, texture, FillMode = fmWinding, drawmode, APixelCenteredCoordinates);
3199end;
3200
3201procedure TBGRADefaultBitmap.EraseLineAntialias(x1, y1, x2, y2: single;
3202 alpha: byte; w: single);
3203begin
3204 FEraseMode := True;
3205 DrawLineAntialias(x1,y1,x2,y2, BGRA(0,0,0,alpha),w);
3206 FEraseMode := False;
3207end;
3208
3209procedure TBGRADefaultBitmap.FillPolyAntialias(const points: array of TPointF; c: TBGRAPixel; APixelCenteredCoordinates: boolean);
3210begin
3211 BGRAPolygon.FillPolyAntialias(self, points, c, FEraseMode, FillMode = fmWinding, LinearAntialiasing, APixelCenteredCoordinates);
3212end;
3213
3214procedure TBGRADefaultBitmap.FillPolyAntialias(const points: array of TPointF;
3215 texture: IBGRAScanner; APixelCenteredCoordinates: boolean);
3216begin
3217 BGRAPolygon.FillPolyAntialiasWithTexture(self, points, texture, FillMode = fmWinding, LinearAntialiasing, APixelCenteredCoordinates);
3218end;
3219
3220procedure TBGRADefaultBitmap.ErasePoly(const points: array of TPointF;
3221 alpha: byte; APixelCenteredCoordinates: boolean);
3222begin
3223 BGRAPolygon.FillPolyAliased(self, points, BGRA(0, 0, 0, alpha), True, FillMode = fmWinding, dmDrawWithTransparency, APixelCenteredCoordinates);
3224end;
3225
3226procedure TBGRADefaultBitmap.ErasePolyAntialias(const points: array of TPointF; alpha: byte; APixelCenteredCoordinates: boolean);
3227begin
3228 FEraseMode := True;
3229 FillPolyAntialias(points, BGRA(0, 0, 0, alpha), APixelCenteredCoordinates);
3230 FEraseMode := False;
3231end;
3232
3233procedure TBGRADefaultBitmap.FillShape(shape: TBGRACustomFillInfo; c: TBGRAPixel;
3234 drawmode: TDrawMode);
3235begin
3236 BGRAPolygon.FillShapeAliased(self, shape, c, FEraseMode, nil, FillMode = fmWinding, drawmode);
3237end;
3238
3239procedure TBGRADefaultBitmap.FillShape(shape: TBGRACustomFillInfo;
3240 texture: IBGRAScanner; drawmode: TDrawMode);
3241begin
3242 BGRAPolygon.FillShapeAliased(self, shape, BGRAPixelTransparent, false, texture, FillMode = fmWinding, drawmode);
3243end;
3244
3245procedure TBGRADefaultBitmap.FillShapeAntialias(shape: TBGRACustomFillInfo;
3246 c: TBGRAPixel);
3247begin
3248 BGRAPolygon.FillShapeAntialias(self, shape, c, FEraseMode, nil, FillMode = fmWinding, LinearAntialiasing);
3249end;
3250
3251procedure TBGRADefaultBitmap.FillShapeAntialias(shape: TBGRACustomFillInfo;
3252 texture: IBGRAScanner);
3253begin
3254 BGRAPolygon.FillShapeAntialiasWithTexture(self, shape, texture, FillMode = fmWinding, LinearAntialiasing);
3255end;
3256
3257procedure TBGRADefaultBitmap.EraseShape(shape: TBGRACustomFillInfo; alpha: byte);
3258begin
3259 BGRAPolygon.FillShapeAliased(self, shape, BGRA(0, 0, 0, alpha), True, nil, FillMode = fmWinding, dmDrawWithTransparency);
3260end;
3261
3262procedure TBGRADefaultBitmap.EraseShapeAntialias(shape: TBGRACustomFillInfo;
3263 alpha: byte);
3264begin
3265 FEraseMode := True;
3266 FillShapeAntialias(shape, BGRA(0, 0, 0, alpha));
3267 FEraseMode := False;
3268end;
3269
3270procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
3271 AStrokeColor: TBGRAPixel; AWidth: single; AFillColor: TBGRAPixel);
3272begin
3273 DrawPath(APath,AffineMatrixIdentity,AStrokeColor,AWidth,AFillColor);
3274end;
3275
3276procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
3277 AStrokeTexture: IBGRAScanner; AWidth: single; AFillColor: TBGRAPixel);
3278begin
3279 DrawPath(APath,AffineMatrixIdentity,AStrokeTexture,AWidth,AFillColor);
3280end;
3281
3282procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
3283 AStrokeColor: TBGRAPixel; AWidth: single; AFillTexture: IBGRAScanner);
3284begin
3285 DrawPath(APath,AffineMatrixIdentity,AStrokeColor,AWidth,AFillTexture);
3286end;
3287
3288procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath;
3289 AStrokeTexture: IBGRAScanner; AWidth: single; AFillTexture: IBGRAScanner);
3290begin
3291 DrawPath(APath,AffineMatrixIdentity,AStrokeTexture,AWidth,AFillTexture);
3292end;
3293
3294procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AStrokeColor: TBGRAPixel; AWidth: single);
3295begin
3296 DrawPath(APath, AffineMatrixIdentity, AStrokeColor, AWidth);
3297end;
3298
3299procedure TBGRADefaultBitmap.DrawPath(APath: IBGRAPath; AStrokeTexture: IBGRAScanner; AWidth: single);
3300begin
3301 DrawPath(APath, AffineMatrixIdentity, AStrokeTexture, AWidth);
3302end;
3303
3304procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
3305 c: TBGRAPixel; w: single);
3306begin
3307 if (PenStyle = psClear) or (c.alpha = 0) or (w = 0) then exit;
3308 if (PenStyle = psSolid) then
3309 BGRAPolygon.BorderEllipseAntialias(self, x, y, rx, ry, w, c, FEraseMode, LinearAntialiasing)
3310 else
3311 DrawPolygonAntialias(ComputeEllipseContour(x,y,rx,ry),c,w);
3312end;
3313
3314procedure TBGRADefaultBitmap.EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF;
3315 c: TBGRAPixel; w: single);
3316begin
3317 if (PenStyle = psClear) or (c.alpha = 0) or (w = 0) then exit;
3318 DrawPolygonAntialias(ComputeEllipseContour(AOrigin, AXAxis, AYAxis),c,w);
3319end;
3320
3321procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
3322 texture: IBGRAScanner; w: single);
3323begin
3324 if (PenStyle = psClear) or (w = 0) then exit;
3325 if (PenStyle = psSolid) then
3326 BGRAPolygon.BorderEllipseAntialiasWithTexture(self, x, y, rx, ry, w, texture, LinearAntialiasing)
3327 else
3328 DrawPolygonAntialias(ComputeEllipseContour(x,y,rx,ry),texture,w);
3329end;
3330
3331procedure TBGRADefaultBitmap.EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF;
3332 texture: IBGRAScanner; w: single);
3333begin
3334 if (PenStyle = psClear) or (w = 0) then exit;
3335 DrawPolygonAntialias(ComputeEllipseContour(AOrigin, AXAxis, AYAxis),texture,w);
3336end;
3337
3338procedure TBGRADefaultBitmap.EllipseAntialias(x, y, rx, ry: single;
3339 c: TBGRAPixel; w: single; back: TBGRAPixel);
3340var multi: TBGRAMultishapeFiller;
3341 hw: single;
3342begin
3343 if (w=0) or (PenStyle = psClear) or (c.alpha = 0) then
3344 begin
3345 FillEllipseAntialias(x, y, rx, ry, back);
3346 exit;
3347 end;
3348 rx := abs(rx);
3349 ry := abs(ry);
3350 hw := w/2;
3351 if (rx <= hw) or (ry <= hw) then
3352 begin
3353 FillEllipseAntialias(x,y,rx+hw,ry+hw,c);
3354 exit;
3355 end;
3356 { use multishape filler for fine junction between polygons }
3357 multi := TBGRAMultishapeFiller.Create;
3358 if (PenStyle = psSolid) then
3359 begin
3360 if back.alpha <> 0 then multi.AddEllipse(x,y,rx-hw,ry-hw,back);
3361 multi.AddEllipseBorder(x,y,rx,ry,w,c)
3362 end
3363 else
3364 begin
3365 if back.alpha <> 0 then multi.AddEllipse(x,y,rx,ry,back);
3366 multi.AddPolygon(ComputeWidePolygon(ComputeEllipseContour(x,y,rx,ry),w),c);
3367 end;
3368 multi.PolygonOrder := poLastOnTop;
3369 multi.Draw(self);
3370 multi.Free;
3371end;
3372
3373procedure TBGRADefaultBitmap.EllipseAntialias(AOrigin, AXAxis, AYAxis: TPointF;
3374 c: TBGRAPixel; w: single; back: TBGRAPixel);
3375var multi: TBGRAMultishapeFiller;
3376 pts: ArrayOfTPointF;
3377begin
3378 if (w=0) or (PenStyle = psClear) or (c.alpha = 0) then
3379 begin
3380 FillEllipseAntialias(AOrigin, AXAxis, AYAxis, back);
3381 exit;
3382 end;
3383 { use multishape filler for fine junction between polygons }
3384 multi := TBGRAMultishapeFiller.Create;
3385 pts := ComputeEllipseContour(AOrigin, AXAxis, AYAxis);
3386 if back.alpha <> 0 then multi.AddPolygon(pts, back);
3387 pts := ComputeWidePolygon(pts,w);
3388 multi.AddPolygon(pts,c);
3389 multi.PolygonOrder := poLastOnTop;
3390 multi.Draw(self);
3391 multi.Free;
3392end;
3393
3394procedure TBGRADefaultBitmap.FillEllipseAntialias(x, y, rx, ry: single; c: TBGRAPixel);
3395begin
3396 BGRAPolygon.FillEllipseAntialias(self, x, y, rx, ry, c, FEraseMode, LinearAntialiasing);
3397end;
3398
3399procedure TBGRADefaultBitmap.FillEllipseAntialias(AOrigin, AXAxis,
3400 AYAxis: TPointF; c: TBGRAPixel);
3401var
3402 pts: array of TPointF;
3403begin
3404 if c.alpha = 0 then exit;
3405 pts := ComputeEllipseContour(AOrigin,AXAxis,AYAxis);
3406 FillPolyAntialias(pts, c);
3407end;
3408
3409procedure TBGRADefaultBitmap.FillEllipseAntialias(x, y, rx, ry: single;
3410 texture: IBGRAScanner);
3411begin
3412 BGRAPolygon.FillEllipseAntialiasWithTexture(self, x, y, rx, ry, texture, LinearAntialiasing);
3413end;
3414
3415procedure TBGRADefaultBitmap.FillEllipseAntialias(AOrigin, AXAxis,
3416 AYAxis: TPointF; texture: IBGRAScanner);
3417var
3418 pts: array of TPointF;
3419begin
3420 pts := ComputeEllipseContour(AOrigin,AXAxis,AYAxis);
3421 FillPolyAntialias(pts, texture);
3422end;
3423
3424procedure TBGRADefaultBitmap.FillEllipseLinearColorAntialias(x, y, rx,
3425 ry: single; outercolor, innercolor: TBGRAPixel);
3426var
3427 grad: TBGRAGradientScanner;
3428 affine: TBGRAAffineScannerTransform;
3429begin
3430 if (rx=0) or (ry=0) then exit;
3431 if rx=ry then
3432 begin
3433 grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(x,y),PointF(x+rx,y),True);
3434 FillEllipseAntialias(x,y,rx,ry,grad);
3435 grad.Free;
3436 end else
3437 begin
3438 grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(0,0),PointF(1,0),True);
3439 affine := TBGRAAffineScannerTransform.Create(grad);
3440 affine.Scale(rx,ry);
3441 affine.Translate(x,y);
3442 FillEllipseAntialias(x,y,rx,ry,affine);
3443 affine.Free;
3444 grad.Free;
3445 end;
3446end;
3447
3448procedure TBGRADefaultBitmap.FillEllipseLinearColorAntialias(AOrigin, AXAxis,
3449 AYAxis: TPointF; outercolor, innercolor: TBGRAPixel);
3450var
3451 grad: TBGRAGradientScanner;
3452 affine: TBGRAAffineScannerTransform;
3453begin
3454 grad := TBGRAGradientScanner.Create(innercolor,outercolor,gtRadial,PointF(0,0),PointF(1,0),True);
3455 affine := TBGRAAffineScannerTransform.Create(grad);
3456 affine.Fit(AOrigin,AXAxis,AYAxis);
3457 FillEllipseAntialias(AOrigin,AXAxis,AYAxis,affine);
3458 affine.Free;
3459 grad.Free;
3460end;
3461
3462procedure TBGRADefaultBitmap.EraseEllipseAntialias(x, y, rx, ry: single; alpha: byte);
3463begin
3464 FEraseMode := True;
3465 FillEllipseAntialias(x, y, rx, ry, BGRA(0, 0, 0, alpha));
3466 FEraseMode := False;
3467end;
3468
3469procedure TBGRADefaultBitmap.EraseEllipseAntialias(AOrigin, AXAxis,
3470 AYAxis: TPointF; alpha: byte);
3471begin
3472 FEraseMode := True;
3473 FillEllipseAntialias(AOrigin, AXAxis, AYAxis, BGRA(0, 0, 0, alpha));
3474 FEraseMode := False;
3475end;
3476
3477procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
3478 c: TBGRAPixel; w: single; back: TBGRAPixel);
3479var
3480 bevel: single;
3481 multi: TBGRAMultishapeFiller;
3482 hw: single;
3483begin
3484 if (PenStyle = psClear) or (c.alpha=0) or (w=0) then
3485 begin
3486 if back <> BGRAPixelTransparent then
3487 FillRectAntialias(x,y,x2,y2,back);
3488 exit;
3489 end;
3490
3491 hw := w/2;
3492 if not CheckAntialiasRectBounds(x,y,x2,y2,w) then
3493 begin
3494 if JoinStyle = pjsBevel then
3495 begin
3496 bevel := (2-sqrt(2))*hw;
3497 FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, c, [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]);
3498 end else
3499 if JoinStyle = pjsRound then
3500 FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, c)
3501 else
3502 FillRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, c);
3503 exit;
3504 end;
3505
3506 { use multishape filler for fine junction between polygons }
3507 multi := TBGRAMultishapeFiller.Create;
3508 multi.FillMode := FillMode;
3509 if (JoinStyle = pjsMiter) and (PenStyle = psSolid) then
3510 multi.AddRectangleBorder(x,y,x2,y2,w,c)
3511 else
3512 multi.AddPolygon(ComputeWidePolygon([Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)],w),c);
3513
3514 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
3515 FillRect(ceil(x + hw), ceil(y + hw), ceil(x2 - hw), ceil(y2 - hw), back, dmDrawWithTransparency)
3516 else
3517 multi.AddRectangle(x + hw, y + hw, x2 - hw, y2 - hw, back);
3518 multi.Draw(self);
3519 multi.Free;
3520end;
3521
3522procedure TBGRADefaultBitmap.RectangleAntialias(x, y, x2, y2: single;
3523 texture: IBGRAScanner; w: single);
3524var
3525 bevel,hw: single;
3526 multi: TBGRAMultishapeFiller;
3527begin
3528 if (PenStyle = psClear) or (w=0) then exit;
3529
3530 hw := w/2;
3531 if not CheckAntialiasRectBounds(x,y,x2,y2,w) then
3532 begin
3533 if JoinStyle = pjsBevel then
3534 begin
3535 bevel := (2-sqrt(2))*hw;
3536 FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, bevel,bevel, texture, [rrTopLeftBevel, rrTopRightBevel, rrBottomLeftBevel, rrBottomRightBevel]);
3537 end else
3538 if JoinStyle = pjsRound then
3539 FillRoundRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, hw,hw, texture)
3540 else
3541 FillRectAntialias(x - hw, y - hw, x2 + hw, y2 + hw, texture);
3542 exit;
3543 end;
3544
3545 { use multishape filler for fine junction between polygons }
3546 multi := TBGRAMultishapeFiller.Create;
3547 multi.FillMode := FillMode;
3548 if (JoinStyle = pjsMiter) and (PenStyle = psSolid) then
3549 multi.AddRectangleBorder(x,y,x2,y2,w, texture)
3550 else
3551 multi.AddPolygon(ComputeWidePolygon([Pointf(x,y),Pointf(x2,y),Pointf(x2,y2),Pointf(x,y2)],w), texture);
3552 multi.Draw(self);
3553 multi.Free;
3554end;
3555
3556procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
3557 c: TBGRAPixel; w: single; options: TRoundRectangleOptions);
3558begin
3559 if (PenStyle = psClear) or (c.alpha = 0) then exit;
3560 if (PenStyle = psSolid) then
3561 BGRAPolygon.BorderRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,c,False, LinearAntialiasing)
3562 else
3563 DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),c,w);
3564end;
3565
3566procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
3567 pencolor: TBGRAPixel; w: single; fillcolor: TBGRAPixel;
3568 options: TRoundRectangleOptions);
3569var
3570 multi: TBGRAMultishapeFiller;
3571begin
3572 if (PenStyle = psClear) or (pencolor.alpha = 0) then
3573 begin
3574 FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillColor,options);
3575 exit;
3576 end;
3577 if (PenStyle = psSolid) then
3578 BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,pencolor,fillcolor,nil,nil,False)
3579 else
3580 begin
3581 multi := TBGRAMultishapeFiller.Create;
3582 multi.PolygonOrder := poLastOnTop;
3583 multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillColor,options);
3584 multi.AddPolygon(ComputeWidePolygon(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),pencolor);
3585 multi.Draw(self);
3586 multi.Free;
3587 end;
3588end;
3589
3590procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
3591 penTexture: IBGRAScanner; w: single; fillTexture: IBGRAScanner;
3592 options: TRoundRectangleOptions);
3593var
3594 multi: TBGRAMultishapeFiller;
3595begin
3596 if (PenStyle = psClear) then
3597 begin
3598 FillRoundRectAntialias(x,y,x2,y2,rx,ry,fillTexture,options);
3599 exit;
3600 end else
3601 if (PenStyle = psSolid) then
3602 BGRAPolygon.BorderAndFillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,w,options,BGRAPixelTransparent,BGRAPixelTransparent,pentexture,filltexture,False)
3603 else
3604 begin
3605 multi := TBGRAMultishapeFiller.Create;
3606 multi.PolygonOrder := poLastOnTop;
3607 multi.AddRoundRectangle(x,y,x2,y2,rx,ry,fillTexture,options);
3608 multi.AddPolygon(ComputeWidePolygon(ComputeRoundRect(x,y,x2,y2,rx,ry,options),w),penTexture);
3609 multi.Draw(self);
3610 multi.Free;
3611 end;
3612end;
3613
3614procedure TBGRADefaultBitmap.RoundRectAntialias(x, y, x2, y2, rx, ry: single;
3615 texture: IBGRAScanner; w: single; options: TRoundRectangleOptions);
3616begin
3617 if (PenStyle = psClear) then exit;
3618 if (PenStyle = psSolid) then
3619 BGRAPolygon.BorderRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,w,options,texture, LinearAntialiasing)
3620 else
3621 DrawPolygonAntialias(BGRAPath.ComputeRoundRect(x,y,x2,y2,rx,ry,options),texture,w);
3622end;
3623
3624function TBGRADefaultBitmap.CheckRectBounds(var x, y, x2, y2: integer; minsize: integer): boolean; inline;
3625var
3626 temp: integer;
3627begin
3628 //swap coordinates if needed
3629 if (x > x2) then
3630 begin
3631 temp := x;
3632 x := x2;
3633 x2 := temp;
3634 end;
3635 if (y > y2) then
3636 begin
3637 temp := y;
3638 y := y2;
3639 y2 := temp;
3640 end;
3641 if (x2 - x <= minsize) or (y2 - y <= minsize) then
3642 begin
3643 result := false;
3644 exit;
3645 end else
3646 result := true;
3647end;
3648
3649procedure TBGRADefaultBitmap.Rectangle(x, y, x2, y2: integer;
3650 c: TBGRAPixel; mode: TDrawMode);
3651begin
3652 if not CheckRectBounds(x,y,x2,y2,1) then exit;
3653 case mode of
3654 dmFastBlend:
3655 begin
3656 FastBlendHorizLine(x, y, x2 - 1, c);
3657 FastBlendHorizLine(x, y2 - 1, x2 - 1, c);
3658 if y2 - y > 2 then
3659 begin
3660 FastBlendVertLine(x, y + 1, y2 - 2, c);
3661 FastBlendVertLine(x2 - 1, y + 1, y2 - 2, c);
3662 end;
3663 end;
3664 dmDrawWithTransparency:
3665 begin
3666 DrawHorizLine(x, y, x2 - 1, c);
3667 DrawHorizLine(x, y2 - 1, x2 - 1, c);
3668 if y2 - y > 2 then
3669 begin
3670 DrawVertLine(x, y + 1, y2 - 2, c);
3671 DrawVertLine(x2 - 1, y + 1, y2 - 2, c);
3672 end;
3673 end;
3674 dmSet:
3675 begin
3676 SetHorizLine(x, y, x2 - 1, c);
3677 SetHorizLine(x, y2 - 1, x2 - 1, c);
3678 if y2 - y > 2 then
3679 begin
3680 SetVertLine(x, y + 1, y2 - 2, c);
3681 SetVertLine(x2 - 1, y + 1, y2 - 2, c);
3682 end;
3683 end;
3684 dmXor:
3685 begin
3686 XorHorizLine(x, y, x2 - 1, c);
3687 XorHorizLine(x, y2 - 1, x2 - 1, c);
3688 if y2 - y > 2 then
3689 begin
3690 XorVertLine(x, y + 1, y2 - 2, c);
3691 XorVertLine(x2 - 1, y + 1, y2 - 2, c);
3692 end;
3693 end;
3694 dmSetExceptTransparent: if (c.alpha = 255) then
3695 Rectangle(x, y, x2, y2, c, dmSet);
3696 end;
3697end;
3698
3699procedure TBGRADefaultBitmap.Rectangle(x, y, x2, y2: integer;
3700 BorderColor, FillColor: TBGRAPixel; mode: TDrawMode);
3701begin
3702 if not CheckRectBounds(x,y,x2,y2,1) then exit;
3703 Rectangle(x, y, x2, y2, BorderColor, mode);
3704 FillRect(x + 1, y + 1, x2 - 1, y2 - 1, FillColor, mode);
3705end;
3706
3707function TBGRADefaultBitmap.CheckClippedRectBounds(var x, y, x2, y2: integer): boolean; inline;
3708var
3709 temp: integer;
3710begin
3711 if (x > x2) then
3712 begin
3713 temp := x;
3714 x := x2;
3715 x2 := temp;
3716 end;
3717 if (y > y2) then
3718 begin
3719 temp := y;
3720 y := y2;
3721 y2 := temp;
3722 end;
3723 if (x >= FClipRect.Right) or (x2 <= FClipRect.Left) or (y >= FClipRect.Bottom) or (y2 <= FClipRect.Top) then
3724 begin
3725 result := false;
3726 exit;
3727 end;
3728 if x < FClipRect.Left then
3729 x := FClipRect.Left;
3730 if x2 > FClipRect.Right then
3731 x2 := FClipRect.Right;
3732 if y < FClipRect.Top then
3733 y := FClipRect.Top;
3734 if y2 > FClipRect.Bottom then
3735 y2 := FClipRect.Bottom;
3736 if (x2 - x <= 0) or (y2 - y <= 0) then
3737 begin
3738 result := false;
3739 exit;
3740 end else
3741 result := true;
3742end;
3743
3744procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer; c: TBGRAPixel;
3745 mode: TDrawMode);
3746var
3747 yb, tx, delta: integer;
3748 p: PBGRAPixel;
3749begin
3750 if not CheckClippedRectBounds(x,y,x2,y2) then exit;
3751 tx := x2 - x;
3752 Dec(x2);
3753 Dec(y2);
3754
3755 if mode = dmSetExceptTransparent then
3756 begin
3757 if (c.alpha = 255) then
3758 FillRect(x, y, x2, y2, c, dmSet);
3759 end else
3760 begin
3761 if (mode <> dmSet) and (mode <> dmXor) and (c.alpha = 0) then exit;
3762
3763 p := Scanline[y] + x;
3764 if FLineOrder = riloBottomToTop then
3765 delta := -Width
3766 else
3767 delta := Width;
3768
3769 case mode of
3770 dmFastBlend:
3771 for yb := y2 - y downto 0 do
3772 begin
3773 FastBlendPixelsInline(p, c, tx);
3774 Inc(p, delta);
3775 end;
3776 dmDrawWithTransparency:
3777 for yb := y2 - y downto 0 do
3778 begin
3779 DrawPixelsInline(p, c, tx);
3780 Inc(p, delta);
3781 end;
3782 dmSet:
3783 for yb := y2 - y downto 0 do
3784 begin
3785 FillInline(p, c, tx);
3786 Inc(p, delta);
3787 end;
3788 dmXor:
3789 if DWord(c) = 0 then exit
3790 else
3791 for yb := y2 - y downto 0 do
3792 begin
3793 XorInline(p, c, tx);
3794 Inc(p, delta);
3795 end;
3796 end;
3797
3798 InvalidateBitmap;
3799 end;
3800end;
3801
3802procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer;
3803 texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint);
3804var
3805 yb, tx, delta: integer;
3806 p: PBGRAPixel;
3807begin
3808 if not CheckClippedRectBounds(x,y,x2,y2) then exit;
3809 tx := x2 - x;
3810 Dec(x2);
3811 Dec(y2);
3812
3813 p := Scanline[y] + x;
3814 if FLineOrder = riloBottomToTop then
3815 delta := -Width
3816 else
3817 delta := Width;
3818
3819 for yb := y to y2 do
3820 begin
3821 texture.ScanMoveTo(x+AScanOffset.X,yb+AScanOffset.Y);
3822 ScannerPutPixels(texture, p, tx, mode);
3823 Inc(p, delta);
3824 end;
3825
3826 InvalidateBitmap;
3827end;
3828
3829procedure TBGRADefaultBitmap.FillRect(x, y, x2, y2: integer;
3830 texture: IBGRAScanner; mode: TDrawMode; AScanOffset: TPoint; ditheringAlgorithm: TDitheringAlgorithm);
3831var dither: TDitheringTask;
3832begin
3833 if not CheckClippedRectBounds(x,y,x2,y2) then exit;
3834 dither := CreateDitheringTask(ditheringAlgorithm, texture, self, rect(x,y,x2,y2));
3835 dither.ScanOffset := AScanOffset;
3836 dither.DrawMode := mode;
3837 dither.Execute;
3838 dither.Free;
3839end;
3840
3841procedure TBGRADefaultBitmap.AlphaFillRect(x, y, x2, y2: integer; alpha: byte);
3842var
3843 yb, tx, delta: integer;
3844 p: PBGRAPixel;
3845begin
3846 if alpha = 0 then
3847 begin
3848 FillRect(x, y, x2, y2, BGRAPixelTransparent, dmSet);
3849 exit;
3850 end;
3851
3852 if not CheckClippedRectBounds(x,y,x2,y2) then exit;
3853 tx := x2 - x;
3854 Dec(x2);
3855 Dec(y2);
3856
3857 p := Scanline[y] + x;
3858 if FLineOrder = riloBottomToTop then
3859 delta := -Width
3860 else
3861 delta := Width;
3862 for yb := y2 - y downto 0 do
3863 begin
3864 AlphaFillInline(p, alpha, tx);
3865 Inc(p, delta);
3866 end;
3867 InvalidateBitmap;
3868end;
3869
3870procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single; c: TBGRAPixel; pixelCenteredCoordinates: boolean);
3871var tx,ty: single;
3872begin
3873 if not pixelCenteredCoordinates then
3874 begin
3875 x -= 0.5;
3876 y -= 0.5;
3877 x2 -= 0.5;
3878 y2 -= 0.5;
3879 end;
3880
3881 tx := x2-x;
3882 ty := y2-y;
3883 if (abs(tx)<1e-3) or (abs(ty)<1e-3) then exit;
3884 if (abs(tx) > 2) and (abs(ty) > 2) then
3885 begin
3886 if (tx < 0) then
3887 begin
3888 tx := -tx;
3889 x := x2;
3890 x2 := x+tx;
3891 end;
3892 if (ty < 0) then
3893 begin
3894 ty := -ty;
3895 y := y2;
3896 y2 := y+ty;
3897 end;
3898 FillRectAntialias(x,y,x2,ceil(y)+0.5,c);
3899 FillRectAntialias(x,ceil(y)+0.5,ceil(x)+0.5,floor(y2)-0.5,c);
3900 FillRectAntialias(floor(x2)-0.5,ceil(y)+0.5,x2,floor(y2)-0.5,c);
3901 FillRectAntialias(x,floor(y2)-0.5,x2,y2,c);
3902 FillRect(ceil(x)+1,ceil(y)+1,floor(x2),floor(y2),c,dmDrawWithTransparency);
3903 end else
3904 FillPolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], c);
3905end;
3906
3907procedure TBGRADefaultBitmap.EraseRectAntialias(x, y, x2, y2: single;
3908 alpha: byte; pixelCenteredCoordinates: boolean);
3909begin
3910 if not pixelCenteredCoordinates then
3911 begin
3912 x -= 0.5;
3913 y -= 0.5;
3914 x2 -= 0.5;
3915 y2 -= 0.5;
3916 end;
3917 ErasePolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], alpha);
3918end;
3919
3920procedure TBGRADefaultBitmap.FillRectAntialias(x, y, x2, y2: single;
3921 texture: IBGRAScanner; pixelCenteredCoordinates: boolean);
3922begin
3923 if not pixelCenteredCoordinates then
3924 begin
3925 x -= 0.5;
3926 y -= 0.5;
3927 x2 -= 0.5;
3928 y2 -= 0.5;
3929 end;
3930 FillPolyAntialias([pointf(x, y), pointf(x2, y), pointf(x2, y2), pointf(x, y2)], texture);
3931end;
3932
3933procedure TBGRADefaultBitmap.FillRoundRectAntialias(x, y, x2, y2, rx,ry: single;
3934 c: TBGRAPixel; options: TRoundRectangleOptions; pixelCenteredCoordinates: boolean);
3935begin
3936 BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,c,False, LinearAntialiasing, pixelCenteredCoordinates);
3937end;
3938
3939procedure TBGRADefaultBitmap.FillRoundRectAntialias(x, y, x2, y2, rx,
3940 ry: single; texture: IBGRAScanner; options: TRoundRectangleOptions; pixelCenteredCoordinates: boolean);
3941begin
3942 BGRAPolygon.FillRoundRectangleAntialiasWithTexture(self,x,y,x2,y2,rx,ry,options,texture, LinearAntialiasing, pixelCenteredCoordinates);
3943end;
3944
3945procedure TBGRADefaultBitmap.EraseRoundRectAntialias(x, y, x2, y2, rx,
3946 ry: single; alpha: byte; options: TRoundRectangleOptions; pixelCenteredCoordinates: boolean);
3947begin
3948 BGRAPolygon.FillRoundRectangleAntialias(self,x,y,x2,y2,rx,ry,options,BGRA(0,0,0,alpha),True, LinearAntialiasing, pixelCenteredCoordinates);
3949end;
3950
3951procedure TBGRADefaultBitmap.Ellipse(x, y, rx, ry: single; c: TBGRAPixel;
3952 w: single; ADrawMode: TDrawMode);
3953begin
3954 if (PenStyle = psClear) or (c.alpha = 0) or (w = 0) then exit;
3955 if (PenStyle = psSolid) then
3956 BGRAPolygon.BorderEllipse(self, x, y, rx, ry, w, c, FEraseMode, ADrawMode)
3957 else
3958 FillPoly(ComputeWidePolygon(ComputeEllipseContour(x,y,rx,ry),w),c, ADrawMode);
3959end;
3960
3961procedure TBGRADefaultBitmap.Ellipse(AOrigin, AXAxis, AYAxis: TPointF;
3962 c: TBGRAPixel; w: single; ADrawMode: TDrawMode);
3963begin
3964 if (PenStyle = psClear) or (c.alpha = 0) or (w = 0) then exit;
3965 FillPoly(ComputeWidePolygon(ComputeEllipseContour(AOrigin, AXAxis, AYAxis),w),c,ADrawMode);
3966end;
3967
3968procedure TBGRADefaultBitmap.RoundRect(X1, Y1, X2, Y2: integer;
3969 DX, DY: integer; BorderColor, FillColor: TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency);
3970begin
3971 BGRARoundRectAliased(self,X1,Y1,X2,Y2,DX,DY,BorderColor,FillColor,nil,ADrawMode);
3972end;
3973
3974procedure TBGRADefaultBitmap.RoundRect(X1, Y1, X2, Y2: integer; DX,
3975 DY: integer; BorderColor: TBGRAPixel; ADrawMode: TDrawMode);
3976begin
3977 BGRARoundRectAliased(self,X1,Y1,X2,Y2,DX,DY,BorderColor,BGRAPixelTransparent,nil,ADrawMode,true);
3978end;
3979
3980procedure TBGRADefaultBitmap.FillRoundRect(X1, Y1, X2, Y2: integer; DX,
3981 DY: integer; FillTexture: IBGRAScanner; ADrawMode: TDrawMode);
3982begin
3983 BGRAFillRoundRectAliased(self,X1,Y1,X2,Y2,DX,DY,BGRAPixelTransparent,FillTexture,ADrawMode);
3984end;
3985
3986{------------------------- Text functions ---------------------------------------}
3987
3988procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; orientationTenthDegCCW: integer;
3989 sUTF8: string; c: TBGRAPixel; align: TAlignment);
3990begin
3991 with (PointF(x,y)-GetFontAnchorRotatedOffset(orientationTenthDegCCW)) do
3992 FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),c,align);
3993end;
3994
3995procedure TBGRADefaultBitmap.TextOutAngle(x, y: single; orientationTenthDegCCW: integer;
3996 sUTF8: string; texture: IBGRAScanner; align: TAlignment);
3997begin
3998 with (PointF(x,y)-GetFontAnchorRotatedOffset(orientationTenthDegCCW)) do
3999 FontRenderer.TextOutAngle(self,x,y,orientationTenthDegCCW,CleanTextOutString(sUTF8),texture,align);
4000end;
4001
4002procedure TBGRADefaultBitmap.TextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; AColor: TBGRAPixel; AAlign: TAlignment; ALetterSpacing: single);
4003begin
4004 InternalTextOutCurved(ACursor, sUTF8, AColor, nil, AAlign, ALetterSpacing);
4005end;
4006
4007procedure TBGRADefaultBitmap.TextOutCurved(ACursor: TBGRACustomPathCursor; sUTF8: string; ATexture: IBGRAScanner; AAlign: TAlignment; ALetterSpacing: single);
4008begin
4009 InternalTextOutCurved(ACursor, sUTF8, BGRAPixelTransparent, ATexture, AAlign, ALetterSpacing);
4010end;
4011
4012procedure TBGRADefaultBitmap.TextMultiline(ALeft, ATop, AWidth: single; sUTF8: string;
4013 c: TBGRAPixel; AAlign: TBidiTextAlignment; AVertAlign: TTextLayout; AParagraphSpacing: single);
4014var
4015 layout: TBidiTextLayout;
4016 i: Integer;
4017begin
4018 if FontBidiMode = fbmAuto then
4019 layout := TBidiTextLayout.Create(FontRenderer, sUTF8)
4020 else
4021 layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8));
4022 for i := 0 to layout.ParagraphCount-1 do
4023 layout.ParagraphAlignment[i] := AAlign;
4024 layout.ParagraphSpacingBelow:= AParagraphSpacing;
4025 layout.AvailableWidth := AWidth;
4026 case AVertAlign of
4027 tlBottom: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight);
4028 tlCenter: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight/2);
4029 else layout.TopLeft := PointF(ALeft,ATop);
4030 end;
4031 layout.DrawText(self, c);
4032 layout.Free;
4033end;
4034
4035procedure TBGRADefaultBitmap.TextMultiline(ALeft, ATop, AWidth: single;
4036 sUTF8: string; ATexture: IBGRAScanner; AAlign: TBidiTextAlignment;
4037 AVertAlign: TTextLayout; AParagraphSpacing: single);
4038var
4039 layout: TBidiTextLayout;
4040 i: Integer;
4041begin
4042 if FontBidiMode = fbmAuto then
4043 layout := TBidiTextLayout.Create(FontRenderer, sUTF8)
4044 else
4045 layout := TBidiTextLayout.Create(FontRenderer, sUTF8, GetFontRightToLeftFor(sUTF8));
4046 for i := 0 to layout.ParagraphCount-1 do
4047 layout.ParagraphAlignment[i] := AAlign;
4048 layout.ParagraphSpacingBelow:= AParagraphSpacing;
4049 layout.AvailableWidth := AWidth;
4050 case AVertAlign of
4051 tlBottom: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight);
4052 tlCenter: layout.TopLeft := PointF(ALeft,ATop-layout.TotalTextHeight/2);
4053 else layout.TopLeft := PointF(ALeft,ATop);
4054 end;
4055 layout.DrawText(self, ATexture);
4056 layout.Free;
4057end;
4058
4059procedure TBGRADefaultBitmap.TextOut(x, y: single; sUTF8: string;
4060 texture: IBGRAScanner; align: TAlignment; ARightToLeft: boolean);
4061begin
4062 FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),texture,align, ARightToLeft);
4063end;
4064
4065procedure TBGRADefaultBitmap.TextOut(x, y: single; sUTF8: string;
4066 c: TBGRAPixel; align: TAlignment; ARightToLeft: boolean);
4067begin
4068 with (PointF(x,y)-GetFontAnchorRotatedOffset) do
4069 FontRenderer.TextOut(self,x,y,CleanTextOutString(sUTF8),c,align, ARightToLeft);
4070end;
4071
4072procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer;
4073 sUTF8: string; style: TTextStyle; c: TBGRAPixel);
4074begin
4075 with (PointF(x,y)-GetFontAnchorRotatedOffset(0)) do
4076 FontRenderer.TextRect(self,ARect,system.round(x),system.round(y),sUTF8,style,c);
4077end;
4078
4079procedure TBGRADefaultBitmap.TextRect(ARect: TRect; x, y: integer; sUTF8: string;
4080 style: TTextStyle; texture: IBGRAScanner);
4081begin
4082 with (PointF(x,y)-GetFontAnchorRotatedOffset(0)) do
4083 FontRenderer.TextRect(self,ARect,system.round(x),system.round(y),sUTF8,style,texture);
4084end;
4085
4086{ Returns the total size of the string provided using the current font.
4087 Orientation is not taken into account, so that the width is along the text. }
4088function TBGRADefaultBitmap.TextSize(sUTF8: string): TSize;
4089begin
4090 result := FontRenderer.TextSize(CleanTextOutString(sUTF8));
4091end;
4092
4093function TBGRADefaultBitmap.TextAffineBox(sUTF8: string): TAffineBox;
4094var size: TSize;
4095 m: TAffineMatrix;
4096 dy: single;
4097begin
4098 dy := GetFontVerticalAnchorOffset;
4099 size := FontRenderer.TextSizeAngle(sUTF8, FontOrientation);
4100 m := AffineMatrixRotationDeg(-FontOrientation*0.1);
4101 result := TAffineBox.AffineBox(PointF(0,-dy), m*PointF(size.cx,-dy), m*PointF(0,size.cy-dy));
4102end;
4103
4104function TBGRADefaultBitmap.TextSize(sUTF8: string; AMaxWidth: integer): TSize;
4105begin
4106 result := FontRenderer.TextSize(sUTF8, AMaxWidth, GetFontRightToLeftFor(sUTF8));
4107end;
4108
4109function TBGRADefaultBitmap.TextSize(sUTF8: string; AMaxWidth: integer;
4110 ARightToLeft: boolean): TSize;
4111begin
4112 result := FontRenderer.TextSize(sUTF8, AMaxWidth, ARightToLeft);
4113end;
4114
4115function TBGRADefaultBitmap.TextFitInfo(sUTF8: string; AMaxWidth: integer
4116 ): integer;
4117begin
4118 result := FontRenderer.TextFitInfo(sUTF8, AMaxWidth);
4119end;
4120
4121{---------------------------- Curves ----------------------------------------}
4122
4123function TBGRADefaultBitmap.ComputeClosedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF;
4124begin
4125 result := BGRAPath.ComputeClosedSpline(APoints, AStyle);
4126end;
4127
4128function TBGRADefaultBitmap.ComputeOpenedSpline(const APoints: array of TPointF; AStyle: TSplineStyle): ArrayOfTPointF;
4129begin
4130 result := BGRAPath.ComputeOpenedSpline(APoints, AStyle);
4131end;
4132
4133function TBGRADefaultBitmap.ComputeBezierCurve(const ACurve: TCubicBezierCurve
4134 ): ArrayOfTPointF;
4135begin
4136 Result:= BGRAPath.ComputeBezierCurve(ACurve);
4137end;
4138
4139function TBGRADefaultBitmap.ComputeBezierCurve(
4140 const ACurve: TQuadraticBezierCurve): ArrayOfTPointF;
4141begin
4142 Result:= BGRAPath.ComputeBezierCurve(ACurve);
4143end;
4144
4145function TBGRADefaultBitmap.ComputeBezierSpline(
4146 const ASpline: array of TCubicBezierCurve): ArrayOfTPointF;
4147begin
4148 Result:= BGRAPath.ComputeBezierSpline(ASpline);
4149end;
4150
4151function TBGRADefaultBitmap.ComputeBezierSpline(
4152 const ASpline: array of TQuadraticBezierCurve): ArrayOfTPointF;
4153begin
4154 Result:= BGRAPath.ComputeBezierSpline(ASpline);
4155end;
4156
4157function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF;
4158 w: single): ArrayOfTPointF;
4159begin
4160 result := FPenStroker.ComputePolyline(points,w);
4161end;
4162
4163function TBGRADefaultBitmap.ComputeWidePolyline(const points: array of TPointF;
4164 w: single; ClosedCap: boolean): ArrayOfTPointF;
4165begin
4166 result := FPenStroker.ComputePolyline(points,w,ClosedCap);
4167end;
4168
4169function TBGRADefaultBitmap.ComputeWidePolygon(const points: array of TPointF;
4170 w: single): ArrayOfTPointF;
4171begin
4172 result := FPenStroker.ComputePolygon(points,w);
4173end;
4174
4175function TBGRADefaultBitmap.ComputeEllipseContour(x, y, rx, ry: single; quality: single): ArrayOfTPointF;
4176begin
4177 result := BGRAPath.ComputeEllipse(x,y,rx,ry, quality);
4178end;
4179
4180function TBGRADefaultBitmap.ComputeEllipseContour(AOrigin, AXAxis,
4181 AYAxis: TPointF; quality: single): ArrayOfTPointF;
4182begin
4183 result := BGRAPath.ComputeEllipse(AOrigin,AXAxis,AYAxis, quality);
4184end;
4185
4186function TBGRADefaultBitmap.ComputeEllipseBorder(x, y, rx, ry, w: single; quality: single): ArrayOfTPointF;
4187begin
4188 result := ComputeWidePolygon(ComputeEllipseContour(x,y,rx,ry, quality),w);
4189end;
4190
4191function TBGRADefaultBitmap.ComputeEllipseBorder(AOrigin, AXAxis,
4192 AYAxis: TPointF; w: single; quality: single): ArrayOfTPointF;
4193begin
4194 result := ComputeWidePolygon(ComputeEllipseContour(AOrigin,AXAxis,AYAxis, quality),w);
4195end;
4196
4197function TBGRADefaultBitmap.ComputeArc65536(x, y, rx, ry: single; start65536,
4198 end65536: word; quality: single): ArrayOfTPointF;
4199begin
4200 result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536,quality);
4201end;
4202
4203function TBGRADefaultBitmap.ComputeArcRad(x, y, rx, ry: single; startRad,
4204 endRad: single; quality: single): ArrayOfTPointF;
4205begin
4206 result := BGRAPath.ComputeArcRad(x,y,rx,ry,startRad,endRad,quality);
4207end;
4208
4209function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single; quality: single): ArrayOfTPointF;
4210begin
4211 result := BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry,quality);
4212end;
4213
4214function TBGRADefaultBitmap.ComputeRoundRect(x1, y1, x2, y2, rx, ry: single;
4215 options: TRoundRectangleOptions; quality: single): ArrayOfTPointF;
4216begin
4217 Result:= BGRAPath.ComputeRoundRect(x1,y1,x2,y2,rx,ry,options,quality);
4218end;
4219
4220function TBGRADefaultBitmap.ComputePie65536(x, y, rx, ry: single; start65536,
4221 end65536: word; quality: single): ArrayOfTPointF;
4222begin
4223 result := BGRAPath.ComputeArc65536(x,y,rx,ry,start65536,end65536,quality);
4224 if (start65536 <> end65536) then
4225 begin
4226 setlength(result,length(result)+1);
4227 result[high(result)] := PointF(x,y);
4228 end;
4229end;
4230
4231function TBGRADefaultBitmap.ComputePieRad(x, y, rx, ry: single; startRad,
4232 endRad: single; quality: single): ArrayOfTPointF;
4233begin
4234 result := self.ComputePie65536(x,y,rx,ry,round(startRad*32768/Pi),round(endRad*32768/Pi),quality);
4235end;
4236
4237{---------------------------------- Fill ---------------------------------}
4238
4239procedure TBGRADefaultBitmap.Fill(texture: IBGRAScanner);
4240begin
4241 FillRect(FClipRect.Left,FClipRect.Top,FClipRect.Right,FClipRect.Bottom,texture,dmSet);
4242end;
4243
4244procedure TBGRADefaultBitmap.Fill(c: TBGRAPixel; start, Count: integer);
4245begin
4246 if start < 0 then
4247 begin
4248 Count += start;
4249 start := 0;
4250 end;
4251 if start >= nbPixels then
4252 exit;
4253 if start + Count > nbPixels then
4254 Count := nbPixels - start;
4255
4256 FillInline(Data + start, c, Count);
4257 InvalidateBitmap;
4258end;
4259
4260procedure TBGRADefaultBitmap.AlphaFill(alpha: byte; start, Count: integer);
4261begin
4262 if alpha = 0 then
4263 Fill(BGRAPixelTransparent, start, Count);
4264 if start < 0 then
4265 begin
4266 Count += start;
4267 start := 0;
4268 end;
4269 if start >= nbPixels then
4270 exit;
4271 if start + Count > nbPixels then
4272 Count := nbPixels - start;
4273
4274 AlphaFillInline(Data + start, alpha, Count);
4275 InvalidateBitmap;
4276end;
4277
4278procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
4279 color: TBGRAPixel; ADrawMode: TDrawMode);
4280var
4281 scan: TBGRACustomScanner;
4282begin
4283 if (AMask = nil) or (color.alpha = 0) then exit;
4284 scan := TBGRASolidColorMaskScanner.Create(AMask,Point(-X,-Y),color);
4285 self.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,ADrawMode);
4286 scan.Free;
4287end;
4288
4289procedure TBGRADefaultBitmap.FillMask(x, y: integer; AMask: TBGRACustomBitmap;
4290 texture: IBGRAScanner; ADrawMode: TDrawMode; AOpacity: byte);
4291var
4292 scan: TBGRACustomScanner;
4293begin
4294 if AMask = nil then exit;
4295 scan := TBGRATextureMaskScanner.Create(AMask,Point(-X,-Y),texture, AOpacity);
4296 self.FillRect(X,Y,X+AMask.Width,Y+AMask.Height,scan,ADrawMode);
4297 scan.Free;
4298end;
4299
4300procedure TBGRADefaultBitmap.EraseMask(x, y: integer; AMask: TBGRACustomBitmap;
4301 alpha: byte);
4302var
4303 x0,y0,x2, y2, yb,xb, tx, delta: integer;
4304 p, psrc: PBGRAPixel;
4305begin
4306 if (AMask = nil) or (alpha = 0) then exit;
4307 x0 := x;
4308 y0 := y;
4309 x2 := x+AMask.Width;
4310 y2 := y+AMask.Height;
4311 if not CheckClippedRectBounds(x,y,x2,y2) then exit;
4312 tx := x2 - x;
4313 Dec(x2);
4314 Dec(y2);
4315
4316 p := Scanline[y] + x;
4317 if FLineOrder = riloBottomToTop then
4318 delta := -Width
4319 else
4320 delta := Width;
4321
4322 for yb := y to y2 do
4323 begin
4324 psrc := AMask.ScanLine[yb-y0]+(x-x0);
4325 if alpha = 255 then
4326 begin
4327 for xb := tx-1 downto 0 do
4328 begin
4329 ErasePixelInline(p, psrc^.green);
4330 inc(p);
4331 inc(psrc);
4332 end;
4333 end else
4334 begin
4335 for xb := tx-1 downto 0 do
4336 begin
4337 ErasePixelInline(p, ApplyOpacity(psrc^.green,alpha));
4338 inc(p);
4339 inc(psrc);
4340 end;
4341 end;
4342 dec(p, tx);
4343 Inc(p, delta);
4344 end;
4345
4346 InvalidateBitmap;
4347end;
4348
4349procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer;
4350 AMask: TBGRACustomBitmap; color: TBGRAPixel; ARGBOrder: boolean);
4351begin
4352 BGRAFillClearTypeMask(self,x, y, xThird, AMask, color, nil, ARGBOrder);
4353end;
4354
4355procedure TBGRADefaultBitmap.FillClearTypeMask(x, y: integer; xThird: integer;
4356 AMask: TBGRACustomBitmap; texture: IBGRAScanner; ARGBOrder: boolean);
4357begin
4358 BGRAFillClearTypeMask(self,x, y, xThird, AMask, BGRAPixelTransparent, texture, ARGBOrder);
4359end;
4360
4361{ Replace color without taking alpha channel into account }
4362procedure TBGRADefaultBitmap.ReplaceColor(before, after: TColor);
4363var
4364 p: PLongWord;
4365 n: integer;
4366 colorMask,beforeBGR, afterBGR: longword;
4367 rAfter,gAfter,bAfter,rBefore,gBefore,bBefore: byte;
4368begin
4369 colorMask := LongWord(BGRA(255,255,255,0));
4370 RedGreenBlue(before, rBefore,gBefore,bBefore);
4371 RedGreenBlue(after, rAfter,gAfter,bAfter);
4372 beforeBGR := LongWord(BGRA(rBefore,gBefore,bBefore,0));
4373 afterBGR := LongWord(BGRA(rAfter,gAfter,bAfter,0));
4374
4375 p := PLongWord(Data);
4376 for n := NbPixels - 1 downto 0 do
4377 begin
4378 if p^ and colorMask = beforeBGR then
4379 p^ := (p^ and not ColorMask) or afterBGR;
4380 Inc(p);
4381 end;
4382 InvalidateBitmap;
4383end;
4384
4385procedure TBGRADefaultBitmap.ReplaceColor(before, after: TBGRAPixel);
4386var
4387 p: PBGRAPixel;
4388 n: integer;
4389begin
4390 if before.alpha = 0 then
4391 begin
4392 ReplaceTransparent(after);
4393 exit;
4394 end;
4395 p := Data;
4396 for n := NbPixels - 1 downto 0 do
4397 begin
4398 if PDWord(p)^ = DWord(before) then
4399 p^ := after;
4400 Inc(p);
4401 end;
4402 InvalidateBitmap;
4403end;
4404
4405procedure TBGRADefaultBitmap.ReplaceColor(ABounds: TRect; before, after: TColor);
4406var p: PLongWord;
4407 xb,yb,xcount: integer;
4408
4409 colorMask,beforeBGR, afterBGR: longword;
4410 rAfter,gAfter,bAfter,rBefore,gBefore,bBefore: byte;
4411begin
4412 colorMask := LongWord(BGRA(255,255,255,0));
4413 RedGreenBlue(before, rBefore,gBefore,bBefore);
4414 RedGreenBlue(after, rAfter,gAfter,bAfter);
4415 beforeBGR := LongWord(BGRA(rBefore,gBefore,bBefore,0));
4416 afterBGR := LongWord(BGRA(rAfter,gAfter,bAfter,0));
4417
4418 if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
4419 xcount := ABounds.Right-ABounds.Left;
4420 for yb := ABounds.Top to ABounds.Bottom-1 do
4421 begin
4422 p := PLongWord(ScanLine[yb]+ABounds.Left);
4423 for xb := xcount-1 downto 0 do
4424 begin
4425 if p^ and colorMask = beforeBGR then
4426 p^ := (p^ and not ColorMask) or afterBGR;
4427 Inc(p);
4428 end;
4429 end;
4430 InvalidateBitmap;
4431end;
4432
4433procedure TBGRADefaultBitmap.ReplaceColor(ABounds: TRect; before,
4434 after: TBGRAPixel);
4435var p: PBGRAPixel;
4436 xb,yb,xcount: integer;
4437begin
4438 if before.alpha = 0 then
4439 begin
4440 ReplaceTransparent(ABounds,after);
4441 exit;
4442 end;
4443 if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
4444 xcount := ABounds.Right-ABounds.Left;
4445 for yb := ABounds.Top to ABounds.Bottom-1 do
4446 begin
4447 p := ScanLine[yb]+ABounds.Left;
4448 for xb := xcount-1 downto 0 do
4449 begin
4450 if PDWord(p)^ = DWord(before) then
4451 p^ := after;
4452 Inc(p);
4453 end;
4454 end;
4455 InvalidateBitmap;
4456end;
4457
4458{ Replace transparent pixels by the specified color }
4459procedure TBGRADefaultBitmap.ReplaceTransparent(after: TBGRAPixel);
4460var
4461 p: PBGRAPixel;
4462 n: integer;
4463begin
4464 p := Data;
4465 for n := NbPixels - 1 downto 0 do
4466 begin
4467 if p^.alpha = 0 then
4468 p^ := after;
4469 Inc(p);
4470 end;
4471 InvalidateBitmap;
4472end;
4473
4474procedure TBGRADefaultBitmap.ReplaceTransparent(ABounds: TRect;
4475 after: TBGRAPixel);
4476var p: PBGRAPixel;
4477 xb,yb,xcount: integer;
4478begin
4479 if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
4480 xcount := ABounds.Right-ABounds.Left;
4481 for yb := ABounds.Top to ABounds.Bottom-1 do
4482 begin
4483 p := ScanLine[yb]+ABounds.Left;
4484 for xb := xcount-1 downto 0 do
4485 begin
4486 if p^.alpha = 0 then
4487 p^ := after;
4488 Inc(p);
4489 end;
4490 end;
4491 InvalidateBitmap;
4492end;
4493
4494{ General purpose FloodFill. It can be used to fill inplace or to
4495 fill a destination bitmap according to the content of the current bitmap.
4496
4497 The first pixel encountered is taken as a reference, further pixels
4498 are compared to this pixel. If the distance between next colors and
4499 the first color is lower than the tolerance, then the floodfill continues.
4500
4501 It uses an array of bits to store visited places to avoid filling twice
4502 the same area. It also uses a stack of positions to remember where
4503 to continue after a place is completely filled.
4504
4505 The first direction to be checked is horizontal, then
4506 it checks pixels on the line above and on the line below. }
4507procedure TBGRADefaultBitmap.ParallelFloodFill(X, Y: integer;
4508 Dest: TBGRACustomBitmap; Color: TBGRAPixel; mode: TFloodfillMode;
4509 Tolerance: byte);
4510var
4511 S: TBGRAPixel;
4512 SX, EX, I: integer;
4513 Added: boolean;
4514
4515 Visited: array of longword;
4516 VisitedLineSize: integer;
4517
4518 Stack: array of integer;
4519 StackCount: integer;
4520
4521 function CheckPixel(AX, AY: integer): boolean; inline;
4522 var
4523 ComparedColor: TBGRAPixel;
4524 begin
4525 if Visited[AX shr 5 + AY * VisitedLineSize] and (1 shl (AX and 31)) <> 0 then
4526 Result := False
4527 else
4528 begin
4529 ComparedColor := GetPixel(AX, AY);
4530 Result := BGRADiff(ComparedColor, S) <= Tolerance;
4531 end;
4532 end;
4533
4534 procedure SetVisited(X1, AY, X2: integer);
4535 var
4536 StartMask, EndMask: longword;
4537 StartPos, EndPos: integer;
4538 begin
4539 if X2 < X1 then
4540 exit;
4541 StartMask := $FFFFFFFF shl (X1 and 31);
4542 case X2 and 31 of
4543 31: EndMask := $FFFFFFFF;
4544 30: EndMask := $7FFFFFFF;
4545 else
4546 EndMask := 1 shl ((X2 and 31) + 1) - 1;
4547 end;
4548 StartPos := X1 shr 5 + AY * VisitedLineSize;
4549 EndPos := X2 shr 5 + AY * VisitedLineSize;
4550 if StartPos = EndPos then
4551 Visited[StartPos] := Visited[StartPos] or (StartMask and EndMask)
4552 else
4553 begin
4554 Visited[StartPos] := Visited[StartPos] or StartMask;
4555 Visited[EndPos] := Visited[EndPos] or EndMask;
4556 if EndPos - StartPos > 1 then
4557 FillDWord(Visited[StartPos + 1], EndPos - StartPos - 1, $FFFFFFFF);
4558 end;
4559 end;
4560
4561 procedure Push(AX, AY: integer); inline;
4562 begin
4563 if StackCount + 1 >= High(Stack) then
4564 SetLength(Stack, Length(Stack) shl 1);
4565
4566 Stack[StackCount] := AX;
4567 Inc(StackCount);
4568 Stack[StackCount] := AY;
4569 Inc(StackCount);
4570 end;
4571
4572 procedure Pop(var AX, AY: integer); inline;
4573 begin
4574 Dec(StackCount);
4575 AY := Stack[StackCount];
4576 Dec(StackCount);
4577 AX := Stack[StackCount];
4578 end;
4579
4580begin
4581 if PtInClipRect(X,Y) then
4582 begin
4583 S := GetPixel(X, Y);
4584
4585 VisitedLineSize := (Width + 31) shr 5;
4586 SetLength(Visited, VisitedLineSize * Height);
4587 FillDWord(Visited[0], Length(Visited), 0);
4588
4589 SetLength(Stack, 2);
4590 StackCount := 0;
4591
4592 Push(X, Y);
4593 repeat
4594 Pop(X, Y);
4595 if not CheckPixel(X, Y) then
4596 Continue;
4597
4598 SX := X;
4599 while (SX > FClipRect.Left) and CheckPixel(Pred(SX), Y) do
4600 Dec(SX);
4601 EX := X;
4602 while (EX < Pred(FClipRect.Right)) and CheckPixel(Succ(EX), Y) do
4603 Inc(EX);
4604
4605 SetVisited(SX, Y, EX);
4606 if mode = fmSet then
4607 dest.SetHorizLine(SX, Y, EX, Color)
4608 else
4609 if mode = fmDrawWithTransparency then
4610 dest.DrawHorizLine(SX, Y, EX, Color)
4611 else
4612 dest.DrawHorizLineDiff(SX, Y, EX, Color, S, Tolerance);
4613
4614 Added := False;
4615 if Y > FClipRect.Top then
4616 for I := SX to EX do
4617 if CheckPixel(I, Pred(Y)) then
4618 begin
4619 if Added then //do not add twice the same segment
4620 Continue;
4621 Push(I, Pred(Y));
4622 Added := True;
4623 end
4624 else
4625 Added := False;
4626
4627 Added := False;
4628 if Y < Pred(FClipRect.Bottom) then
4629 for I := SX to EX do
4630 if CheckPixel(I, Succ(Y)) then
4631 begin
4632 if Added then //do not add twice the same segment
4633 Continue;
4634 Push(I, Succ(Y));
4635 Added := True;
4636 end
4637 else
4638 Added := False;
4639 until StackCount <= 0;
4640 end;
4641end;
4642
4643procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer;
4644 c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
4645 gammaColorCorrection: boolean; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm);
4646var
4647 scanner: TBGRAGradientScanner;
4648begin
4649 if (c1.alpha = 0) and (c2.alpha = 0) then
4650 FillRect(x, y, x2, y2, BGRAPixelTransparent, mode)
4651 else
4652 if ditherAlgo <> daNearestNeighbor then
4653 GradientFillDithered(x,y,x2,y2,c1,c2,gtype,o1,o2,mode,gammaColorCorrection,sinus,ditherAlgo)
4654 else
4655 begin
4656 scanner := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus);
4657 FillRect(x,y,x2,y2,scanner,mode);
4658 scanner.Free;
4659 end;
4660end;
4661
4662procedure TBGRADefaultBitmap.GradientFill(x, y, x2, y2: integer;
4663 gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF;
4664 mode: TDrawMode; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm);
4665var
4666 scanner: TBGRAGradientScanner;
4667begin
4668 if ditherAlgo <> daNearestNeighbor then
4669 GradientFillDithered(x,y,x2,y2,gradient,gtype,o1,o2,mode,sinus,ditherAlgo)
4670 else
4671 begin
4672 scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus);
4673 FillRect(x,y,x2,y2,scanner,mode);
4674 scanner.Free;
4675 end;
4676end;
4677
4678procedure TBGRADefaultBitmap.GradientFillDithered(x, y, x2, y2: integer; c1,
4679 c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF;
4680 mode: TDrawMode; gammaColorCorrection: boolean; Sinus: Boolean;
4681 ditherAlgo: TDitheringAlgorithm);
4682var
4683 scanner: TBGRAGradientScanner;
4684begin
4685 if (c1.alpha = 0) and (c2.alpha = 0) then
4686 FillRect(x, y, x2, y2, BGRAPixelTransparent, dmSet)
4687 else
4688 begin
4689 scanner := TBGRAGradientScanner.Create(c1,c2,gtype,o1,o2,gammaColorCorrection,Sinus);
4690 FillRect(x,y,x2,y2,scanner,mode,ditherAlgo);
4691 scanner.Free;
4692 end;
4693end;
4694
4695procedure TBGRADefaultBitmap.GradientFillDithered(x, y, x2, y2: integer;
4696 gradient: TBGRACustomGradient; gtype: TGradientType; o1, o2: TPointF;
4697 mode: TDrawMode; Sinus: Boolean; ditherAlgo: TDitheringAlgorithm);
4698var
4699 scanner: TBGRAGradientScanner;
4700begin
4701 scanner := TBGRAGradientScanner.Create(gradient,gtype,o1,o2,sinus);
4702 FillRect(x,y,x2,y2,scanner,mode,ditherAlgo);
4703 scanner.Free;
4704end;
4705
4706function TBGRADefaultBitmap.CreateBrushTexture(ABrushStyle: TBrushStyle; APatternColor, ABackgroundColor: TBGRAPixel;
4707 AWidth: integer = 8; AHeight: integer = 8; APenWidth: single = 1): TBGRACustomBitmap;
4708begin
4709 result := BGRAPen.CreateBrushTexture(self,ABrushStyle,APatternColor,ABackgroundColor,AWidth,AHeight,APenWidth);
4710end;
4711
4712function TBGRADefaultBitmap.ScanAtInteger(X, Y: integer): TBGRAPixel;
4713begin
4714 if (FScanWidth <> 0) and (FScanHeight <> 0) then
4715 result := (GetScanlineFast(PositiveMod(Y+ScanOffset.Y, FScanHeight))+PositiveMod(X+ScanOffset.X, FScanWidth))^
4716 else
4717 result := BGRAPixelTransparent;
4718end;
4719
4720{ Scanning procedures for IBGRAScanner interface }
4721procedure TBGRADefaultBitmap.ScanMoveTo(X, Y: Integer);
4722begin
4723 if (FScanWidth = 0) or (FScanHeight = 0) then exit;
4724 LoadFromBitmapIfNeeded;
4725 FScanCurX := PositiveMod(X+ScanOffset.X, FScanWidth);
4726 FScanCurY := PositiveMod(Y+ScanOffset.Y, FScanHeight);
4727 FScanPtr := ScanLine[FScanCurY];
4728end;
4729
4730function TBGRADefaultBitmap.ScanNextPixel: TBGRAPixel;
4731begin
4732 if (FScanWidth <> 0) and (FScanHeight <> 0) then
4733 begin
4734 result := (FScanPtr+FScanCurX)^;
4735 inc(FScanCurX);
4736 if FScanCurX = FScanWidth then //cycle
4737 FScanCurX := 0;
4738 end
4739 else
4740 result := BGRAPixelTransparent;
4741end;
4742
4743function TBGRADefaultBitmap.ScanAt(X, Y: Single): TBGRAPixel;
4744var
4745 ix, iy: Int32or64;
4746 iFactX,iFactY: Int32or64;
4747begin
4748 if (FScanWidth = 0) or (FScanHeight = 0) then
4749 begin
4750 result := BGRAPixelTransparent;
4751 exit;
4752 end;
4753 LoadFromBitmapIfNeeded;
4754 ix := round(x*256);
4755 iy := round(y*256);
4756 if ScanInterpolationFilter = rfBox then
4757 begin
4758 ix := PositiveMod((ix+128)+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8;
4759 iy := PositiveMod((iy+128)+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8;
4760 result := (GetScanlineFast(iy)+ix)^;
4761 exit;
4762 end;
4763 iFactX := ix and 255;
4764 iFactY := iy and 255;
4765 ix := PositiveMod(ix+(ScanOffset.X shl 8), FScanWidth shl 8) shr 8;
4766 iy := PositiveMod(iy+(ScanOffset.Y shl 8), FScanHeight shl 8) shr 8;
4767 if (iFactX = 0) and (iFactY = 0) then
4768 begin
4769 result := (GetScanlineFast(iy)+ix)^;
4770 exit;
4771 end;
4772 if ScanInterpolationFilter <> rfLinear then
4773 begin
4774 iFactX := FineInterpolation256( iFactX, ScanInterpolationFilter );
4775 iFactY := FineInterpolation256( iFactY, ScanInterpolationFilter );
4776 end;
4777 result := InternalGetPixelCycle256(ix,iy, iFactX,iFactY);
4778end;
4779
4780function TBGRADefaultBitmap.IsScanPutPixelsDefined: boolean;
4781begin
4782 Result:= true;
4783end;
4784
4785procedure TBGRADefaultBitmap.ScanPutPixels(pdest: PBGRAPixel; count: integer;
4786 mode: TDrawMode);
4787var
4788 i,nbCopy: Integer;
4789 c: TBGRAPixel;
4790begin
4791 if (FScanWidth <= 0) or (FScanHeight <= 0) then
4792 begin
4793 if mode = dmSet then
4794 FillDWord(pdest^, count, DWord(BGRAPixelTransparent));
4795 exit;
4796 end;
4797 case mode of
4798 dmLinearBlend:
4799 for i := 0 to count-1 do
4800 begin
4801 FastBlendPixelInline(pdest, ScanNextPixel);
4802 inc(pdest);
4803 end;
4804 dmDrawWithTransparency:
4805 for i := 0 to count-1 do
4806 begin
4807 DrawPixelInlineWithAlphaCheck(pdest, ScanNextPixel);
4808 inc(pdest);
4809 end;
4810 dmSet:
4811 while count > 0 do
4812 begin
4813 nbCopy := FScanWidth-FScanCurX;
4814 if count < nbCopy then nbCopy := count;
4815 move((FScanPtr+FScanCurX)^,pdest^,nbCopy*sizeof(TBGRAPixel));
4816 inc(pdest,nbCopy);
4817 inc(FScanCurX,nbCopy);
4818 if FScanCurX = FScanWidth then FScanCurX := 0;
4819 dec(count,nbCopy);
4820 end;
4821 dmSetExceptTransparent:
4822 for i := 0 to count-1 do
4823 begin
4824 c := ScanNextPixel;
4825 if c.alpha = 255 then pdest^ := c;
4826 inc(pdest);
4827 end;
4828 dmXor:
4829 for i := 0 to count-1 do
4830 begin
4831 PDWord(pdest)^ := PDWord(pdest)^ xor DWord(ScanNextPixel);
4832 inc(pdest);
4833 end;
4834 end;
4835end;
4836
4837{ General purpose pixel drawing function }
4838procedure TBGRADefaultBitmap.DrawPixels(c: TBGRAPixel; start, Count: integer);
4839var
4840 p: PBGRAPixel;
4841begin
4842 if c.alpha = 0 then
4843 exit;
4844 if c.alpha = 255 then
4845 begin
4846 Fill(c,start,Count);
4847 exit;
4848 end;
4849
4850 if start < 0 then
4851 begin
4852 Count += start;
4853 start := 0;
4854 end;
4855 if start >= nbPixels then
4856 exit;
4857 if start + Count > nbPixels then
4858 Count := nbPixels - start;
4859
4860 p := Data + start;
4861 DrawPixelsInline(p,c,Count);
4862 InvalidateBitmap;
4863end;
4864
4865{------------------------- End fill ------------------------------}
4866
4867procedure TBGRADefaultBitmap.DoAlphaCorrection;
4868var
4869 p: PBGRAPixel;
4870 n: integer;
4871 colormask: longword;
4872begin
4873 if CanvasAlphaCorrection then
4874 begin
4875 p := FData;
4876 colormask := longword(BGRA(255,255,255,0));
4877 for n := NbPixels - 1 downto 0 do
4878 begin
4879 if (longword(p^) and colormask <> 0) and (p^.alpha = 0) then
4880 p^.alpha := FCanvasOpacity;
4881 Inc(p);
4882 end;
4883 end;
4884 FAlphaCorrectionNeeded := False;
4885 InvalidateBitmap;
4886end;
4887
4888{ Ensure that transparent pixels have all channels to zero }
4889procedure TBGRADefaultBitmap.ClearTransparentPixels;
4890var
4891 p: PBGRAPixel;
4892 n: integer;
4893begin
4894 p := FData;
4895 for n := NbPixels - 1 downto 0 do
4896 begin
4897 if (p^.alpha = 0) then
4898 p^ := BGRAPixelTransparent;
4899 Inc(p);
4900 end;
4901 InvalidateBitmap;
4902end;
4903
4904function TBGRADefaultBitmap.CheckAntialiasRectBounds(var x, y, x2, y2: single;
4905 w: single): boolean;
4906var
4907 temp: Single;
4908begin
4909 if (x > x2) then
4910 begin
4911 temp := x;
4912 x := x2;
4913 x2 := temp;
4914 end;
4915 if (y > y2) then
4916 begin
4917 temp := y;
4918 y := y2;
4919 y2 := temp;
4920 end;
4921
4922 result := (x2 - x > w) and (y2 - y > w);
4923end;
4924
4925function TBGRADefaultBitmap.GetCanvasBGRA: TBGRACanvas;
4926begin
4927 if FCanvasBGRA = nil then
4928 FCanvasBGRA := TBGRACanvas.Create(self);
4929 result := FCanvasBGRA;
4930end;
4931
4932function TBGRADefaultBitmap.GetCanvas2D: TBGRACanvas2D;
4933begin
4934 if FCanvas2D = nil then
4935 FCanvas2D := TBGRACanvas2D.Create(self);
4936 result := FCanvas2D;
4937end;
4938
4939procedure TBGRADefaultBitmap.PutImage(x, y: integer; Source: TBGRACustomBitmap;
4940 mode: TDrawMode; AOpacity: byte);
4941var
4942 yb, minxb, minyb, maxxb, maxyb, ignoreleft, copycount, sourcewidth,
4943 i, delta_source, delta_dest: integer;
4944 psource, pdest: PBGRAPixel;
4945 tempPixel: TBGRAPixel;
4946
4947begin
4948 if (source = nil) or (AOpacity = 0) then exit;
4949 sourcewidth := Source.Width;
4950
4951 if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft,FClipRect) then exit;
4952
4953 copycount := maxxb - minxb + 1;
4954
4955 psource := Source.ScanLine[minyb - y] + ignoreleft;
4956 if Source.LineOrder = riloBottomToTop then
4957 delta_source := -sourcewidth
4958 else
4959 delta_source := sourcewidth;
4960
4961 pdest := Scanline[minyb] + minxb;
4962 if FLineOrder = riloBottomToTop then
4963 delta_dest := -Width
4964 else
4965 delta_dest := Width;
4966
4967 case mode of
4968 dmSet:
4969 begin
4970 if AOpacity <> 255 then
4971 begin
4972 for yb := minyb to maxyb do
4973 begin
4974 CopyPixelsWithOpacity(pdest, psource, AOpacity, copycount);
4975 Inc(psource, delta_source);
4976 Inc(pdest, delta_dest);
4977 end;
4978 end
4979 else
4980 begin
4981 copycount *= sizeof(TBGRAPixel);
4982 for yb := minyb to maxyb do
4983 begin
4984 move(psource^, pdest^, copycount);
4985 Inc(psource, delta_source);
4986 Inc(pdest, delta_dest);
4987 end;
4988 end;
4989 InvalidateBitmap;
4990 end;
4991 dmSetExceptTransparent:
4992 begin
4993 Dec(delta_source, copycount);
4994 Dec(delta_dest, copycount);
4995 for yb := minyb to maxyb do
4996 begin
4997 if AOpacity <> 255 then
4998 begin
4999 for i := copycount - 1 downto 0 do
5000 begin
5001 if psource^.alpha = 255 then
5002 begin
5003 tempPixel := psource^;
5004 tempPixel.alpha := ApplyOpacity(tempPixel.alpha,AOpacity);
5005 FastBlendPixelInline(pdest,tempPixel);
5006 end;
5007 Inc(pdest);
5008 Inc(psource);
5009 end;
5010 end else
5011 for i := copycount - 1 downto 0 do
5012 begin
5013 if psource^.alpha = 255 then
5014 pdest^ := psource^;
5015 Inc(pdest);
5016 Inc(psource);
5017 end;
5018 Inc(psource, delta_source);
5019 Inc(pdest, delta_dest);
5020 end;
5021 InvalidateBitmap;
5022 if (Source is TBGRADefaultBitmap) and Assigned(TBGRADefaultBitmap(Source).XorMask) then
5023 PutImage(x,y,TBGRADefaultBitmap(Source).XorMask,dmXor,AOpacity);
5024 end;
5025 dmDrawWithTransparency:
5026 begin
5027 Dec(delta_source, copycount);
5028 Dec(delta_dest, copycount);
5029 for yb := minyb to maxyb do
5030 begin
5031 if AOpacity <> 255 then
5032 begin
5033 for i := copycount - 1 downto 0 do
5034 begin
5035 DrawPixelInlineWithAlphaCheck(pdest, psource^, AOpacity);
5036 Inc(pdest);
5037 Inc(psource);
5038 end;
5039 end
5040 else
5041 for i := copycount - 1 downto 0 do
5042 begin
5043 DrawPixelInlineWithAlphaCheck(pdest, psource^);
5044 Inc(pdest);
5045 Inc(psource);
5046 end;
5047 Inc(psource, delta_source);
5048 Inc(pdest, delta_dest);
5049 end;
5050 InvalidateBitmap;
5051 if (Source is TBGRADefaultBitmap) and Assigned(TBGRADefaultBitmap(Source).XorMask) then
5052 PutImage(x,y,TBGRADefaultBitmap(Source).XorMask,dmXor,AOpacity);
5053 end;
5054 dmFastBlend:
5055 begin
5056 Dec(delta_source, copycount);
5057 Dec(delta_dest, copycount);
5058 for yb := minyb to maxyb do
5059 begin
5060 if AOpacity <> 255 then
5061 begin
5062 for i := copycount - 1 downto 0 do
5063 begin
5064 FastBlendPixelInline(pdest, psource^, AOpacity);
5065 Inc(pdest);
5066 Inc(psource);
5067 end;
5068 end else
5069 for i := copycount - 1 downto 0 do
5070 begin
5071 FastBlendPixelInline(pdest, psource^);
5072 Inc(pdest);
5073 Inc(psource);
5074 end;
5075 Inc(psource, delta_source);
5076 Inc(pdest, delta_dest);
5077 end;
5078 InvalidateBitmap;
5079 if (Source is TBGRADefaultBitmap) and Assigned(TBGRADefaultBitmap(Source).XorMask) then
5080 PutImage(x,y,TBGRADefaultBitmap(Source).XorMask,dmXor,AOpacity);
5081 end;
5082 dmXor:
5083 begin
5084 if AOpacity <> 255 then
5085 begin
5086 Dec(delta_source, copycount);
5087 Dec(delta_dest, copycount);
5088 for yb := minyb to maxyb do
5089 begin
5090 for i := copycount - 1 downto 0 do
5091 begin
5092 FastBlendPixelInline(pdest, TBGRAPixel(PDWord(pdest)^ xor PDword(psource)^), AOpacity);
5093 Inc(pdest);
5094 Inc(psource);
5095 end;
5096 Inc(psource, delta_source);
5097 Inc(pdest, delta_dest);
5098 end;
5099 end else
5100 begin
5101 for yb := minyb to maxyb do
5102 begin
5103 XorPixels(pdest, psource, copycount);
5104 Inc(psource, delta_source);
5105 Inc(pdest, delta_dest);
5106 end;
5107 end;
5108 InvalidateBitmap;
5109 end;
5110 end;
5111end;
5112
5113procedure TBGRADefaultBitmap.BlendImage(x, y: integer; Source: TBGRACustomBitmap;
5114 operation: TBlendOperation);
5115var
5116 yb, minxb, minyb, maxxb, maxyb, ignoreleft, copycount, sourcewidth,
5117 delta_source, delta_dest: integer;
5118 psource, pdest: PBGRAPixel;
5119begin
5120 sourcewidth := Source.Width;
5121
5122 if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft,FClipRect) then exit;
5123
5124 copycount := maxxb - minxb + 1;
5125
5126 psource := Source.ScanLine[minyb - y] + ignoreleft;
5127 if Source.LineOrder = riloBottomToTop then
5128 delta_source := -sourcewidth
5129 else
5130 delta_source := sourcewidth;
5131
5132 pdest := Scanline[minyb] + minxb;
5133 if FLineOrder = riloBottomToTop then
5134 delta_dest := -Width
5135 else
5136 delta_dest := Width;
5137
5138 for yb := minyb to maxyb do
5139 begin
5140 BlendPixels(pdest, psource, operation, copycount);
5141 Inc(psource, delta_source);
5142 Inc(pdest, delta_dest);
5143 end;
5144 InvalidateBitmap;
5145end;
5146
5147procedure TBGRADefaultBitmap.BlendImageOver(x, y: integer;
5148 Source: TBGRACustomBitmap; operation: TBlendOperation; AOpacity: byte; ALinearBlend: boolean);
5149var
5150 yb, minxb, minyb, maxxb, maxyb, ignoreleft, copycount, sourcewidth,
5151 delta_source, delta_dest: integer;
5152 psource, pdest: PBGRAPixel;
5153begin
5154 sourcewidth := Source.Width;
5155
5156 if not CheckPutImageBounds(x,y,sourcewidth,source.height,minxb,minyb,maxxb,maxyb,ignoreleft,FClipRect) then exit;
5157
5158 copycount := maxxb - minxb + 1;
5159
5160 psource := Source.ScanLine[minyb - y] + ignoreleft;
5161 if Source.LineOrder = riloBottomToTop then
5162 delta_source := -sourcewidth
5163 else
5164 delta_source := sourcewidth;
5165
5166 pdest := Scanline[minyb] + minxb;
5167 if FLineOrder = riloBottomToTop then
5168 delta_dest := -Width
5169 else
5170 delta_dest := Width;
5171
5172 for yb := minyb to maxyb do
5173 begin
5174 BlendPixelsOver(pdest, psource, operation, copycount, AOpacity, ALinearBlend);
5175 Inc(psource, delta_source);
5176 Inc(pdest, delta_dest);
5177 end;
5178 InvalidateBitmap;
5179end;
5180
5181{ Draw an image with an affine transformation (rotation, scale, translate).
5182 Parameters are the bitmap origin, the end of the horizontal axis and the end of the vertical axis.
5183 The output bounds correspond to the pixels that will be affected in the destination. }
5184procedure TBGRADefaultBitmap.PutImageAffine(AMatrix: TAffineMatrix;
5185 Source: TBGRACustomBitmap; AOutputBounds: TRect;
5186 AResampleFilter: TResampleFilter; AMode: TDrawMode; AOpacity: Byte);
5187var affine: TBGRAAffineBitmapTransform;
5188 sourceBounds: TRect;
5189begin
5190 if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) or (AOpacity = 0) then exit;
5191 IntersectRect(AOutputBounds,AOutputBounds,ClipRect);
5192 if IsRectEmpty(AOutputBounds) then exit;
5193
5194 if IsAffineRoughlyTranslation(AMatrix, rect(0,0,Source.Width,Source.Height)) then
5195 begin
5196 sourceBounds := AOutputBounds;
5197 OffsetRect(sourceBounds, -round(AMatrix[1,3]),-round(AMatrix[2,3]));
5198 IntersectRect(sourceBounds,sourceBounds,rect(0,0,Source.Width,Source.Height));
5199 PutImagePart(round(AMatrix[1,3])+sourceBounds.Left,round(AMatrix[2,3])+sourceBounds.Top,Source,sourceBounds,AMode,AOpacity);
5200 end else
5201 begin
5202 affine := TBGRAAffineBitmapTransform.Create(Source, false, AResampleFilter);
5203 affine.GlobalOpacity := AOpacity;
5204 affine.ViewMatrix := AMatrix;
5205 FillRect(AOutputBounds,affine,AMode);
5206 affine.Free;
5207 end;
5208end;
5209
5210function TBGRADefaultBitmap.GetImageAffineBounds(AMatrix: TAffineMatrix;
5211 ASourceBounds: TRect; AClipOutput: boolean): TRect;
5212const pointMargin = 0.5 - 1/512;
5213
5214 procedure FirstPoint(pt: TPointF);
5215 begin
5216 result.Left := round(pt.X);
5217 result.Top := round(pt.Y);
5218 result.Right := round(pt.X)+1;
5219 result.Bottom := round(pt.Y)+1;
5220 end;
5221
5222 //include specified point in the bounds
5223 procedure IncludePoint(pt: TPointF);
5224 begin
5225 if round(pt.X) < result.Left then result.Left := round(pt.X);
5226 if round(pt.Y) < result.Top then result.Top := round(pt.Y);
5227 if round(pt.X)+1 > result.Right then result.Right := round(pt.X)+1;
5228 if round(pt.Y)+1 > result.Bottom then result.Bottom := round(pt.Y)+1;
5229 end;
5230
5231begin
5232 result := EmptyRect;
5233 if IsRectEmpty(ASourceBounds) then exit;
5234 if IsAffineRoughlyTranslation(AMatrix,ASourceBounds) then
5235 begin
5236 result := ASourceBounds;
5237 OffsetRect(result,round(AMatrix[1,3]),round(AMatrix[2,3]));
5238 end else
5239 begin
5240 FirstPoint(AMatrix*PointF(ASourceBounds.Left-pointMargin,ASourceBounds.Top-pointMargin));
5241 IncludePoint(AMatrix*PointF(ASourceBounds.Right-1+pointMargin,ASourceBounds.Top-pointMargin));
5242 IncludePoint(AMatrix*PointF(ASourceBounds.Left-pointMargin,ASourceBounds.Bottom-1+pointMargin));
5243 IncludePoint(AMatrix*PointF(ASourceBounds.Right-1+pointMargin,ASourceBounds.Bottom-1+pointMargin));
5244 end;
5245 if AClipOutput then IntersectRect(result,result,ClipRect);
5246end;
5247
5248procedure TBGRADefaultBitmap.StretchPutImage(ARect: TRect;
5249 Source: TBGRACustomBitmap; mode: TDrawMode; AOpacity: byte);
5250var noTransition: boolean;
5251begin
5252 If (Source = nil) or (AOpacity = 0) then exit;
5253 if (ARect.Right-ARect.Left = Source.Width) and (ARect.Bottom-ARect.Top = Source.Height) then
5254 PutImage(ARect.Left,ARect.Top,Source,mode,AOpacity)
5255 else
5256 begin
5257 noTransition:= (mode = dmXor) or ((mode in [dmDrawWithTransparency,dmFastBlend,dmSetExceptTransparent]) and
5258 (Source is TBGRADefaultBitmap) and
5259 Assigned(TBGRADefaultBitmap(Source).XorMask));
5260 BGRAResample.StretchPutImage(Source, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, self, ARect.left,ARect.Top, mode, AOpacity, noTransition);
5261 if (mode in [dmDrawWithTransparency,dmFastBlend,dmSetExceptTransparent]) and Assigned(TBGRADefaultBitmap(Source).XorMask) then
5262 BGRAResample.StretchPutImage(TBGRADefaultBitmap(Source).XorMask, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, self, ARect.left,ARect.Top, dmXor, AOpacity, noTransition);
5263 end;
5264end;
5265
5266{ Duplicate bitmap content. Optionally, bitmap properties can be also duplicated }
5267function TBGRADefaultBitmap.Duplicate(DuplicateProperties: Boolean = False; DuplicateXorMask: Boolean = False): TBGRACustomBitmap;
5268var Temp: TBGRADefaultBitmap;
5269begin
5270 LoadFromBitmapIfNeeded;
5271 Temp := NewBitmap(Width, Height) as TBGRADefaultBitmap;
5272 Temp.PutImage(0, 0, self, dmSet);
5273 Temp.Caption := self.Caption;
5274 if DuplicateProperties then
5275 CopyPropertiesTo(Temp);
5276 if DuplicateXorMask and Assigned(XorMask) then
5277 Temp.FXorMask := FXorMask.Duplicate(True) as TBGRADefaultBitmap;
5278 Result := Temp;
5279end;
5280
5281{ Copy properties only }
5282procedure TBGRADefaultBitmap.CopyPropertiesTo(ABitmap: TBGRADefaultBitmap);
5283begin
5284 ABitmap.CanvasOpacity := CanvasOpacity;
5285 ABitmap.CanvasDrawModeFP := CanvasDrawModeFP;
5286 ABitmap.PenStyle := PenStyle;
5287 ABitmap.CustomPenStyle := CustomPenStyle;
5288 ABitmap.FontHeight := FontHeight;
5289 ABitmap.FontName := FontName;
5290 ABitmap.FontStyle := FontStyle;
5291 ABitmap.FontAntialias := FontAntialias;
5292 ABitmap.FontOrientation := FontOrientation;
5293 ABitmap.FontBidiMode:= FontBidiMode;
5294 ABitmap.LineCap := LineCap;
5295 ABitmap.JoinStyle := JoinStyle;
5296 ABitmap.FillMode := FillMode;
5297 ABitmap.ClipRect := ClipRect;
5298 ABitmap.HotSpot := HotSpot;
5299end;
5300
5301{ Check if two bitmaps have the same content }
5302function TBGRADefaultBitmap.Equals(comp: TBGRACustomBitmap): boolean;
5303var
5304 yb, xb: integer;
5305 pself, pcomp: PBGRAPixel;
5306begin
5307 if comp = nil then
5308 Result := False
5309 else
5310 if (comp.Width <> Width) or (comp.Height <> Height) then
5311 Result := False
5312 else
5313 begin
5314 Result := True;
5315 for yb := 0 to Height - 1 do
5316 begin
5317 pself := ScanLine[yb];
5318 pcomp := comp.Scanline[yb];
5319 for xb := 0 to Width - 1 do
5320 begin
5321 if pself^ <> pcomp^ then
5322 begin
5323 Result := False;
5324 exit;
5325 end;
5326 Inc(pself);
5327 Inc(pcomp);
5328 end;
5329 end;
5330 end;
5331end;
5332
5333{ Check if a bitmap is filled wih the specified color }
5334function TBGRADefaultBitmap.Equals(comp: TBGRAPixel): boolean;
5335var
5336 i: integer;
5337 p: PBGRAPixel;
5338begin
5339 p := Data;
5340 for i := NbPixels - 1 downto 0 do
5341 begin
5342 if p^ <> comp then
5343 begin
5344 Result := False;
5345 exit;
5346 end;
5347 Inc(p);
5348 end;
5349 Result := True;
5350end;
5351
5352{----------------------------- Filters -----------------------------------------}
5353{ Call the appropriate function }
5354
5355function TBGRADefaultBitmap.FilterSmartZoom3(Option: TMedianOption): TBGRACustomBitmap;
5356begin
5357 Result := BGRAFilters.FilterSmartZoom3(self, Option);
5358end;
5359
5360function TBGRADefaultBitmap.FilterMedian(Option: TMedianOption): TBGRACustomBitmap;
5361begin
5362 Result := BGRAFilters.FilterMedian(self, option);
5363end;
5364
5365function TBGRADefaultBitmap.FilterSmooth: TBGRACustomBitmap;
5366begin
5367 Result := BGRAFilters.FilterBlurRadial(self, 3, rbPrecise);
5368end;
5369
5370function TBGRADefaultBitmap.FilterSphere: TBGRACustomBitmap;
5371begin
5372 Result := BGRAFilters.FilterSphere(self);
5373end;
5374
5375function TBGRADefaultBitmap.FilterTwirl(ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
5376begin
5377 Result := BGRAFilters.FilterTwirl(self, ACenter, ARadius, ATurn, AExponent);
5378end;
5379
5380function TBGRADefaultBitmap.FilterTwirl(ABounds: TRect; ACenter: TPoint;
5381 ARadius: Single; ATurn: Single; AExponent: Single): TBGRACustomBitmap;
5382begin
5383 result := BGRAFilters.FilterTwirl(self, ABounds, ACenter, ARadius, ATurn, AExponent);
5384end;
5385
5386function TBGRADefaultBitmap.FilterCylinder: TBGRACustomBitmap;
5387begin
5388 Result := BGRAFilters.FilterCylinder(self);
5389end;
5390
5391function TBGRADefaultBitmap.FilterPlane: TBGRACustomBitmap;
5392begin
5393 Result := BGRAFilters.FilterPlane(self);
5394end;
5395
5396function TBGRADefaultBitmap.FilterSharpen(Amount: single = 1): TBGRACustomBitmap;
5397begin
5398 Result := BGRAFilters.FilterSharpen(self,round(Amount*256));
5399end;
5400
5401function TBGRADefaultBitmap.FilterSharpen(ABounds: TRect; Amount: single
5402 ): TBGRACustomBitmap;
5403begin
5404 Result := BGRAFilters.FilterSharpen(self,ABounds,round(Amount*256));
5405end;
5406
5407function TBGRADefaultBitmap.FilterContour: TBGRACustomBitmap;
5408begin
5409 Result := BGRAFilters.FilterContour(self);
5410end;
5411
5412function TBGRADefaultBitmap.FilterBlurRadial(radius: single;
5413 blurType: TRadialBlurType): TBGRACustomBitmap;
5414begin
5415 Result := BGRAFilters.FilterBlurRadial(self, radius, blurType);
5416end;
5417
5418function TBGRADefaultBitmap.FilterBlurRadial(ABounds: TRect; radius: single;
5419 blurType: TRadialBlurType): TBGRACustomBitmap;
5420var task: TFilterTask;
5421begin
5422 task := BGRAFilters.CreateRadialBlurTask(self, ABounds, radius, blurType);
5423 try
5424 result := task.Execute;
5425 finally
5426 task.Free;
5427 end;
5428end;
5429
5430function TBGRADefaultBitmap.FilterBlurRadial(radiusX, radiusY: single;
5431 blurType: TRadialBlurType): TBGRACustomBitmap;
5432begin
5433 Result := BGRAFilters.FilterBlurRadial(self, radiusX,radiusY, blurType);
5434end;
5435
5436function TBGRADefaultBitmap.FilterBlurRadial(ABounds: TRect; radiusX,
5437 radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap;
5438var task: TFilterTask;
5439begin
5440 task := BGRAFilters.CreateRadialBlurTask(self, ABounds, radiusX,radiusY, blurType);
5441 try
5442 result := task.Execute;
5443 finally
5444 task.Free;
5445 end;
5446end;
5447
5448function TBGRADefaultBitmap.FilterPixelate(pixelSize: integer;
5449 useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap;
5450begin
5451 Result:= BGRAFilters.FilterPixelate(self, pixelSize, useResample, filter);
5452end;
5453
5454function TBGRADefaultBitmap.FilterBlurMotion(distance: single;
5455 angle: single; oriented: boolean): TBGRACustomBitmap;
5456begin
5457 Result := BGRAFilters.FilterBlurMotion(self, distance, angle, oriented);
5458end;
5459
5460function TBGRADefaultBitmap.FilterBlurMotion(ABounds: TRect; distance: single;
5461 angle: single; oriented: boolean): TBGRACustomBitmap;
5462var task: TFilterTask;
5463begin
5464 task := BGRAFilters.CreateMotionBlurTask(self,ABounds,distance,angle,oriented);
5465 try
5466 Result := task.Execute;
5467 finally
5468 task.Free;
5469 end;
5470end;
5471
5472function TBGRADefaultBitmap.FilterCustomBlur(mask: TBGRACustomBitmap):
5473TBGRACustomBitmap;
5474begin
5475 Result := BGRAFilters.FilterBlur(self, mask);
5476end;
5477
5478function TBGRADefaultBitmap.FilterCustomBlur(ABounds: TRect;
5479 mask: TBGRACustomBitmap): TBGRACustomBitmap;
5480var task: TFilterTask;
5481begin
5482 task := BGRAFilters.CreateBlurTask(self, ABounds, mask);
5483 try
5484 result := task.Execute;
5485 finally
5486 task.Free;
5487 end;
5488end;
5489
5490function TBGRADefaultBitmap.FilterEmboss(angle: single;
5491 AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap;
5492begin
5493 Result := BGRAFilters.FilterEmboss(self, angle, AStrength, AOptions);
5494end;
5495
5496function TBGRADefaultBitmap.FilterEmboss(angle: single; ABounds: TRect;
5497 AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap;
5498begin
5499 Result := BGRAFilters.FilterEmboss(self, angle, ABounds, AStrength, AOptions);
5500end;
5501
5502function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean):
5503TBGRACustomBitmap;
5504begin
5505 Result := BGRAFilters.FilterEmbossHighlight(self, FillSelection, BGRAPixelTransparent);
5506end;
5507
5508function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean;
5509 BorderColor: TBGRAPixel): TBGRACustomBitmap;
5510begin
5511 Result := BGRAFilters.FilterEmbossHighlight(self, FillSelection, BorderColor);
5512end;
5513
5514function TBGRADefaultBitmap.FilterEmbossHighlight(FillSelection: boolean;
5515 BorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap;
5516begin
5517 Result := BGRAFilters.FilterEmbossHighlightOffset(self, FillSelection, BorderColor, Offset);
5518end;
5519
5520function TBGRADefaultBitmap.FilterGrayscale: TBGRACustomBitmap;
5521begin
5522 Result := BGRAFilters.FilterGrayscale(self);
5523end;
5524
5525function TBGRADefaultBitmap.FilterGrayscale(ABounds: TRect): TBGRACustomBitmap;
5526begin
5527 Result := BGRAFilters.FilterGrayscale(self, ABounds);
5528end;
5529
5530function TBGRADefaultBitmap.FilterNormalize(eachChannel: boolean = True):
5531TBGRACustomBitmap;
5532begin
5533 Result := BGRAFilters.FilterNormalize(self, eachChannel);
5534end;
5535
5536function TBGRADefaultBitmap.FilterNormalize(ABounds: TRect; eachChannel: boolean): TBGRACustomBitmap;
5537begin
5538 Result := BGRAFilters.FilterNormalize(self, ABounds, eachChannel);
5539end;
5540
5541function TBGRADefaultBitmap.FilterRotate(origin: TPointF;
5542 angle: single; correctBlur: boolean): TBGRACustomBitmap;
5543begin
5544 Result := BGRAFilters.FilterRotate(self, origin, angle, correctBlur);
5545end;
5546
5547function TBGRADefaultBitmap.FilterAffine(AMatrix: TAffineMatrix;
5548 correctBlur: boolean): TBGRACustomBitmap;
5549begin
5550 Result := NewBitmap(Width,Height);
5551 Result.PutImageAffine(AMatrix,self,255,correctBlur);
5552end;
5553
5554function TBGRADefaultBitmap.GetHasTransparentPixels: boolean;
5555var
5556 p: PBGRAPixel;
5557 n: integer;
5558begin
5559 p := Data;
5560 for n := NbPixels - 1 downto 0 do
5561 begin
5562 if p^.alpha <> 255 then
5563 begin
5564 Result := True;
5565 exit;
5566 end;
5567 Inc(p);
5568 end;
5569 Result := False;
5570end;
5571
5572function TBGRADefaultBitmap.GetHasSemiTransparentPixels: boolean;
5573var
5574 n: integer;
5575 p: PBGRAPixel;
5576begin
5577 p := Data;
5578 for n := NbPixels - 1 downto 0 do
5579 begin
5580 if (p^.alpha > 0) and (p^.alpha < 255) then
5581 begin
5582 result := true;
5583 exit;
5584 end;
5585 inc(p);
5586 end;
5587 result := false;
5588end;
5589
5590function TBGRADefaultBitmap.GetAverageColor: TColor;
5591var
5592 pix: TBGRAPixel;
5593begin
5594 pix := GetAveragePixel;
5595 {$hints off}
5596 if pix.alpha = 0 then
5597 result := clNone else
5598 result := RGBToColor(pix.red,pix.green,pix.blue);
5599 {$hints on}
5600end;
5601
5602function TBGRADefaultBitmap.GetAveragePixel: TBGRAPixel;
5603var
5604 n: integer;
5605 p: PBGRAPixel;
5606 r, g, b, sum: double;
5607 alpha: double;
5608begin
5609 sum := 0;
5610 r := 0;
5611 g := 0;
5612 b := 0;
5613 p := Data;
5614 for n := NbPixels - 1 downto 0 do
5615 begin
5616 alpha := p^.alpha / 255;
5617 sum += alpha;
5618 r += p^.red * alpha;
5619 g += p^.green * alpha;
5620 b += p^.blue * alpha;
5621 Inc(p);
5622 end;
5623 if sum = 0 then
5624 Result := BGRAPixelTransparent
5625 else
5626 Result := BGRA(round(r / sum),round(g / sum),round(b / sum),round(sum*255/NbPixels));
5627end;
5628
5629function TBGRADefaultBitmap.GetPenJoinStyle: TPenJoinStyle;
5630begin
5631 result := FPenStroker.JoinStyle;
5632end;
5633
5634procedure TBGRADefaultBitmap.SetPenJoinStyle(const AValue: TPenJoinStyle);
5635begin
5636 FPenStroker.JoinStyle := AValue;
5637end;
5638
5639function TBGRADefaultBitmap.GetPenMiterLimit: single;
5640begin
5641 result := FPenStroker.MiterLimit;
5642end;
5643
5644procedure TBGRADefaultBitmap.SetPenMiterLimit(const AValue: single);
5645begin
5646 FPenStroker.MiterLimit := AValue;
5647end;
5648
5649procedure TBGRADefaultBitmap.SetCanvasOpacity(AValue: byte);
5650begin
5651 LoadFromBitmapIfNeeded;
5652 FCanvasOpacity := AValue;
5653end;
5654
5655function TBGRADefaultBitmap.GetDataPtr: PBGRAPixel;
5656begin
5657 LoadFromBitmapIfNeeded;
5658 Result := FData;
5659end;
5660
5661{----------------------------- Resample ---------------------------------------}
5662
5663function TBGRADefaultBitmap.FineResample(NewWidth, NewHeight: integer):
5664TBGRACustomBitmap;
5665begin
5666 Result := BGRAResample.FineResample(self, NewWidth, NewHeight, ResampleFilter);
5667end;
5668
5669function TBGRADefaultBitmap.SimpleStretch(NewWidth, NewHeight: integer):
5670TBGRACustomBitmap;
5671begin
5672 Result := BGRAResample.SimpleStretch(self, NewWidth, NewHeight);
5673end;
5674
5675function TBGRADefaultBitmap.Resample(newWidth, newHeight: integer;
5676 mode: TResampleMode): TBGRACustomBitmap;
5677begin
5678 case mode of
5679 rmFineResample: Result := FineResample(newWidth, newHeight);
5680 rmSimpleStretch: Result := SimpleStretch(newWidth, newHeight);
5681 else
5682 Result := nil;
5683 end;
5684end;
5685
5686{-------------------------------- Data functions ------------------------}
5687
5688{ Flip vertically the bitmap. Use a temporary line to store top line,
5689 assign bottom line to top line, then assign temporary line to bottom line.
5690
5691 It is an involution, i.e it does nothing when applied twice }
5692procedure TBGRADefaultBitmap.VerticalFlip(ARect: TRect);
5693var
5694 yb,h2: integer;
5695 line: PBGRAPixel;
5696 linesize, delta: integer;
5697 PStart: PBGRAPixel;
5698 PEnd: PBGRAPixel;
5699begin
5700 if FData = nil then
5701 exit;
5702
5703 if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit;
5704 if not IntersectRect(ARect, ARect, rect(0,0,Width,Height)) then exit;
5705 LoadFromBitmapIfNeeded;
5706 linesize := (ARect.Right-ARect.Left) * sizeof(TBGRAPixel);
5707 line := nil;
5708 getmem(line, linesize);
5709 PStart := GetScanlineFast(ARect.Top)+ARect.Left;
5710 PEnd := GetScanlineFast(ARect.Bottom-1)+ARect.Left;
5711 h2 := (ARect.Bottom-ARect.Top) div 2;
5712 if LineOrder = riloTopToBottom then delta := +Width else delta := -Width;
5713 for yb := h2-1 downto 0 do
5714 begin
5715 move(PStart^, line^, linesize);
5716 move(PEnd^, PStart^, linesize);
5717 move(line^, PEnd^, linesize);
5718 Inc(PStart, delta);
5719 Dec(PEnd, delta);
5720 end;
5721 freemem(line);
5722 InvalidateBitmap;
5723
5724 if Assigned(XorMask) then XorMask.VerticalFlip(ARect);
5725end;
5726
5727{ Flip horizontally. Swap left pixels with right pixels on each line.
5728
5729 It is an involution, i.e it does nothing when applied twice}
5730procedure TBGRADefaultBitmap.HorizontalFlip(ARect: TRect);
5731var
5732 yb, xb, w: integer;
5733 PStart: PBGRAPixel;
5734 PEnd: PBGRAPixel;
5735 temp: TBGRAPixel;
5736begin
5737 if FData = nil then
5738 exit;
5739
5740 if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit;
5741 if not IntersectRect(ARect, ARect, rect(0,0,Width,Height)) then exit;
5742 w := ARect.Right-ARect.Left;
5743 LoadFromBitmapIfNeeded;
5744 for yb := ARect.Top to ARect.Bottom-1 do
5745 begin
5746 PStart := GetScanlineFast(yb)+ARect.Left;
5747 PEnd := PStart + w;
5748 for xb := 0 to (w div 2) - 1 do
5749 begin
5750 Dec(PEnd);
5751 temp := PStart^;
5752 PStart^ := PEnd^;
5753 PEnd^ := temp;
5754 Inc(PStart);
5755 end;
5756 end;
5757 InvalidateBitmap;
5758
5759 if Assigned(XorMask) then XorMask.HorizontalFlip(ARect);
5760end;
5761
5762{ Return a new bitmap rotated in a clock wise direction. }
5763function TBGRADefaultBitmap.RotateCW: TBGRACustomBitmap;
5764var
5765 psrc, pdest: PBGRAPixel;
5766 yb, xb: integer;
5767 delta: integer;
5768begin
5769 LoadFromBitmapIfNeeded;
5770 Result := NewBitmap(Height, Width);
5771 if Result.LineOrder = riloTopToBottom then
5772 delta := Result.Width
5773 else
5774 delta := -Result.Width;
5775 for yb := 0 to Height - 1 do
5776 begin
5777 psrc := Scanline[yb];
5778 pdest := Result.Scanline[0] + (Height - 1 - yb);
5779 for xb := 0 to Width - 1 do
5780 begin
5781 pdest^ := psrc^;
5782 Inc(psrc);
5783 Inc(pdest, delta);
5784 end;
5785 end;
5786
5787 if Assigned(XorMask) then TBGRADefaultBitmap(result).FXorMask := self.XorMask.RotateCW;
5788end;
5789
5790{ Return a new bitmap rotated in a counter clock wise direction. }
5791function TBGRADefaultBitmap.RotateCCW: TBGRACustomBitmap;
5792var
5793 psrc, pdest: PBGRAPixel;
5794 yb, xb: integer;
5795 delta: integer;
5796begin
5797 LoadFromBitmapIfNeeded;
5798 Result := NewBitmap(Height, Width);
5799 if Result.LineOrder = riloTopToBottom then
5800 delta := Result.Width
5801 else
5802 delta := -Result.Width;
5803 for yb := 0 to Height - 1 do
5804 begin
5805 psrc := Scanline[yb];
5806 pdest := Result.Scanline[Width - 1] + yb;
5807 for xb := 0 to Width - 1 do
5808 begin
5809 pdest^ := psrc^;
5810 Inc(psrc);
5811 Dec(pdest, delta);
5812 end;
5813 end;
5814
5815 if Assigned(XorMask) then TBGRADefaultBitmap(result).FXorMask := self.XorMask.RotateCCW;
5816end;
5817
5818{ Compute negative with gamma correction. A negative contains
5819 complentary colors (black becomes white etc.).
5820
5821 It is NOT EXACTLY an involution, when applied twice, some color information is lost }
5822procedure TBGRADefaultBitmap.Negative;
5823begin
5824 TBGRAFilterScannerNegative.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), True);
5825end;
5826
5827procedure TBGRADefaultBitmap.NegativeRect(ABounds: TRect);
5828begin
5829 if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
5830 TBGRAFilterScannerNegative.ComputeFilterInplace(self, ABounds, True);
5831end;
5832
5833{ Compute negative without gamma correction.
5834
5835 It is an involution, i.e it does nothing when applied twice }
5836procedure TBGRADefaultBitmap.LinearNegative;
5837begin
5838 TBGRAFilterScannerNegative.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), False);
5839end;
5840
5841procedure TBGRADefaultBitmap.LinearNegativeRect(ABounds: TRect);
5842begin
5843 if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
5844 TBGRAFilterScannerNegative.ComputeFilterInplace(self, ABounds, False);
5845end;
5846
5847procedure TBGRADefaultBitmap.InplaceGrayscale(AGammaCorrection: boolean = true);
5848begin
5849 TBGRAFilterScannerGrayscale.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), AGammaCorrection);
5850end;
5851
5852procedure TBGRADefaultBitmap.InplaceGrayscale(ABounds: TRect; AGammaCorrection: boolean = true);
5853begin
5854 if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
5855 TBGRAFilterScannerGrayscale.ComputeFilterInplace(self, ABounds, AGammaCorrection);
5856end;
5857
5858procedure TBGRADefaultBitmap.InplaceNormalize(AEachChannel: boolean);
5859begin
5860 InplaceNormalize(rect(0,0,Width,Height),AEachChannel);
5861end;
5862
5863procedure TBGRADefaultBitmap.InplaceNormalize(ABounds: TRect;
5864 AEachChannel: boolean);
5865var scanner: TBGRAFilterScannerNormalize;
5866begin
5867 if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
5868 scanner := TBGRAFilterScannerNormalize.Create(self,Point(0,0),ABounds,AEachChannel);
5869 FillRect(ABounds,scanner,dmSet);
5870 scanner.Free;
5871end;
5872
5873{ Swap red and blue channels. Useful when RGB order is swapped.
5874
5875 It is an involution, i.e it does nothing when applied twice }
5876procedure TBGRADefaultBitmap.SwapRedBlue;
5877begin
5878 TBGRAFilterScannerSwapRedBlue.ComputeFilterInplace(self, rect(0,0,FWidth,FHeight), False);
5879end;
5880
5881procedure TBGRADefaultBitmap.SwapRedBlue(ARect: TRect);
5882begin
5883 if not CheckClippedRectBounds(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom) then exit;
5884 TBGRAFilterScannerSwapRedBlue.ComputeFilterInplace(self, ARect, False);
5885end;
5886
5887{ Convert a grayscale image into a black image with alpha value }
5888procedure TBGRADefaultBitmap.GrayscaleToAlpha;
5889var
5890 n: integer;
5891 p: PLongword;
5892begin
5893 LoadFromBitmapIfNeeded;
5894 p := PLongword(Data);
5895 n := NbPixels;
5896 if n = 0 then
5897 exit;
5898 repeat
5899 p^ := (p^ shr TBGRAPixel_RedShift and $FF) shl TBGRAPixel_AlphaShift;
5900 Inc(p);
5901 Dec(n);
5902 until n = 0;
5903 InvalidateBitmap;
5904end;
5905
5906procedure TBGRADefaultBitmap.AlphaToGrayscale;
5907var
5908 n: integer;
5909 temp: longword;
5910 p: PLongword;
5911begin
5912 LoadFromBitmapIfNeeded;
5913 p := PLongword(Data);
5914 n := NbPixels;
5915 if n = 0 then
5916 exit;
5917 repeat
5918 temp := (p^ shr TBGRAPixel_AlphaShift) and $ff;
5919 p^ := (temp shl TBGRAPixel_RedShift) or (temp shl TBGRAPixel_GreenShift)
5920 or (temp shl TBGRAPixel_BlueShift) or ($ff shl TBGRAPixel_AlphaShift);
5921 Inc(p);
5922 Dec(n);
5923 until n = 0;
5924 InvalidateBitmap;
5925end;
5926
5927{ Apply a mask to the bitmap. It means that alpha channel is
5928 changed according to grayscale values of the mask.
5929
5930 See : http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial_5 }
5931procedure TBGRADefaultBitmap.ApplyMask(mask: TBGRACustomBitmap; ARect: TRect; AMaskRectTopLeft: TPoint);
5932var
5933 p, pmask: PBGRAPixel;
5934 yb, xb: integer;
5935 MaskOffsetX,MaskOffsetY,w: integer;
5936 opacity: NativeUint;
5937begin
5938 if (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then exit;
5939 IntersectRect(ARect, ARect, rect(0,0,Width,Height));
5940 MaskOffsetX := AMaskRectTopLeft.x - ARect.Left;
5941 MaskOffsetY := AMaskRectTopLeft.y - ARect.Top;
5942 OffsetRect(ARect, MaskOffsetX, MaskOffsetY);
5943 IntersectRect(ARect, ARect, rect(0,0,mask.Width,mask.Height));
5944 OffsetRect(ARect, -MaskOffsetX, -MaskOffsetY);
5945
5946 LoadFromBitmapIfNeeded;
5947 w := ARect.Right-ARect.Left-1;
5948 for yb := ARect.Top to ARect.Bottom - 1 do
5949 begin
5950 p := Scanline[yb]+ARect.Left;
5951 pmask := Mask.Scanline[yb+MaskOffsetY]+ARect.Left+MaskOffsetX;
5952 for xb := w downto 0 do
5953 begin
5954 opacity := ApplyOpacity(p^.alpha, pmask^.red);
5955 if opacity = 0 then p^ := BGRAPixelTransparent
5956 else p^.alpha := opacity;
5957 Inc(p);
5958 Inc(pmask);
5959 end;
5960 end;
5961 InvalidateBitmap;
5962end;
5963
5964function TBGRADefaultBitmap.GetMaskFromAlpha: TBGRACustomBitmap;
5965var y,x: integer;
5966 psrc, pdest: PBGRAPixel;
5967begin
5968 result := BGRABitmapFactory.Create(Width,Height);
5969 for y := 0 to self.Height-1 do
5970 begin
5971 psrc := self.ScanLine[y];
5972 pdest := result.ScanLine[y];
5973 for x := 0 to self.Width-1 do
5974 begin
5975 pdest^ := BGRA(psrc^.alpha,psrc^.alpha,psrc^.alpha);
5976 inc(psrc);
5977 inc(pdest);
5978 end;
5979 end;
5980end;
5981
5982procedure TBGRADefaultBitmap.ApplyGlobalOpacity(alpha: byte);
5983var
5984 p: PBGRAPixel;
5985 i: integer;
5986begin
5987 if alpha = 0 then
5988 FillTransparent
5989 else
5990 if alpha <> 255 then
5991 begin
5992 p := Data;
5993 for i := NbPixels - 1 downto 0 do
5994 begin
5995 p^.alpha := ApplyOpacity(p^.alpha, alpha);
5996 Inc(p);
5997 end;
5998 end;
5999end;
6000
6001procedure TBGRADefaultBitmap.ApplyGlobalOpacity(ABounds: TRect; alpha: byte);
6002var p: PBGRAPixel;
6003 xb,yb,xcount: integer;
6004begin
6005 if not IntersectRect(ABounds,ABounds,ClipRect) then exit;
6006 xcount := ABounds.Right-ABounds.Left;
6007 for yb := ABounds.Top to ABounds.Bottom-1 do
6008 begin
6009 p := ScanLine[yb]+ABounds.Left;
6010 for xb := xcount-1 downto 0 do
6011 begin
6012 p^.alpha := ApplyOpacity(p^.alpha, alpha);
6013 Inc(p);
6014 end;
6015 end;
6016 InvalidateBitmap;
6017end;
6018
6019procedure TBGRADefaultBitmap.ConvertToLinearRGB;
6020var p: PBGRAPixel;
6021 n: integer;
6022begin
6023 p := Data;
6024 for n := NbPixels-1 downto 0 do
6025 begin
6026 p^.red := GammaExpansionTab[p^.red] shr 8;
6027 p^.green := GammaExpansionTab[p^.green] shr 8;
6028 p^.blue := GammaExpansionTab[p^.blue] shr 8;
6029 inc(p);
6030 end;
6031end;
6032
6033procedure TBGRADefaultBitmap.ConvertFromLinearRGB;
6034var p: PBGRAPixel;
6035 n: integer;
6036begin
6037 p := Data;
6038 for n := NbPixels-1 downto 0 do
6039 begin
6040 p^.red := GammaCompressionTab[p^.red shl 8 + p^.red];
6041 p^.green := GammaCompressionTab[p^.green shl 8 + p^.green];
6042 p^.blue := GammaCompressionTab[p^.blue shl 8 + p^.blue];
6043 inc(p);
6044 end;
6045end;
6046
6047procedure TBGRADefaultBitmap.DrawCheckers(ARect: TRect; AColorEven,
6048 AColorOdd: TBGRAPixel);
6049const tx = 8; ty = 8; //must be a power of 2
6050 xMask = tx*2-1;
6051var xcount,patY,w,n,patY1,patY2m1,patX,patX1: NativeInt;
6052 pdest: PBGRAPixel;
6053 delta: PtrInt;
6054 actualRect: TRect;
6055begin
6056 actualRect := ARect;
6057 IntersectRect(actualRect, ARect, self.ClipRect);
6058 w := actualRect.Right-actualRect.Left;
6059 if (w <= 0) or (actualRect.Bottom <= actualRect.Top) then exit;
6060 delta := self.Width;
6061 if self.LineOrder = riloBottomToTop then delta := -delta;
6062 delta := (delta-w)*SizeOf(TBGRAPixel);
6063 pdest := self.ScanLine[actualRect.Top]+actualRect.left;
6064 patY1 := actualRect.Top - ARect.Top;
6065 patY2m1 := actualRect.Bottom - ARect.Top-1;
6066 patX1 := (actualRect.Left - ARect.Left) and xMask;
6067 for patY := patY1 to patY2m1 do
6068 begin
6069 xcount := w;
6070 if patY and ty = 0 then
6071 patX := patX1
6072 else
6073 patX := (patX1+tx) and xMask;
6074 while xcount > 0 do
6075 begin
6076 if patX and tx = 0 then
6077 begin
6078 n := 8-patX;
6079 if n > xcount then n := xcount;
6080 FillDWord(pdest^,n,DWord(AColorEven));
6081 dec(xcount,n);
6082 inc(pdest,n);
6083 patX := tx;
6084 end else
6085 begin
6086 n := 16-patX;
6087 if n > xcount then n := xcount;
6088 FillDWord(pdest^,n,DWord(AColorOdd));
6089 dec(xcount,n);
6090 inc(pdest,n);
6091 patX := 0;
6092 end;
6093 end;
6094 inc(pbyte(pdest),delta);
6095 end;
6096 self.InvalidateBitmap;
6097end;
6098
6099function TBGRADefaultBitmap.GetDifferenceBounds(ABitmap: TBGRACustomBitmap): TRect;
6100var
6101 minx, miny, maxx, maxy: integer;
6102 xb, yb: integer;
6103 p, p2: PBGRAPixel;
6104begin
6105 if (ABitmap.Width <> Width) or (ABitmap.Height <> Height) then
6106 begin
6107 result := rect(0,0,Width,Height);
6108 if ABitmap.Width > result.Right then result.Right := ABitmap.Width;
6109 if ABitmap.Height > result.bottom then result.bottom := ABitmap.Height;
6110 exit;
6111 end;
6112 maxx := -1;
6113 maxy := -1;
6114 minx := self.Width;
6115 miny := self.Height;
6116 for yb := 0 to self.Height - 1 do
6117 begin
6118 p := self.ScanLine[yb];
6119 p2 := ABitmap.ScanLine[yb];
6120 for xb := 0 to self.Width - 1 do
6121 begin
6122 if p^ <> p2^ then
6123 begin
6124 if xb < minx then
6125 minx := xb;
6126 if yb < miny then
6127 miny := yb;
6128 if xb > maxx then
6129 maxx := xb;
6130 if yb > maxy then
6131 maxy := yb;
6132 end;
6133 Inc(p);
6134 Inc(p2);
6135 end;
6136 end;
6137 if minx > maxx then
6138 begin
6139 Result.left := 0;
6140 Result.top := 0;
6141 Result.right := 0;
6142 Result.bottom := 0;
6143 end
6144 else
6145 begin
6146 Result.left := minx;
6147 Result.top := miny;
6148 Result.right := maxx + 1;
6149 Result.bottom := maxy + 1;
6150 end;
6151end;
6152
6153{ Make a copy of the transparent bitmap to a TBitmap with a background color
6154 instead of transparency }
6155function TBGRADefaultBitmap.MakeBitmapCopy(BackgroundColor: TColor): TBitmap;
6156var
6157 opaqueCopy: TBGRACustomBitmap;
6158begin
6159 Result := TBitmap.Create;
6160 Result.Width := Width;
6161 Result.Height := Height;
6162 opaqueCopy := NewBitmap(Width, Height);
6163 opaqueCopy.Fill(ColorToRGB(BackgroundColor));
6164 opaqueCopy.PutImage(0, 0, self, dmDrawWithTransparency);
6165 opaqueCopy.Draw(Result.canvas, 0, 0, True);
6166 opaqueCopy.Free;
6167end;
6168
6169{ Get a part of the image with repetition in both directions. It means
6170 that if the bounds are within the image, the result is just that part
6171 of the image, but if the bounds are bigger than the image, the image
6172 is tiled. }
6173function TBGRADefaultBitmap.GetPart(ARect: TRect): TBGRACustomBitmap;
6174var
6175 copywidth, copyheight, widthleft, heightleft, curxin, curyin, xdest,
6176 ydest, tx, ty: integer;
6177begin
6178 tx := ARect.Right - ARect.Left;
6179 ty := ARect.Bottom - ARect.Top;
6180
6181 if (tx <= 0) or (ty <= 0) then
6182 begin
6183 result := nil;
6184 exit;
6185 end;
6186
6187 LoadFromBitmapIfNeeded;
6188 if ARect.Left >= Width then
6189 ARect.Left := ARect.Left mod Width
6190 else
6191 if ARect.Left < 0 then
6192 ARect.Left := Width - ((-ARect.Left) mod Width);
6193 ARect.Right := ARect.Left + tx;
6194
6195 if ARect.Top >= Height then
6196 ARect.Top := ARect.Top mod Height
6197 else
6198 if ARect.Top < 0 then
6199 ARect.Top := Height - ((-ARect.Top) mod Height);
6200 ARect.Bottom := ARect.Top + ty;
6201
6202 if (ARect.Left = 0) and (ARect.Top = 0) and
6203 (ARect.Right = Width) and
6204 (ARect.Bottom = Height) then
6205 begin
6206 result := Duplicate;
6207 exit;
6208 end;
6209
6210 result := NewBitmap(tx, ty);
6211 heightleft := result.Height;
6212 curyin := ARect.Top;
6213 ydest := -ARect.Top;
6214 while heightleft > 0 do
6215 begin
6216 if curyin + heightleft > Height then
6217 copyheight := Height - curyin
6218 else
6219 copyheight := heightleft;
6220
6221 widthleft := result.Width;
6222 curxin := ARect.Left;
6223 xdest := -ARect.Left;
6224 while widthleft > 0 do
6225 begin
6226 if curxin + widthleft > Width then
6227 copywidth := Width - curxin
6228 else
6229 copywidth := widthleft;
6230
6231 result.PutImage(xdest, ydest, self, dmSet);
6232
6233 curxin := 0;
6234 Dec(widthleft, copywidth);
6235 Inc(xdest, Width);
6236 end;
6237 curyin := 0;
6238 Dec(heightleft, copyheight);
6239 Inc(ydest, Height);
6240 end;
6241end;
6242
6243function TBGRADefaultBitmap.GetPtrBitmap(Top, Bottom: Integer
6244 ): TBGRACustomBitmap;
6245var temp: integer;
6246 ptrbmp: TBGRAPtrBitmap;
6247begin
6248 if Top > Bottom then
6249 begin
6250 temp := Top;
6251 Top := Bottom;
6252 Bottom := Temp;
6253 end;
6254 if Top < 0 then Top := 0;
6255 if Bottom > Height then Bottom := Height;
6256 if Top >= Bottom then
6257 result := nil
6258 else
6259 begin
6260 if LineOrder = riloTopToBottom then
6261 ptrbmp := CreatePtrBitmap(Width,Bottom-Top,ScanLine[Top]) else
6262 ptrbmp := CreatePtrBitmap(Width,Bottom-Top,ScanLine[Bottom-1]);
6263 ptrbmp.LineOrder := LineOrder;
6264 result := ptrbmp;
6265 end;
6266end;
6267
6268{-------------------------- Allocation routines -------------------------------}
6269
6270procedure TBGRADefaultBitmap.ReallocData;
6271begin
6272 FreeBitmap;
6273 ReAllocMem(FData, NbPixels * sizeof(TBGRAPixel));
6274 if (NbPixels > 0) and (FData = nil) then
6275 raise EOutOfMemory.Create('TBGRADefaultBitmap: Not enough memory');
6276 InvalidateBitmap;
6277 FScanPtr := nil;
6278end;
6279
6280procedure TBGRADefaultBitmap.FreeData;
6281begin
6282 freemem(FData);
6283 FData := nil;
6284end;
6285
6286function TBGRADefaultBitmap.CreatePtrBitmap(AWidth, AHeight: integer;
6287 AData: PBGRAPixel): TBGRAPtrBitmap;
6288begin
6289 result := TBGRAPtrBitmap.Create(AWidth,AHeight,AData);
6290end;
6291
6292procedure TBGRADefaultBitmap.FreeBitmap;
6293begin
6294 FreeAndNil(FBitmap);
6295end;
6296
6297function TBGRADefaultBitmap.GetNbPixels: integer;
6298begin
6299 result := FNbPixels;
6300end;
6301
6302function TBGRADefaultBitmap.GetWidth: integer;
6303begin
6304 Result := FWidth;
6305end;
6306
6307function TBGRADefaultBitmap.GetHeight: integer;
6308begin
6309 Result:= FHeight;
6310end;
6311
6312function TBGRADefaultBitmap.GetRefCount: integer;
6313begin
6314 result := FRefCount;
6315end;
6316
6317function TBGRADefaultBitmap.GetLineOrder: TRawImageLineOrder;
6318begin
6319 result := FLineOrder;
6320end;
6321
6322procedure TBGRADefaultBitmap.SetLineOrder(AValue: TRawImageLineOrder);
6323begin
6324 FLineOrder := AValue;
6325end;
6326
6327function TBGRADefaultBitmap.GetCanvasOpacity: byte;
6328begin
6329 result:= FCanvasOpacity;
6330end;
6331
6332function TBGRADefaultBitmap.GetFontHeight: integer;
6333begin
6334 result := FFontHeight;
6335end;
6336
6337{ TBGRAPtrBitmap }
6338
6339function TBGRAPtrBitmap.GetLineOrder: TRawImageLineOrder;
6340begin
6341 result := inherited GetLineOrder;
6342end;
6343
6344procedure TBGRAPtrBitmap.SetLineOrder(AValue: TRawImageLineOrder);
6345begin
6346 inherited SetLineOrder(AValue);
6347end;
6348
6349procedure TBGRAPtrBitmap.ReallocData;
6350begin
6351 //nothing
6352end;
6353
6354procedure TBGRAPtrBitmap.FreeData;
6355begin
6356 FData := nil;
6357end;
6358
6359procedure TBGRAPtrBitmap.CannotResize;
6360begin
6361 raise exception.Create('A pointer bitmap cannot be resized');
6362end;
6363
6364procedure TBGRAPtrBitmap.NotImplemented;
6365begin
6366 raise exception.Create('Not implemented');
6367end;
6368
6369procedure TBGRAPtrBitmap.RebuildBitmap;
6370begin
6371 NotImplemented;
6372end;
6373
6374function TBGRAPtrBitmap.CreateDefaultFontRenderer: TBGRACustomFontRenderer;
6375begin
6376 result := nil;
6377 NotImplemented;
6378end;
6379
6380function TBGRAPtrBitmap.LoadFromRawImage(ARawImage: TRawImage;
6381 DefaultOpacity: byte; AlwaysReplaceAlpha: boolean;
6382 RaiseErrorOnInvalidPixelFormat: boolean): boolean;
6383begin
6384 result := false;
6385 NotImplemented;
6386end;
6387
6388constructor TBGRAPtrBitmap.Create(AWidth, AHeight: integer; AData: Pointer);
6389begin
6390 inherited Create(AWidth, AHeight);
6391 SetDataPtr(AData);
6392end;
6393
6394function TBGRAPtrBitmap.Duplicate(DuplicateProperties: Boolean = False; DuplicateXorMask: Boolean = False): TBGRACustomBitmap;
6395begin
6396 Result := NewBitmap(Width, Height);
6397 if DuplicateProperties then CopyPropertiesTo(TBGRADefaultBitmap(Result));
6398 if DuplicateXorMask and Assigned(XorMask) then
6399 TBGRADefaultBitmap(Result).FXorMask := FXorMask.Duplicate(True);
6400end;
6401
6402procedure TBGRAPtrBitmap.SetDataPtr(AData: Pointer);
6403begin
6404 FData := AData;
6405end;
6406
6407procedure TBGRAPtrBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
6408 AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
6409begin
6410 NotImplemented;
6411end;
6412
6413procedure TBGRAPtrBitmap.DataDrawOpaque(ACanvas: TCanvas; Rect: TRect;
6414 AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
6415begin
6416 NotImplemented;
6417end;
6418
6419procedure TBGRAPtrBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer
6420 );
6421begin
6422 NotImplemented;
6423end;
6424
6425procedure TBGRAPtrBitmap.Assign(Source: TPersistent);
6426begin
6427 CannotResize;
6428end;
6429
6430procedure TBGRAPtrBitmap.TakeScreenshot(ARect: TRect);
6431begin
6432 CannotResize;
6433end;
6434
6435procedure TBGRAPtrBitmap.TakeScreenshotOfPrimaryMonitor;
6436begin
6437 CannotResize;
6438end;
6439
6440procedure TBGRAPtrBitmap.LoadFromDevice(DC: HDC);
6441begin
6442 NotImplemented;
6443end;
6444
6445procedure TBGRAPtrBitmap.LoadFromDevice(DC: HDC; ARect: TRect);
6446begin
6447 NotImplemented;
6448end;
6449
6450procedure BGRAGradientFill(bmp: TBGRACustomBitmap; x, y, x2, y2: integer;
6451 c1, c2: TBGRAPixel; gtype: TGradientType; o1, o2: TPointF; mode: TDrawMode;
6452 gammaColorCorrection: boolean = True; Sinus: Boolean=False);
6453begin
6454 bmp.GradientFill(x,y,x2,y2,c1,c2,gtype,o1,o2,mode,gammaColorCorrection,sinus);
6455end;
6456
6457initialization
6458
6459 with DefaultTextStyle do
6460 begin
6461 Alignment := taLeftJustify;
6462 Layout := tlTop;
6463 WordBreak := True;
6464 SingleLine := True;
6465 Clipping := True;
6466 ShowPrefix := False;
6467 Opaque := False;
6468 end;
6469
6470end.
6471
Note: See TracBrowser for help on using the repository browser.