source: trunk/Packages/bgrabitmap/bgrapolygon.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 55.9 KB
Line 
1unit BGRAPolygon;
2
3{$mode objfpc}{$H+}
4
5{ This unit contains polygon drawing functions and spline functions.
6
7 Shapes are drawn using a TBGRACustomFillInfo object, which calculates the
8 intersection of an horizontal line and the polygon.
9
10 Various shapes are handled :
11 - TFillPolyInfo : polygon scanned in any order
12 - TOnePassFillPolyInfo : polygon scanned from top to bottom
13 - TFillEllipseInfo : ellipse
14 - TFillBorderEllipseInfo : ellipse border
15 - TFillRoundRectangleInfo : round rectangle (or other corners)
16 - TFillBorderRoundRectInfo : round rectangle border
17
18 Various fill modes :
19 - Alternate : each time there is an intersection, it enters or go out of the polygon
20 - Winding : filled when the sum of ascending and descending intersection is non zero
21 - Color : fill with a color defined as a TBGRAPixel argument
22 - Erase : erase with an alpha in the TBGRAPixel argument
23 - Texture : draws a texture with the IBGRAScanner argument
24
25 Various border handling :
26 - aliased : one horizontal line intersection is calculated per pixel in the vertical loop
27 - antialiased : more lines are calculated and a density is computed by adding them together
28 - multi-polygon antialiasing and superposition (TBGRAMultiShapeFiller) : same as above but
29 by combining multiple polygons at the same time, and optionally subtracting top polygons
30 }
31
32interface
33
34uses
35 Classes, SysUtils, BGRAGraphics, BGRABitmapTypes, BGRAFillInfo, BGRAPath;
36
37procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
38 c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false);
39procedure FillShapeAntialiasWithTexture(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
40 scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false);
41procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
42 c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; AliasingIncludeBottomRight: Boolean= false);
43
44type
45
46 { TBGRAMultishapeFiller }
47
48 TBGRAMultishapeFiller = class
49 protected
50 nbShapes: integer;
51 shapes: array of record
52 info: TBGRACustomFillInfo;
53 internalInfo: boolean;
54 texture: IBGRAScanner;
55 internalTexture: TObject;
56 color: TExpandedPixel;
57 bounds: TRect;
58 fillMode: TFillMode;
59 fillModeOverride: boolean;
60 end;
61 function AddShape(AInfo: TBGRACustomFillInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel): integer; overload;
62 function CheckRectangleBorderBounds(var x1, y1, x2, y2: single; w: single): boolean;
63 procedure InternalAddStroke(const APoints: array of TPointF; AClosed: boolean; AData: Pointer);
64 public
65 FillMode : TFillMode;
66 PolygonOrder: TPolygonOrder;
67 Antialiasing: Boolean;
68 AliasingIncludeBottomRight: Boolean;
69 constructor Create;
70 destructor Destroy; override;
71 function AddShape(AShape: TBGRACustomFillInfo; AColor: TBGRAPixel): integer; overload;
72 function AddShape(AShape: TBGRACustomFillInfo; ATexture: IBGRAScanner): integer; overload;
73 function AddPolygon(const points: array of TPointF; AColor: TBGRAPixel): integer; overload;
74 function AddPolygon(const points: array of TPointF; ATexture: IBGRAScanner): integer; overload;
75 procedure AddPathStroke(APath: TBGRAPath; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker); overload;
76 procedure AddPathStroke(APath: TBGRAPath; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker); overload;
77 procedure AddPathStroke(APath: TBGRAPath; AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker); overload;
78 procedure AddPathStroke(APath: TBGRAPath; AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker); overload;
79 function AddPathFill(APath: TBGRAPath; AColor: TBGRAPixel): integer; overload;
80 function AddPathFill(APath: TBGRAPath; ATexture: IBGRAScanner): integer; overload;
81 function AddPathFill(APath: TBGRAPath; AMatrix: TAffineMatrix; AColor: TBGRAPixel): integer; overload;
82 function AddPathFill(APath: TBGRAPath; AMatrix: TAffineMatrix; ATexture: IBGRAScanner): integer; overload;
83 function AddPolylineStroke(const points: array of TPointF; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload;
84 function AddPolylineStroke(const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload;
85 function AddPolygonStroke(const points: array of TPointF; AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload;
86 function AddPolygonStroke(const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker): integer; overload;
87 function AddTriangleLinearColor(pt1, pt2, pt3: TPointF; c1, c2, c3: TBGRAPixel): integer;
88 function AddTriangleLinearMapping(pt1, pt2, pt3: TPointF; texture: IBGRAScanner; tex1, tex2, tex3: TPointF): integer;
89 procedure AddQuadLinearColor(pt1, pt2, pt3, pt4: TPointF; c1, c2, c3, c4: TBGRAPixel);
90 procedure AddQuadLinearMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, {%H-}tex3, tex4: TPointF;
91 ACulling: TFaceCulling = fcNone);
92 procedure AddQuadPerspectiveMapping(pt1, pt2, pt3, pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
93 function AddEllipse(x, y, rx, ry: single; AColor: TBGRAPixel): integer; overload;
94 function AddEllipse(x, y, rx, ry: single; ATexture: IBGRAScanner): integer; overload;
95 function AddEllipseBorder(x, y, rx, ry, w: single; AColor: TBGRAPixel): integer; overload;
96 function AddEllipseBorder(x, y, rx, ry, w: single; ATexture: IBGRAScanner): integer; overload;
97 function AddRoundRectangle(x1, y1, x2, y2, rx, ry: single; AColor: TBGRAPixel; options: TRoundRectangleOptions= []): integer; overload;
98 function AddRoundRectangle(x1, y1, x2, y2, rx, ry: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions= []): integer; overload;
99 function AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, w: single; AColor: TBGRAPixel; options: TRoundRectangleOptions= []): integer; overload;
100 function AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry, w: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions= []): integer; overload;
101 function AddRectangle(x1, y1, x2, y2: single; AColor: TBGRAPixel): integer; overload;
102 function AddRectangle(x1, y1, x2, y2: single; ATexture: IBGRAScanner): integer; overload;
103 function AddRectangleBorder(x1, y1, x2, y2, w: single; AColor: TBGRAPixel): integer; overload;
104 function AddRectangleBorder(x1, y1, x2, y2, w: single; ATexture: IBGRAScanner): integer; overload;
105 procedure OverrideFillMode(AShapeIndex: integer; AFillMode: TFillMode);
106 procedure Draw(dest: TBGRACustomBitmap; ADrawMode: TDrawMode = dmDrawWithTransparency);
107 property ShapeCount: integer read nbShapes;
108 end;
109
110procedure FillPolyAliased(bmp: TBGRACustomBitmap; points: array of TPointF;
111 c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean = true);
112procedure FillPolyAliasedWithTexture(bmp: TBGRACustomBitmap; points: array of TPointF;
113 scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean = true);
114procedure FillPolyAntialias(bmp: TBGRACustomBitmap; points: array of TPointF;
115 c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true);
116procedure FillPolyAntialiasWithTexture(bmp: TBGRACustomBitmap; points: array of TPointF;
117 scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true);
118
119procedure FillEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry: single;
120 c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false);
121procedure FillEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry: single;
122 scan: IBGRAScanner; LinearBlend: boolean = false);
123
124procedure BorderEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
125 c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false);
126procedure BorderEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
127 scan: IBGRAScanner; LinearBlend: boolean = false);
128
129procedure BorderEllipse(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
130 c: TBGRAPixel; EraseMode: boolean; drawmode: TDrawMode);
131procedure BorderEllipseWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
132 scan: IBGRAScanner; drawmode: TDrawMode);
133
134procedure FillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry: single;
135 options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true);
136procedure FillRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry: single;
137 options: TRoundRectangleOptions; scan: IBGRAScanner; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true);
138
139procedure BorderRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single;
140 options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true);
141procedure BorderRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single;
142 options: TRoundRectangleOptions; scan: IBGRAScanner; LinearBlend: boolean = false; APixelCenteredCoordinates: boolean = true);
143
144procedure BorderAndFillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2, rx, ry, w: single;
145 options: TRoundRectangleOptions; bordercolor,fillcolor: TBGRAPixel; bordertexture,filltexture: IBGRAScanner; EraseMode: boolean; APixelCenteredCoordinates: boolean = true);
146
147implementation
148
149uses Math, BGRABlend, BGRAGradientScanner, BGRATransform;
150
151type
152 TPathStrokeData = record
153 Stroker: TBGRACustomPenStroker;
154 Texture: IBGRAScanner;
155 Color: TBGRAPixel;
156 Width: Single;
157 end;
158
159procedure FillShapeAntialias(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
160 c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean);
161const oneOver512 = 1/512;
162var
163 inter: array of TIntersectionInfo;
164 nbInter: integer;
165
166 firstScan, lastScan: record
167 inter: array of TIntersectionInfo;
168 nbInter: integer;
169 sliceIndex: integer;
170 end;
171
172 miny, maxy, minx, maxx,
173 densMinX, densMaxX: integer;
174 joinDensity, nextJoinDensity: boolean;
175
176 density: PDensity;
177
178 xb, yb, yc, i: integer;
179 tempDensity: UInt32or64;
180
181 x1, x2, x1b,x2b: single;
182 ix1, ix2: integer;
183 pdest: PBGRAPixel;
184 pdens: PDensity;
185
186 curvedSeg,optimised: boolean;
187 ec: TExpandedPixel;
188 c2:TBGRAPixel;
189 MemScanCopy,pscan: pbgrapixel;
190 ScanNextPixelProc: TScanNextPixelFunction;
191 temp: Single;
192
193 function GetYScan(num: integer): single; inline;
194 begin
195 result := yb + (num * 2 + 1) / (AntialiasPrecision * 2);
196 end;
197
198 procedure SubTriangleDensity(x1,density1, x2, density2: single);
199 var ix1,ix2,n: integer;
200 slope: single;
201 function densityAt(x: single): single; inline;
202 begin
203 result := (x-x1)*slope+density1;
204 end;
205 var
206 curdens: single;
207 pdens: pdensity;
208 newvalue: Int32or64;
209 begin
210 if (x1 <> x2) and (x1 < maxx + 1) and (x2 >= minx) then
211 begin
212 slope := (density2-density1)/(x2-x1);
213 if x1 < minx then
214 begin
215 density1 := densityAt(minx);
216 x1 := minx;
217 end;
218 if x2 >= maxx + 1 then
219 begin
220 density2 := densityAt(maxx+1);
221 x2 := maxx + 1;
222 end;
223 ix1 := floor(x1);
224 ix2 := floor(x2);
225
226 if ix1 = ix2 then
227 begin
228 newValue := (density + (ix1 - minx))^ - round((x2 - x1)*(density1+density2)/2);
229 if newValue < 0 then newValue := 0;
230 if newValue > 256 then newValue := 256;
231 (density + (ix1 - minx))^ := newValue
232 end
233 else
234 begin
235 newValue := (density + (ix1 - minx))^ - round((1 - (x1 - ix1))*(density1+densityAt(ix1+1))/2) ;
236 if newValue < 0 then newValue := 0;
237 if newValue > 256 then newValue := 256;
238 (density + (ix1 - minx))^ := newValue;
239 if (ix2 <= maxx) then
240 begin
241 newValue := (density + (ix2 - minx))^ - round((x2 - ix2)*(density2+densityAt(ix2))/2);
242 if newValue < 0 then newValue := 0;
243 if newValue > 256 then newValue := 256;
244 (density + (ix2 - minx))^ := newValue;
245 end;
246 end;
247 if ix2 > ix1 + 1 then
248 begin
249 curdens := densityAt(ix1+1.5);
250 pdens := density + (ix1+1 - minx);
251 for n := ix2-1-(ix1+1) downto 0 do
252 begin
253 newValue := pdens^ - round(curdens);
254 if newValue < 0 then newValue := 0;
255 if newValue > 256 then newValue := 256;
256 pdens^ := newValue;
257 curdens += slope;
258 inc(pdens);
259 end;
260 end;
261 end;
262 end;
263
264begin
265 if (scan=nil) and (c.alpha=0) then exit;
266 If not BGRAShapeComputeMinMax(shapeInfo,minx,miny,maxx,maxy,bmp) then exit;
267
268 inter := shapeInfo.CreateIntersectionArray;
269 getmem(density, (maxx - minx + 2)*sizeof(TDensity)); //more for safety
270 ec := GammaExpansion(c);
271 c2 := c;
272
273 MemScanCopy := nil;
274 ScanNextPixelProc := nil;
275 if scan <> nil then
276 begin
277 if scan.IsScanPutPixelsDefined then
278 GetMem(MemScanCopy,(maxx-minx+1)*sizeof(TBGRAPixel));
279 ScanNextPixelProc := @scan.ScanNextPixel;
280 end;
281
282 curvedSeg := shapeInfo.SegmentsCurved;
283 if not curvedSeg then
284 begin
285 firstScan.inter := shapeInfo.CreateIntersectionArray;
286 lastScan.inter := shapeInfo.CreateIntersectionArray;
287 end;
288
289 //vertical scan
290 for yb := miny to maxy do
291 begin
292 //mean density
293 fillchar(density^,(maxx-minx+1)*sizeof(TDensity),0);
294
295 densMinX := maxx+1;
296 densMaxX := minx-1;
297
298 if not curvedSeg then
299 begin
300 with firstScan do
301 begin
302 shapeInfo.ComputeAndSort(yb+1/256,inter,nbInter,NonZeroWinding);
303 sliceIndex:= shapeInfo.GetSliceIndex;
304 end;
305 with lastScan do
306 begin
307 shapeInfo.ComputeAndSort(yb+255/256,inter,nbInter,NonZeroWinding);
308 sliceIndex:= shapeInfo.GetSliceIndex;
309 end;
310 if (firstScan.sliceIndex = lastScan.sliceIndex) and (firstScan.nbInter = lastScan.nbInter) then
311 begin
312 optimised := true;
313 for i := 0 to firstScan.nbInter-1 do
314 if firstScan.inter[i].numSegment <> lastScan.inter[i].numSegment then
315 begin
316 optimised := false;
317 break;
318 end;
319 end else
320 optimised := false;
321
322 if optimised then
323 begin
324 nextJoinDensity := false;
325 for i := 0 to firstScan.nbinter div 2 - 1 do
326 begin
327 joinDensity := nextJoinDensity;
328 x1 := firstScan.inter[i+i].interX;
329 x1b := lastScan.inter[i+i].interX;
330 x2 := firstScan.inter[i+i+1].interX;
331 x2b := lastScan.inter[i+i+1].interX;
332 nextJoinDensity := not ((i+i+2 >= firstScan.nbInter) or
333 ((firstScan.inter[i+i+2].interX >= x2+1) and
334 (lastScan.inter[i+i+2].interX >= x2b+1)));
335 if (abs(x1-x1b)<oneOver512) and (abs(x2-x2b)<oneOver512) and
336 not joinDensity and not nextJoinDensity then
337 begin
338 x1 := (x1+x1b)*0.5;
339 x2 := (x2+x2b)*0.5;
340
341 if x1 < minx then x1 := minx;
342 ix1 := floor(x1);
343
344 if x2 >= maxx+1 then
345 begin
346 x2 := maxx+1;
347 ix2 := maxx;
348 end else
349 ix2 := floor(x2);
350 if ix2 > maxx then ix2 := maxx;
351
352 if ix1>ix2 then continue;
353 if ix1=ix2 then
354 begin
355 tempDensity:= round((x2-x1)*256);
356 if scan <> nil then //with texture scan
357 begin
358 scan.ScanMoveTo(ix1,yb);
359 c := scan.ScanNextPixel;
360 c.alpha := c.alpha*tempDensity shr 8;
361 if linearBlend then
362 bmp.DrawPixel(ix1, yb, c, dmLinearBlend)
363 else
364 bmp.DrawPixel(ix1, yb, c, dmDrawWithTransparency);
365 end else
366 if EraseMode then //erase with alpha
367 bmp.ErasePixel(ix1,yb,c.alpha*tempDensity shr 8)
368 else
369 begin //solid color
370 c2.alpha := c.alpha*tempDensity shr 8;
371 if linearBlend then
372 bmp.DrawPixel(ix1, yb, c2, dmLinearBlend)
373 else
374 bmp.DrawPixel(ix1, yb, c2, dmDrawWithTransparency);
375 end;
376 end else
377 begin
378 tempDensity:= round((ix1+1-x1)*256);
379 if scan <> nil then scan.ScanMoveTo(ix1,yb);
380 if tempDensity < 256 then
381 begin
382 if scan <> nil then //with texture scan
383 begin
384 c := scan.ScanNextPixel;
385 c.alpha := c.alpha*tempDensity shr 8;
386 if linearBlend then
387 bmp.DrawPixel(ix1, yb, c, dmLinearBlend)
388 else
389 bmp.DrawPixel(ix1, yb, c, dmDrawWithTransparency);
390 end else
391 if EraseMode then //erase with alpha
392 bmp.ErasePixel(ix1,yb, c.alpha*tempDensity shr 8)
393 else
394 begin //solid color
395 c2.alpha := c.alpha*tempDensity shr 8;
396 if linearBlend then
397 bmp.DrawPixel(ix1, yb, c2, dmLinearBlend)
398 else
399 bmp.DrawPixel(ix1, yb, c2, dmDrawWithTransparency);
400 end;
401 inc(ix1);
402 end;
403 tempDensity:= round((x2-ix2)*256);
404 if tempDensity < 256 then dec(ix2);
405 if ix2 >= ix1 then
406 begin
407 if scan <> nil then //with texture scan
408 begin
409 if linearBlend then
410 ScannerPutPixels(scan, bmp.ScanLine[yb] + ix1, ix2-ix1+1, dmLinearBlend)
411 else
412 ScannerPutPixels(scan, bmp.ScanLine[yb] + ix1, ix2-ix1+1, dmDrawWithTransparency);
413 end else
414 if EraseMode then //erase with alpha
415 bmp.EraseLine(ix1,yb,ix2,yb,c.alpha,True)
416 else
417 begin //solid color
418 if LinearBlend then
419 bmp.HorizLine(ix1,yb,ix2,c,dmLinearBlend)
420 else
421 bmp.HorizLine(ix1,yb,ix2,c,dmDrawWithTransparency);
422 end;
423 end;
424 if tempDensity < 256 then
425 begin
426 inc(ix2);
427 if scan <> nil then //with texture scan
428 begin
429 c := scan.ScanNextPixel;
430 c.alpha := c.alpha*tempDensity shr 8;
431 if linearBlend then
432 bmp.DrawPixel(ix2, yb, c, dmLinearBlend)
433 else
434 bmp.DrawPixel(ix2, yb, c, dmDrawWithTransparency);
435 end else
436 if EraseMode then //erase with alpha
437 bmp.ErasePixel(ix2,yb,c.alpha*tempDensity shr 8)
438 else
439 begin //solid color
440 c2.alpha := c.alpha*tempDensity shr 8;
441 if linearBlend then
442 bmp.DrawPixel(ix2, yb, c2, dmLinearBlend)
443 else
444 bmp.DrawPixel(ix2, yb, c2, dmDrawWithTransparency);
445 end;
446 end;
447 end;
448 continue;
449 end else
450 begin
451 if (x1 > x1b) then
452 begin
453 temp := x1;
454 x1 := x1b;
455 x1b := temp;
456 end;
457 if (x2 < x2b) then
458 begin
459 temp := x2;
460 x2 := x2b;
461 x2b := temp;
462 end;
463
464 {$DEFINE INCLUDE_FILLDENSITY}
465 {$DEFINE PARAM_SINGLESEGMENT}
466 {$i density256.inc}
467 SubTriangleDensity(x1,256,x1b,0);
468 SubTriangleDensity(x2b,0,x2,256);
469 end;
470 end;
471 end else
472 begin
473 for yc := 0 to AntialiasPrecision - 1 do
474 begin
475 //find intersections
476 shapeInfo.ComputeAndSort(GetYScan(yc),inter,nbInter,NonZeroWinding);
477
478 {$DEFINE INCLUDE_FILLDENSITY}
479 {$i density256.inc}
480 end;
481 end;
482 end else
483 begin
484 optimised := false;
485 //precision scan
486 for yc := 0 to AntialiasPrecision - 1 do
487 begin
488 //find intersections
489 shapeInfo.ComputeAndSort(GetYScan(yc),inter,nbInter,NonZeroWinding);
490
491 {$DEFINE INCLUDE_FILLDENSITY}
492 {$i density256.inc}
493 end;
494 end;
495
496 if LinearBlend then
497 begin
498 if optimised then
499 {$DEFINE INCLUDE_RENDERDENSITY}
500 {$define PARAM_LINEARANTIALIASING}
501 {$i density256.inc}
502 else
503 {$DEFINE INCLUDE_RENDERDENSITY}
504 {$define PARAM_LINEARANTIALIASING}
505 {$define PARAM_ANTIALIASINGFACTOR}
506 {$i density256.inc}
507 end else
508 begin
509 if optimised then
510 {$DEFINE INCLUDE_RENDERDENSITY}
511 {$i density256.inc}
512 else
513 {$DEFINE INCLUDE_RENDERDENSITY}
514 {$define PARAM_ANTIALIASINGFACTOR}
515 {$i density256.inc}
516 end;
517 end;
518
519 freemem(MemScanCopy);
520 shapeInfo.FreeIntersectionArray(inter);
521
522 if not curvedSeg then
523 begin
524 with firstScan do
525 begin
526 for i := 0 to high(inter) do
527 inter[i].free;
528 end;
529 with lastScan do
530 begin
531 for i := 0 to high(inter) do
532 inter[i].free;
533 end;
534 end;
535 freemem(density);
536
537 bmp.InvalidateBitmap;
538end;
539
540procedure FillShapeAliased(bmp: TBGRACustomBitmap; shapeInfo: TBGRACustomFillInfo;
541 c: TBGRAPixel; EraseMode: boolean; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; AliasingIncludeBottomRight: Boolean= false);
542var
543 inter: array of TIntersectionInfo;
544 nbInter: integer;
545
546 miny, maxy, minx, maxx: integer;
547 xb,yb, i: integer;
548 x1, x2: single;
549 ix1, ix2: integer;
550 pdest: PBGRAPixel;
551 AliasingOfs: TPointF;
552 ec: TExpandedPixel;
553
554begin
555 if (scan=nil) and (c.alpha=0) then exit;
556 If not BGRAShapeComputeMinMax(shapeInfo,minx,miny,maxx,maxy,bmp) then exit;
557 inter := shapeInfo.CreateIntersectionArray;
558
559 if AliasingIncludeBottomRight then
560 AliasingOfs := PointF(0,0) else
561 AliasingOfs := PointF(-0.0001,-0.0001);
562
563 ec := GammaExpansion(c);
564 if (scan = nil) and (c.alpha = 255) then drawmode := dmSet;
565
566 //vertical scan
567 for yb := miny to maxy do
568 begin
569 //find intersections
570 shapeInfo.ComputeAndSort( yb+0.5-AliasingOfs.Y, inter, nbInter, NonZeroWinding);
571
572 for i := 0 to nbinter div 2 - 1 do
573 begin
574 x1 := inter[i + i].interX+AliasingOfs.X;
575 x2 := inter[i + i+ 1].interX+AliasingOfs.X;
576
577 if x1 <> x2 then
578 begin
579 ComputeAliasedRowBounds(x1,x2, minx,maxx, ix1,ix2);
580 if ix1 <= ix2 then
581 begin
582 //render scanline
583 if scan <> nil then //with texture scan
584 begin
585 pdest := bmp.ScanLine[yb] + ix1;
586 scan.ScanMoveTo(ix1,yb);
587 ScannerPutPixels(scan,pdest,ix2-ix1+1,drawmode);
588 end else
589 if EraseMode then //erase with alpha
590 begin
591 pdest := bmp.ScanLine[yb] + ix1;
592 for xb := ix1 to ix2 do
593 begin
594 ErasePixelInline(pdest, c.alpha);
595 Inc(pdest);
596 end;
597 end
598 else
599 begin
600 case drawmode of
601 dmFastBlend: bmp.FastBlendHorizLine(ix1,yb,ix2, c);
602 dmDrawWithTransparency: bmp.DrawHorizLine(ix1,yb,ix2, ec);
603 dmSet: bmp.SetHorizLine(ix1,yb,ix2, c);
604 dmXor: bmp.XorHorizLine(ix1,yb,ix2, c);
605 end;
606 end;
607 end;
608 end;
609 end;
610 end;
611
612 shapeInfo.FreeIntersectionArray(inter);
613 bmp.InvalidateBitmap;
614end;
615
616procedure FillShapeAntialiasWithTexture(bmp: TBGRACustomBitmap;
617 shapeInfo: TBGRACustomFillInfo; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean);
618begin
619 FillShapeAntialias(bmp,shapeInfo,BGRAPixelTransparent,False,scan,NonZeroWinding,LinearBlend);
620end;
621
622procedure FillPolyAliased(bmp: TBGRACustomBitmap; points: array of TPointF;
623 c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean);
624var
625 info: TCustomFillPolyInfo;
626begin
627 if length(points) < 3 then
628 exit;
629
630 info := TOnePassFillPolyInfo.Create(points, APixelCenteredCoordinates);
631 FillShapeAliased(bmp, info, c, EraseMode, nil, NonZeroWinding, drawmode);
632 info.Free;
633end;
634
635procedure FillPolyAliasedWithTexture(bmp: TBGRACustomBitmap;
636 points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean; drawmode: TDrawMode; APixelCenteredCoordinates: boolean);
637var
638 info: TCustomFillPolyInfo;
639begin
640 if length(points) < 3 then
641 exit;
642
643 info := TOnePassFillPolyInfo.Create(points, APixelCenteredCoordinates);
644 FillShapeAliased(bmp, info, BGRAPixelTransparent,False,scan, NonZeroWinding, drawmode);
645 info.Free;
646end;
647
648procedure FillPolyAntialias(bmp: TBGRACustomBitmap; points: array of TPointF;
649 c: TBGRAPixel; EraseMode: boolean; NonZeroWinding: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean);
650var
651 info: TCustomFillPolyInfo;
652begin
653 if length(points) < 3 then
654 exit;
655
656 info := TOnePassFillPolyInfo.Create(points, APixelCenteredCoordinates);
657 FillShapeAntialias(bmp, info, c, EraseMode, nil, NonZeroWinding, LinearBlend);
658 info.Free;
659end;
660
661procedure FillPolyAntialiasWithTexture(bmp: TBGRACustomBitmap;
662 points: array of TPointF; scan: IBGRAScanner; NonZeroWinding: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean);
663var
664 info: TCustomFillPolyInfo;
665begin
666 if length(points) < 3 then
667 exit;
668
669 info := TOnePassFillPolyInfo.Create(points, APixelCenteredCoordinates);
670 FillShapeAntialiasWithTexture(bmp, info, scan, NonZeroWinding, LinearBlend);
671 info.Free;
672end;
673
674procedure FillEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry: single;
675 c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean);
676var
677 info: TFillEllipseInfo;
678begin
679 if (rx = 0) or (ry = 0) or (x = EmptySingle) or (y = EmptySingle) then
680 exit;
681
682 info := TFillEllipseInfo.Create(x, y, rx, ry);
683 FillShapeAntialias(bmp, info, c, EraseMode, nil, False, LinearBlend);
684 info.Free;
685end;
686
687procedure FillEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx,
688 ry: single; scan: IBGRAScanner; LinearBlend: boolean);
689var
690 info: TFillEllipseInfo;
691begin
692 if (rx = 0) or (ry = 0) or (x = EmptySingle) or (y = EmptySingle) then
693 exit;
694
695 info := TFillEllipseInfo.Create(x, y, rx, ry);
696 FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend);
697 info.Free;
698end;
699
700procedure BorderEllipseAntialias(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
701 c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean);
702var
703 info: TFillBorderEllipseInfo;
704begin
705 if ((rx = 0) and (ry = 0)) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then
706 exit;
707 info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w);
708 FillShapeAntialias(bmp, info, c, EraseMode, nil, False, LinearBlend);
709 info.Free;
710end;
711
712procedure BorderEllipseAntialiasWithTexture(bmp: TBGRACustomBitmap; x, y, rx,
713 ry, w: single; scan: IBGRAScanner; LinearBlend: boolean);
714var
715 info: TFillBorderEllipseInfo;
716begin
717 if ((rx = 0) and (ry = 0)) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then
718 exit;
719 info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w);
720 FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend);
721 info.Free;
722end;
723
724{ TBGRAMultishapeFiller }
725
726function TBGRAMultishapeFiller.AddShape(AInfo: TBGRACustomFillInfo; AInternalInfo: boolean; ATexture: IBGRAScanner; AInternalTexture: TObject; AColor: TBGRAPixel): integer;
727begin
728 if length(shapes) = nbShapes then
729 setlength(shapes, (length(shapes)+1)*2);
730 result := nbShapes;
731 inc(nbShapes);
732
733 with shapes[result] do
734 begin
735 info := AInfo;
736 internalInfo:= AInternalInfo;
737 texture := ATexture;
738 internalTexture:= AInternalTexture;
739 color := GammaExpansion(AColor);
740 fillModeOverride:= false;
741 end;
742end;
743
744function TBGRAMultishapeFiller.CheckRectangleBorderBounds(var x1, y1, x2,
745 y2: single; w: single): boolean;
746var temp: single;
747begin
748 if x1 > x2 then
749 begin
750 temp := x1;
751 x1 := x2;
752 x2 := temp;
753 end;
754 if y1 > y2 then
755 begin
756 temp := y1;
757 y1 := y2;
758 y2 := temp;
759 end;
760 result := (x2-x1 > w) and (y2-y1 > w);
761end;
762
763procedure TBGRAMultishapeFiller.InternalAddStroke(
764 const APoints: array of TPointF; AClosed: boolean; AData: Pointer);
765var pts: ArrayOfTPointF;
766 idxShape: Integer;
767begin
768 with TPathStrokeData(AData^) do
769 begin
770 if AClosed then
771 pts := Stroker.ComputePolygon(APoints, Width)
772 else
773 pts := Stroker.ComputePolylineAutoCycle(APoints, Width);
774 if Texture <> nil then
775 idxShape := AddPolygon(pts, Texture)
776 else
777 idxShape := AddPolygon(pts, Color);
778 OverrideFillMode(idxShape, fmWinding);
779 end;
780end;
781
782constructor TBGRAMultishapeFiller.Create;
783begin
784 nbShapes := 0;
785 shapes := nil;
786 PolygonOrder := poNone;
787 Antialiasing := True;
788 AliasingIncludeBottomRight := False;
789end;
790
791destructor TBGRAMultishapeFiller.Destroy;
792var
793 i: Integer;
794begin
795 for i := 0 to nbShapes-1 do
796 begin
797 if shapes[i].internalInfo then shapes[i].info.free;
798 shapes[i].texture := nil;
799 if shapes[i].internalTexture <> nil then shapes[i].internalTexture.Free;
800 end;
801 shapes := nil;
802 inherited Destroy;
803end;
804
805function TBGRAMultishapeFiller.AddShape(AShape: TBGRACustomFillInfo;
806 AColor: TBGRAPixel): integer;
807begin
808 result := AddShape(AShape,False,nil,nil,AColor);
809end;
810
811function TBGRAMultishapeFiller.AddShape(AShape: TBGRACustomFillInfo;
812 ATexture: IBGRAScanner): integer;
813begin
814 result := AddShape(AShape,False,ATexture,nil,BGRAPixelTransparent);
815end;
816
817function TBGRAMultishapeFiller.AddPolygon(const points: array of TPointF;
818 AColor: TBGRAPixel): integer;
819begin
820 if length(points) <= 2 then exit(-1);
821 result := AddShape(TOnePassFillPolyInfo.Create(points),True,nil,nil,AColor);
822end;
823
824function TBGRAMultishapeFiller.AddPolygon(const points: array of TPointF;
825 ATexture: IBGRAScanner): integer;
826begin
827 if length(points) <= 2 then exit(-1);
828 result := AddShape(TOnePassFillPolyInfo.Create(points),True,ATexture,nil,BGRAPixelTransparent);
829end;
830
831procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath;
832 AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker);
833begin
834 AddPathStroke(APath,AffineMatrixIdentity,AColor,AWidth,AStroker);
835end;
836
837procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath;
838 ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker);
839begin
840 AddPathStroke(APath,AffineMatrixIdentity,ATexture,AWidth,AStroker);
841end;
842
843procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath;
844 AMatrix: TAffineMatrix; AColor: TBGRAPixel; AWidth: single;
845 AStroker: TBGRACustomPenStroker);
846var data: TPathStrokeData;
847begin
848 data.Stroker := AStroker;
849 data.Color := AColor;
850 data.Texture := nil;
851 data.Width := AWidth;
852 APath.stroke(@InternalAddStroke, AMatrix, 0.1, @data);
853end;
854
855procedure TBGRAMultishapeFiller.AddPathStroke(APath: TBGRAPath;
856 AMatrix: TAffineMatrix; ATexture: IBGRAScanner; AWidth: single;
857 AStroker: TBGRACustomPenStroker);
858var data: TPathStrokeData;
859begin
860 data.Stroker := AStroker;
861 data.Color := BGRAPixelTransparent;
862 data.Texture := ATexture;
863 data.Width := AWidth;
864 APath.stroke(@InternalAddStroke, AMatrix, 0.1, @data);
865end;
866
867function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath; AColor: TBGRAPixel): integer;
868begin
869 result := AddPolygon(APath.ToPoints, AColor);
870end;
871
872function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath;
873 ATexture: IBGRAScanner): integer;
874begin
875 result := AddPolygon(APath.ToPoints, ATexture);
876end;
877
878function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath;
879 AMatrix: TAffineMatrix; AColor: TBGRAPixel): integer;
880begin
881 result := AddPolygon(APath.ToPoints(AMatrix), AColor);
882end;
883
884function TBGRAMultishapeFiller.AddPathFill(APath: TBGRAPath;
885 AMatrix: TAffineMatrix; ATexture: IBGRAScanner): integer;
886begin
887 result := AddPolygon(APath.ToPoints(AMatrix), ATexture);
888end;
889
890function TBGRAMultishapeFiller.AddPolylineStroke(
891 const points: array of TPointF; AColor: TBGRAPixel; AWidth: single;
892 AStroker: TBGRACustomPenStroker): integer;
893begin
894 result := AddPolygon(AStroker.ComputePolyline(points,AWidth,AColor), AColor);
895end;
896
897function TBGRAMultishapeFiller.AddPolylineStroke(
898 const points: array of TPointF; ATexture: IBGRAScanner; AWidth: single;
899 AStroker: TBGRACustomPenStroker): integer;
900begin
901 result := AddPolygon(AStroker.ComputePolyline(points,AWidth), ATexture);
902end;
903
904function TBGRAMultishapeFiller.AddPolygonStroke(const points: array of TPointF;
905 AColor: TBGRAPixel; AWidth: single; AStroker: TBGRACustomPenStroker): integer;
906begin
907 result := AddPolygon(AStroker.ComputePolygon(points,AWidth), AColor);
908end;
909
910function TBGRAMultishapeFiller.AddPolygonStroke(const points: array of TPointF;
911 ATexture: IBGRAScanner; AWidth: single; AStroker: TBGRACustomPenStroker
912 ): integer;
913begin
914 result := AddPolygon(AStroker.ComputePolygon(points,AWidth), ATexture);
915end;
916
917function TBGRAMultishapeFiller.AddTriangleLinearColor(pt1, pt2, pt3: TPointF;
918 c1, c2, c3: TBGRAPixel): integer;
919var grad: TBGRAGradientTriangleScanner;
920begin
921 if (c1 = c2) and (c2 = c3) then
922 result := AddPolygon([pt1,pt2,pt3],c1)
923 else
924 begin
925 grad := TBGRAGradientTriangleScanner.Create(pt1,pt2,pt3, c1,c2,c3);
926 result := AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3]),True,grad,grad,BGRAPixelTransparent);
927 end;
928end;
929
930function TBGRAMultishapeFiller.AddTriangleLinearMapping(pt1, pt2, pt3: TPointF;
931 texture: IBGRAScanner; tex1, tex2, tex3: TPointF): integer;
932var
933 mapping: TBGRATriangleLinearMapping;
934begin
935 mapping := TBGRATriangleLinearMapping.Create(texture, pt1,pt2,pt3, tex1, tex2, tex3);
936 result := AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3]),True,mapping,mapping,BGRAPixelTransparent);
937end;
938
939procedure TBGRAMultishapeFiller.AddQuadLinearColor(pt1, pt2, pt3, pt4: TPointF;
940 c1, c2, c3, c4: TBGRAPixel);
941var
942 center: TPointF;
943 centerColor: TBGRAPixel;
944begin
945 if (c1 = c2) and (c2 = c3) and (c3 = c4) then
946 AddPolygon([pt1,pt2,pt3,pt4],c1)
947 else
948 begin
949 center := (pt1+pt2+pt3+pt4)*(1/4);
950 centerColor := GammaCompression( MergeBGRA(MergeBGRA(GammaExpansion(c1),GammaExpansion(c2)),
951 MergeBGRA(GammaExpansion(c3),GammaExpansion(c4))) );
952 AddTriangleLinearColor(pt1,pt2,center, c1,c2,centerColor);
953 AddTriangleLinearColor(pt2,pt3,center, c2,c3,centerColor);
954 AddTriangleLinearColor(pt3,pt4,center, c3,c4,centerColor);
955 AddTriangleLinearColor(pt4,pt1,center, c4,c1,centerColor);
956 end;
957end;
958
959procedure TBGRAMultishapeFiller.AddQuadLinearMapping(pt1, pt2, pt3,
960 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF;
961 ACulling: TFaceCulling);
962var
963 mapping: TBGRAQuadLinearScanner;
964begin
965 mapping := TBGRAQuadLinearScanner.Create(texture,
966 [tex1,tex2,tex3,tex4],
967 [pt1,pt2,pt3,pt4]);
968 mapping.Culling := ACulling;
969 AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3,pt4]),True,mapping,mapping,BGRAPixelTransparent);
970end;
971
972procedure TBGRAMultishapeFiller.AddQuadPerspectiveMapping(pt1, pt2, pt3,
973 pt4: TPointF; texture: IBGRAScanner; tex1, tex2, tex3, tex4: TPointF);
974var persp: TBGRAPerspectiveScannerTransform;
975begin
976 persp := TBGRAPerspectiveScannerTransform.Create(texture,[tex1,tex2,tex3,tex4],[pt1,pt2,pt3,pt4]);
977 AddShape(TOnePassFillPolyInfo.Create([pt1,pt2,pt3,pt4]),True,persp,persp,BGRAPixelTransparent);
978end;
979
980function TBGRAMultishapeFiller.AddEllipse(x, y, rx, ry: single;
981 AColor: TBGRAPixel): integer;
982begin
983 result := AddShape(TFillEllipseInfo.Create(x,y,rx,ry),True,nil,nil,AColor);
984end;
985
986function TBGRAMultishapeFiller.AddEllipse(x, y, rx, ry: single;
987 ATexture: IBGRAScanner): integer;
988begin
989 result := AddShape(TFillEllipseInfo.Create(x,y,rx,ry),True,ATexture,nil,BGRAPixelTransparent);
990end;
991
992function TBGRAMultishapeFiller.AddEllipseBorder(x, y, rx, ry, w: single;
993 AColor: TBGRAPixel): integer;
994begin
995 result := AddShape(TFillBorderEllipseInfo.Create(x,y,rx,ry,w),True,nil,nil,AColor);
996end;
997
998function TBGRAMultishapeFiller.AddEllipseBorder(x, y, rx, ry, w: single;
999 ATexture: IBGRAScanner): integer;
1000begin
1001 result := AddShape(TFillBorderEllipseInfo.Create(x,y,rx,ry,w),True,ATexture,nil,BGRAPixelTransparent);
1002end;
1003
1004function TBGRAMultishapeFiller.AddRoundRectangle(x1, y1, x2, y2, rx,
1005 ry: single; AColor: TBGRAPixel; options: TRoundRectangleOptions): integer;
1006begin
1007 result := AddShape(TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,options),True,nil,nil,AColor);
1008end;
1009
1010function TBGRAMultishapeFiller.AddRoundRectangle(x1, y1, x2, y2, rx,
1011 ry: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions): integer;
1012begin
1013 result := AddShape(TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry,options),True,
1014 ATexture,nil,BGRAPixelTransparent);
1015end;
1016
1017function TBGRAMultishapeFiller.AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry,
1018 w: single; AColor: TBGRAPixel; options: TRoundRectangleOptions): integer;
1019begin
1020 result := AddShape(TFillBorderRoundRectInfo.Create(x1, y1, x2, y2, rx, ry,w,options),True,
1021 nil,nil,AColor);
1022end;
1023
1024function TBGRAMultishapeFiller.AddRoundRectangleBorder(x1, y1, x2, y2, rx, ry,
1025 w: single; ATexture: IBGRAScanner; options: TRoundRectangleOptions): integer;
1026begin
1027 result := AddShape(TFillBorderRoundRectInfo.Create(x1, y1, x2, y2, rx, ry,w,options),True,
1028 ATexture,nil,BGRAPixelTransparent);
1029end;
1030
1031function TBGRAMultishapeFiller.AddRectangle(x1, y1, x2, y2: single;
1032 AColor: TBGRAPixel): integer;
1033begin
1034 result := AddPolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],AColor);
1035end;
1036
1037function TBGRAMultishapeFiller.AddRectangle(x1, y1, x2, y2: single;
1038 ATexture: IBGRAScanner): integer;
1039begin
1040 result := AddPolygon([PointF(x1,y1),PointF(x2,y1),PointF(x2,y2),PointF(x1,y2)],ATexture);
1041end;
1042
1043function TBGRAMultishapeFiller.AddRectangleBorder(x1, y1, x2, y2, w: single;
1044 AColor: TBGRAPixel): integer;
1045var hw : single;
1046begin
1047 hw := w/2;
1048 if not CheckRectangleBorderBounds(x1,y1,x2,y2,w) then
1049 result := AddRectangle(x1-hw,y1-hw,x2+hw,y2+hw,AColor) else
1050 result := AddPolygon([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw),EmptyPointF,
1051 PointF(x1+hw,y2-hw),PointF(x2-hw,y2-hw),PointF(x2-hw,y1+hw),PointF(x1+hw,y1+hw)],AColor);
1052end;
1053
1054function TBGRAMultishapeFiller.AddRectangleBorder(x1, y1, x2, y2, w: single;
1055 ATexture: IBGRAScanner): integer;
1056var hw : single;
1057begin
1058 hw := w/2;
1059 if not CheckRectangleBorderBounds(x1,y1,x2,y2,w) then
1060 result := AddRectangle(x1-hw,y1-hw,x2+hw,y2+hw,ATexture) else
1061 result := AddPolygon([PointF(x1-hw,y1-hw),PointF(x2+hw,y1-hw),PointF(x2+hw,y2+hw),PointF(x1-hw,y2+hw),EmptyPointF,
1062 PointF(x1+hw,y2-hw),PointF(x2-hw,y2-hw),PointF(x2-hw,y1+hw),PointF(x1+hw,y1+hw)],ATexture);
1063end;
1064
1065procedure TBGRAMultishapeFiller.OverrideFillMode(AShapeIndex: integer;
1066 AFillMode: TFillMode);
1067begin
1068 if AShapeIndex < 0 then exit;
1069 if AShapeIndex >= nbShapes then raise exception.Create('Index out of bounds');
1070 shapes[AShapeIndex].fillMode := AFillMode;
1071 shapes[AShapeIndex].fillModeOverride := true;
1072end;
1073
1074procedure TBGRAMultishapeFiller.Draw(dest: TBGRACustomBitmap; ADrawMode: TDrawMode = dmDrawWithTransparency);
1075var
1076 shapeRow: array of record
1077 density: PDensity;
1078 densMinx,densMaxx: integer;
1079 nbInter: integer;
1080 inter: array of TIntersectionInfo;
1081 end;
1082 shapeRowsList: array of integer;
1083 NbShapeRows: integer;
1084 miny, maxy, minx, maxx,
1085 rowminx, rowmaxx: integer;
1086
1087 procedure SubstractScanlines(src,dest: integer);
1088 var i: integer;
1089
1090 procedure SubstractSegment(srcseg: integer);
1091 var x1,x2, x3,x4: single;
1092 j: integer;
1093
1094 procedure AddSegment(xa,xb: single);
1095 var nb: PInteger;
1096 begin
1097 nb := @shapeRow[dest].nbinter;
1098 if length(shapeRow[dest].inter) < nb^+2 then
1099 setlength(shapeRow[dest].inter, nb^*2+2);
1100 with shapeRow[dest] do
1101 begin
1102 if inter[nb^] = nil then inter[nb^] := shapes[dest].info.CreateIntersectionInfo;
1103 inter[nb^].interX := xa;
1104 if inter[nb^+1] = nil then inter[nb^+1] := shapes[dest].info.CreateIntersectionInfo;
1105 inter[nb^+1].interX := xb;
1106 end;
1107 inc(nb^,2);
1108 end;
1109
1110 begin
1111 x1 := shapeRow[src].inter[(srcseg-1)*2].interX;
1112 x2 := shapeRow[src].inter[srcseg*2-1].interX;
1113 for j := shapeRow[dest].nbInter div 2 downto 1 do
1114 begin
1115 x3 := shapeRow[dest].inter[(j-1)*2].interX;
1116 x4 := shapeRow[dest].inter[j*2-1].interX;
1117 if (x2 <= x3) or (x1 >= x4) then continue; //not overlapping
1118 if (x1 <= x3) and (x2 >= x4) then
1119 shapeRow[dest].inter[j*2-1].interX := x3 //empty
1120 else
1121 if (x1 <= x3) and (x2 < x4) then
1122 shapeRow[dest].inter[(j-1)*2].interX := x2 //remove left part
1123 else
1124 if (x1 > x3) and (x2 >= x4) then
1125 shapeRow[dest].inter[j*2-1].interX := x1 else //remove right part
1126 begin
1127 //[x1,x2] is inside [x3,x4]
1128 shapeRow[dest].inter[j*2-1].interX := x1; //left part
1129 AddSegment(x2,x4);
1130 end;
1131 end;
1132 end;
1133
1134 begin
1135 for i := 1 to shapeRow[src].nbInter div 2 do
1136 SubstractSegment(i);
1137 end;
1138
1139var
1140 AliasingOfs: TPointF;
1141 useAA: boolean;
1142
1143 procedure AddOneLineDensity(cury: single);
1144 var
1145 i,k: integer;
1146 ix1,ix2: integer;
1147 x1,x2: single;
1148 begin
1149 for k := 0 to NbShapeRows-1 do
1150 with shapeRow[shapeRowsList[k]], shapes[shapeRowsList[k]] do
1151 begin
1152 //find intersections
1153 info.ComputeAndSort(cury, inter, nbInter, fillMode=fmWinding);
1154 nbInter := nbInter and not 1; //even
1155 end;
1156
1157 case PolygonOrder of
1158 poLastOnTop: begin
1159 for k := 1 to NbShapeRows-1 do
1160 if shapeRow[shapeRowsList[k]].nbInter > 0 then
1161 for i := 0 to k-1 do
1162 SubstractScanlines(shapeRowsList[k],shapeRowsList[i]);
1163 end;
1164 poFirstOnTop: begin
1165 for k := 0 to NbShapeRows-2 do
1166 if shapeRow[shapeRowsList[k]].nbInter > 0 then
1167 for i := k+1 to NbShapeRows-1 do
1168 SubstractScanlines(shapeRowsList[k],shapeRowsList[i]);
1169 end;
1170 end;
1171
1172 for k := 0 to NbShapeRows-1 do
1173 with shapeRow[shapeRowsList[k]] do
1174 begin
1175 //fill density
1176 if not useAA then
1177 begin
1178 for i := 0 to nbinter div 2 - 1 do
1179 begin
1180 x1 := inter[i + i].interX;
1181 x2 := inter[i + i + 1].interX;
1182 ComputeAliasedRowBounds(x1+AliasingOfs.X,x2+AliasingOfs.X,minx,maxx,ix1,ix2);
1183
1184 if ix1 < densMinx then densMinx := ix1;
1185 if ix2 > densMaxx then densMaxx := ix2;
1186
1187 if ix2 >= ix1 then
1188 FillWord(density[ix1-minx],ix2-ix1+1,256);
1189 end;
1190 end else
1191 {$DEFINE INCLUDE_FILLDENSITY}
1192 {$i density256.inc}
1193 end;
1194
1195 for k := 0 to NbShapeRows-1 do
1196 with shapeRow[shapeRowsList[k]] do
1197 begin
1198 if densMinX < rowminx then rowminx := densMinX;
1199 if densMaxX > rowmaxx then rowmaxx := densMaxX;
1200 end;
1201 end;
1202
1203type
1204 TCardinalSum = record
1205 sumR,sumG,sumB,sumA: cardinal;
1206 end;
1207
1208var
1209 MultiEmpty: boolean;
1210 bounds: TRect;
1211
1212 xb, yb, yc, k: integer;
1213 pdest: PBGRAPixel;
1214
1215 curSum,nextSum: ^TCardinalSum;
1216 sums: array of TCardinalSum;
1217 curAlpha: byte;
1218
1219 pdens: PDensity;
1220 w: UInt32or64;
1221 ec: TExpandedPixel;
1222 count: integer;
1223 ScanNextFunc: function: TBGRAPixel of object;
1224
1225begin
1226 if nbShapes = 0 then exit;
1227 for k := 0 to nbShapes-1 do
1228 if not shapes[k].fillModeOverride then shapes[k].fillMode:= fillMode;
1229
1230 useAA := Antialiasing and (ADrawMode in [dmDrawWithTransparency,dmLinearBlend]);
1231 if nbShapes = 1 then
1232 begin
1233 if useAA then
1234 FillShapeAntialias(dest,shapes[0].info,GammaCompression(shapes[0].color),False,shapes[0].texture,shapes[0].fillMode = fmWinding, ADrawMode=dmLinearBlend) else
1235 FillShapeAliased(dest,shapes[0].info,GammaCompression(shapes[0].color),False,shapes[0].texture,shapes[0].fillMode = fmWinding, ADrawMode,
1236 AliasingIncludeBottomRight);
1237 exit;
1238 end;
1239 bounds := Rect(0,0,0,0);
1240 MultiEmpty := True;
1241 for k := 0 to nbShapes-1 do
1242 begin
1243 If BGRAShapeComputeMinMax(shapes[k].info,minx,miny,maxx,maxy,dest) then
1244 begin
1245 shapes[k].bounds := rect(minx,miny,maxx+1,maxy+1);
1246 if MultiEmpty then
1247 begin
1248 MultiEmpty := False;
1249 bounds := shapes[k].bounds;
1250 end else
1251 begin
1252 if minx < bounds.left then bounds.left := minx;
1253 if miny < bounds.top then bounds.top := miny;
1254 if maxx >= bounds.right then bounds.right := maxx+1;
1255 if maxy >= bounds.bottom then bounds.bottom := maxy+1;
1256 end;
1257 end else
1258 shapes[k].bounds := rect(0,0,0,0);
1259 end;
1260 if MultiEmpty then exit;
1261 minx := bounds.left;
1262 miny := bounds.top;
1263 maxx := bounds.right-1;
1264 maxy := bounds.bottom-1;
1265
1266 setlength(shapeRow, nbShapes);
1267 for k := 0 to nbShapes-1 do
1268 begin
1269 shapeRow[k].inter := shapes[k].info.CreateIntersectionArray;
1270 getmem(shapeRow[k].density, (maxx - minx + 2)*sizeof(TDensity)); //more for safety
1271 end;
1272
1273 if AliasingIncludeBottomRight then
1274 AliasingOfs := PointF(0,0) else
1275 AliasingOfs := PointF(-0.0001,-0.0001);
1276
1277 setlength(sums,maxx-minx+1);
1278 setlength(shapeRowsList, nbShapes);
1279
1280 //vertical scan
1281 for yb := miny to maxy do
1282 begin
1283 rowminx := maxx+1;
1284 rowmaxx := minx-1;
1285
1286 //init shape rows
1287 NbShapeRows := 0;
1288 for k := 0 to nbShapes-1 do
1289 if (yb >= shapes[k].bounds.top) and (yb < shapes[k].bounds.Bottom) then
1290 begin
1291 shapeRowsList[NbShapeRows] := k;
1292 inc(NbShapeRows);
1293
1294 fillchar(shapeRow[k].density^,(maxx-minx+1)*sizeof(TDensity),0);
1295 shapeRow[k].densMinx := maxx+1;
1296 shapeRow[k].densMaxx := minx-1;
1297 end;
1298
1299 If useAA then
1300 begin
1301 //precision scan
1302 for yc := 0 to AntialiasPrecision - 1 do
1303 AddOneLineDensity( yb + (yc * 2 + 1) / (AntialiasPrecision * 2) );
1304 end else
1305 begin
1306 AddOneLineDensity( yb + 0.5 - AliasingOfs.Y );
1307 end;
1308
1309 if rowminx < minx then rowminx := minx;
1310 if rowmaxx > maxx then rowmaxx := maxx;
1311
1312 if rowminx <= rowmaxx then
1313 begin
1314 FillChar(sums[rowminx-minx],(rowmaxx-rowminx+1)*sizeof(sums[0]),0);
1315
1316 if useAA then
1317 {$define PARAM_ANTIALIASINGFACTOR}
1318 {$i multishapeline.inc}
1319 else
1320 {$i multishapeline.inc};
1321
1322 pdest := dest.ScanLine[yb] + rowminx;
1323 xb := rowminx;
1324 nextSum := @sums[xb-minx];
1325 case ADrawMode of
1326 dmDrawWithTransparency:
1327 while xb <= rowmaxx do
1328 begin
1329 curSum := nextSum;
1330 inc(nextSum);
1331 with curSum^ do
1332 begin
1333 if sumA <> 0 then
1334 begin
1335 ec.red := (sumR+sumA shr 1) div sumA;
1336 ec.green := (sumG+sumA shr 1) div sumA;
1337 ec.blue := (sumB+sumA shr 1) div sumA;
1338 if sumA > 255 then curAlpha := 255 else curAlpha := sumA;
1339 ec.alpha := curAlpha shl 8 + curAlpha;
1340 count := 1;
1341 while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB)
1342 and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do
1343 begin
1344 inc(xb);
1345 inc(nextSum);
1346 inc(count);
1347 end;
1348 if count = 1 then
1349 DrawExpandedPixelInlineNoAlphaCheck(pdest,ec,curAlpha) else
1350 DrawExpandedPixelsInline(pdest, ec, count );
1351 inc(pdest,count-1);
1352 end;
1353 end;
1354 inc(xb);
1355 inc(pdest);
1356 end;
1357
1358 dmLinearBlend:
1359 while xb <= rowmaxx do
1360 begin
1361 curSum := nextSum;
1362 inc(nextSum);
1363 with curSum^ do
1364 begin
1365 if sumA <> 0 then
1366 begin
1367 ec.red := (sumR+sumA shr 1) div sumA;
1368 ec.green := (sumG+sumA shr 1) div sumA;
1369 ec.blue := (sumB+sumA shr 1) div sumA;
1370 if sumA > 255 then curAlpha := 255 else curAlpha := sumA;
1371 ec.alpha := curAlpha shl 8 + curAlpha;
1372 count := 1;
1373 while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB)
1374 and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do
1375 begin
1376 inc(xb);
1377 inc(nextSum);
1378 inc(count);
1379 end;
1380 if count = 1 then
1381 DrawPixelInlineNoAlphaCheck(pdest,GammaCompression(ec)) else
1382 begin
1383 DrawPixelsInline(pdest, GammaCompression(ec), count );
1384 inc(pdest,count-1);
1385 end;
1386 end;
1387 end;
1388 inc(xb);
1389 inc(pdest);
1390 end;
1391
1392 dmXor:
1393 while xb <= rowmaxx do
1394 begin
1395 curSum := nextSum;
1396 inc(nextSum);
1397 with curSum^ do
1398 begin
1399 if sumA <> 0 then
1400 begin
1401 ec.red := (sumR+sumA shr 1) div sumA;
1402 ec.green := (sumG+sumA shr 1) div sumA;
1403 ec.blue := (sumB+sumA shr 1) div sumA;
1404 if sumA > 255 then curAlpha := 255 else curAlpha := sumA;
1405 ec.alpha := curAlpha shl 8 + curAlpha;
1406 count := 1;
1407 while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB)
1408 and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do
1409 begin
1410 inc(xb);
1411 inc(nextSum);
1412 inc(count);
1413 end;
1414 XorInline(pdest,GammaCompression(ec),count);
1415 inc(pdest,count-1);
1416 end;
1417 end;
1418 inc(xb);
1419 inc(pdest);
1420 end;
1421
1422 dmSet:
1423 while xb <= rowmaxx do
1424 begin
1425 curSum := nextSum;
1426 inc(nextSum);
1427 with curSum^ do
1428 begin
1429 if sumA <> 0 then
1430 begin
1431 ec.red := (sumR+sumA shr 1) div sumA;
1432 ec.green := (sumG+sumA shr 1) div sumA;
1433 ec.blue := (sumB+sumA shr 1) div sumA;
1434 if sumA > 255 then curAlpha := 255 else curAlpha := sumA;
1435 ec.alpha := curAlpha shl 8 + curAlpha;
1436 count := 1;
1437 while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB)
1438 and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do
1439 begin
1440 inc(xb);
1441 inc(nextSum);
1442 inc(count);
1443 end;
1444 FillInline(pdest,GammaCompression(ec),count);
1445 inc(pdest,count-1);
1446 end;
1447 end;
1448 inc(xb);
1449 inc(pdest);
1450 end;
1451
1452 dmSetExceptTransparent:
1453 while xb <= rowmaxx do
1454 begin
1455 curSum := nextSum;
1456 inc(nextSum);
1457 with curSum^ do
1458 begin
1459 if sumA >= 255 then
1460 begin
1461 ec.red := (sumR+sumA shr 1) div sumA;
1462 ec.green := (sumG+sumA shr 1) div sumA;
1463 ec.blue := (sumB+sumA shr 1) div sumA;
1464 if sumA > 255 then curAlpha := 255 else curAlpha := sumA;
1465 ec.alpha := curAlpha shl 8 + curAlpha;
1466 count := 1;
1467 while (xb < rowmaxx) and (nextSum^.sumA = sumA) and (nextSum^.sumB = sumB)
1468 and (nextSum^.sumG = sumG) and (nextSum^.sumR = sumR) do
1469 begin
1470 inc(xb);
1471 inc(nextSum);
1472 inc(count);
1473 end;
1474 FillInline(pdest,GammaCompression(ec),count);
1475 inc(pdest,count-1);
1476 end;
1477 end;
1478 inc(xb);
1479 inc(pdest);
1480 end;
1481
1482 end;
1483 end;
1484
1485 end;
1486
1487 for k := 0 to nbShapes-1 do
1488 begin
1489 freemem(shapeRow[k].density);
1490 shapes[k].info.FreeIntersectionArray(shapeRow[k].inter);
1491 end;
1492
1493 dest.InvalidateBitmap;
1494end;
1495
1496procedure BorderEllipse(bmp: TBGRACustomBitmap; x, y, rx, ry, w: single;
1497 c: TBGRAPixel; EraseMode: boolean; drawmode: TDrawMode);
1498var
1499 info: TFillBorderEllipseInfo;
1500begin
1501 if ((rx = 0) and (ry = 0)) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then
1502 exit;
1503 info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w);
1504 FillShapeAliased(bmp, info, c, EraseMode, nil, False, drawmode);
1505 info.Free;
1506end;
1507
1508procedure BorderEllipseWithTexture(bmp: TBGRACustomBitmap; x, y, rx, ry,
1509 w: single; scan: IBGRAScanner; drawmode: TDrawMode);
1510var
1511 info: TFillBorderEllipseInfo;
1512begin
1513 if ((rx = 0) and (ry = 0)) or (w=0) or (x = EmptySingle) or (y = EmptySingle) then
1514 exit;
1515 info := TFillBorderEllipseInfo.Create(x, y, rx, ry, w);
1516 FillShapeAliased(bmp, info, BGRAPixelTransparent, False, scan, false, drawmode);
1517 info.Free;
1518end;
1519
1520procedure FillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2, y2,
1521 rx, ry: single; options: TRoundRectangleOptions; c: TBGRAPixel; EraseMode: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean);
1522var
1523 info: TFillRoundRectangleInfo;
1524begin
1525 if (x1 = x2) or (y1 = y2) then exit;
1526 info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry, options, APixelCenteredCoordinates);
1527 FillShapeAntialias(bmp, info, c, EraseMode,nil, False, LinearBlend);
1528 info.Free;
1529end;
1530
1531procedure FillRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1,
1532 y1, x2, y2, rx, ry: single; options: TRoundRectangleOptions;
1533 scan: IBGRAScanner; LinearBlend: boolean; APixelCenteredCoordinates: boolean);
1534var
1535 info: TFillRoundRectangleInfo;
1536begin
1537 if (x1 = x2) or (y1 = y2) then exit;
1538 info := TFillRoundRectangleInfo.Create(x1, y1, x2, y2, rx, ry, options, APixelCenteredCoordinates);
1539 FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend);
1540 info.Free;
1541end;
1542
1543procedure BorderRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1, x2,
1544 y2, rx, ry, w: single; options: TRoundRectangleOptions; c: TBGRAPixel;
1545 EraseMode: boolean; LinearBlend: boolean; APixelCenteredCoordinates: boolean);
1546var
1547 info: TFillShapeInfo;
1548 oldLinear: boolean;
1549begin
1550 if w=0 then exit;
1551 if ((rx=0) or (ry=0)) and not EraseMode then
1552 begin
1553 oldLinear := bmp.LinearAntialiasing;
1554 bmp.LinearAntialiasing := LinearBlend;
1555 bmp.RectangleAntialias(x1,y1,x2,y2,c,w);
1556 bmp.LinearAntialiasing := oldLinear;
1557 exit;
1558 end;
1559 info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options, APixelCenteredCoordinates);
1560 FillShapeAntialias(bmp, info, c, EraseMode, nil, False, LinearBlend);
1561 info.Free;
1562end;
1563
1564procedure BorderRoundRectangleAntialiasWithTexture(bmp: TBGRACustomBitmap; x1,
1565 y1, x2, y2, rx, ry, w: single; options: TRoundRectangleOptions;
1566 scan: IBGRAScanner; LinearBlend: boolean; APixelCenteredCoordinates: boolean);
1567var
1568 info: TFillBorderRoundRectInfo;
1569 oldLinear: Boolean;
1570begin
1571 if w=0 then exit;
1572 if (rx=0) or (ry=0) then
1573 begin
1574 oldLinear := bmp.LinearAntialiasing;
1575 bmp.LinearAntialiasing := LinearBlend;
1576 bmp.RectangleAntialias(x1,y1,x2,y2,scan,w);
1577 bmp.LinearAntialiasing := oldLinear;
1578 exit;
1579 end;
1580 info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options, APixelCenteredCoordinates);
1581 FillShapeAntialiasWithTexture(bmp, info, scan, False, LinearBlend);
1582 info.Free;
1583end;
1584
1585procedure BorderAndFillRoundRectangleAntialias(bmp: TBGRACustomBitmap; x1, y1,
1586 x2, y2, rx, ry, w: single; options: TRoundRectangleOptions; bordercolor,
1587 fillcolor: TBGRAPixel; bordertexture,filltexture: IBGRAScanner; EraseMode: boolean; APixelCenteredCoordinates: boolean);
1588var
1589 info: TFillBorderRoundRectInfo;
1590 multi: TBGRAMultishapeFiller;
1591begin
1592 if (rx = 0) or (ry = 0) then exit;
1593 info := TFillBorderRoundRectInfo.Create(x1, y1, x2,y2, rx, ry, w, options, APixelCenteredCoordinates);
1594 if not EraseMode then
1595 begin
1596 multi := TBGRAMultishapeFiller.Create;
1597 if filltexture <> nil then
1598 multi.AddShape(info.innerBorder, filltexture) else
1599 multi.AddShape(info.innerBorder, fillcolor);
1600 if w<>0 then
1601 begin
1602 if bordertexture <> nil then
1603 multi.AddShape(info, bordertexture) else
1604 multi.AddShape(info, bordercolor);
1605 end;
1606 multi.Draw(bmp);
1607 multi.Free;
1608 end else
1609 begin
1610 FillShapeAntialias(bmp, info.innerBorder, fillcolor, EraseMode, nil, False, False);
1611 FillShapeAntialias(bmp, info, bordercolor, EraseMode, nil, False, False);
1612 end;
1613 info.Free;
1614end;
1615
1616end.
Note: See TracBrowser for help on using the repository browser.