1 unit ugraph;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, bgrabitmap, bgrabitmaptypes, Graphics;
9 
10 const
11   FrameDashLength = 4;
12 
RectUnionnull13 function RectUnion(const rect1, Rect2: TRect): TRect;
RectOfsnull14 function RectOfs(const ARect: TRect; ofsX, ofsY: integer): TRect;
GetShapeBoundsnull15 function GetShapeBounds(const pts: array of TPointF; Width: single): TRect;
16 procedure DrawCheckers(bmp: TBGRABitmap);
17 procedure DrawGrid(bmp: TBGRABitmap; sizex, sizey: single);
ComputeAnglenull18 function ComputeAngle(dx, dy: single): single;
GetSelectionCenternull19 function GetSelectionCenter(bmp: TBGRABitmap): TPointF;
20 procedure ComputeSelectionMask(image: TBGRABitmap; destMask: TBGRABitmap);
21 procedure SubstractMask(image: TBGRABitmap; mask: TBGRABitmap);
22 procedure NicePoint(bmp: TBGRABitmap; x, y: single); overload;
23 procedure NicePoint(bmp: TBGRABitmap; ptF: TPointF); overload;
24 procedure NiceLine(bmp: TBGRABitmap; x1, y1, x2, y2: single);
ComputeColorCirclenull25 function ComputeColorCircle(tx, ty: integer; light: word;
26   hueCorrection: boolean = True): TBGRABitmap;
ChangeCanvasSizenull27 function ChangeCanvasSize(bmp: TBGRABitmap; newWidth, newHeight: integer;
28   anchor: string; background: TBGRAPixel; repeatImage: boolean;
29   flipMode: boolean = False): TBGRABitmap; overload;
30 
31 procedure RenderCloudsOn(bmp: TBGRABitmap; color: TBGRAPixel);
32 procedure RenderWaterOn(bmp: TBGRABitmap; waterColor, skyColor: TBGRAPixel);
33 
CreateMetalFloorTexturenull34 function CreateMetalFloorTexture(tx: integer): TBGRABitmap;
CreatePlastikTexturenull35 function CreatePlastikTexture(tx, ty: integer): TBGRABitmap;
CreateCamouflageTexturenull36 function CreateCamouflageTexture(tx, ty: integer): TBGRABitmap;
CreateSnowPrintTexturenull37 function CreateSnowPrintTexture(tx, ty: integer): TBGRABitmap;
CreateRoundStoneTexturenull38 function CreateRoundStoneTexture(tx, ty: integer): TBGRABitmap;
CreateStoneTexturenull39 function CreateStoneTexture(tx, ty: integer): TBGRABitmap;
CreateWaterTexturenull40 function CreateWaterTexture(tx, ty: integer): TBGRABitmap;
CreateMarbleTexturenull41 function CreateMarbleTexture(tx, ty: integer): TBGRABitmap;
CreateWoodTexturenull42 function CreateWoodTexture(tx, ty: integer): TBGRABitmap;
CreateVerticalWoodTexturenull43 function CreateVerticalWoodTexture(tx, ty: integer): TBGRABitmap;
44 
ClearTypeFilternull45 function ClearTypeFilter(Source: TBGRACustomBitmap): TBGRACustomBitmap;
ClearTypeInverseFilternull46 function ClearTypeInverseFilter(Source: TBGRACustomBitmap): TBGRACustomBitmap;
47 
DoResamplenull48 function DoResample(Source: TBGRABitmap; newWidth, newHeight: integer;
49   StretchMode: TResampleMode): TBGRABitmap;
50 
51 implementation
52 
53 uses Math, Types, LCLProc, BGRAGradients;
54 
RectUnionnull55 function RectUnion(const rect1, Rect2: TRect): TRect;
56 begin
57   if IsRectEmpty(rect1) then
58   begin
59     if IsRectEmpty(rect2) then
60       Result := EmptyRect
61     else
62       Result := rect2;
63   end
64   else
65   begin
66     Result := rect1;
67     if not IsRectEmpty(rect2) then
68       UnionRect(Result, Result, rect2);
69   end;
70 end;
71 
RectOfsnull72 function RectOfs(const ARect: TRect; ofsX, ofsY: integer): TRect;
73 begin
74   Result := ARect;
75   OffsetRect(Result, ofsX, ofsY);
76 end;
77 
GetShapeBoundsnull78 function GetShapeBounds(const pts: array of TPointF; Width: single): TRect;
79 var
80   ix, iy, i: integer;
81 begin
82   Width /= 2;
83   Result.Left := high(integer);
84   Result.Top := high(integer);
85   Result.Right := low(integer);
86   Result.Bottom := low(integer);
87   for i := 0 to high(pts) do
88   begin
89     ix := floor(pts[i].x - Width);
90     iy := floor(pts[i].y - Width);
91     if ix < Result.left then
92       Result.left := ix;
93     if iy < Result.Top then
94       Result.top := iy;
95     ix := ceil(pts[i].x + Width) + 2;
96     iy := ceil(pts[i].y + Width) + 2;
97     if ix > Result.right then
98       Result.right := ix;
99     if iy > Result.bottom then
100       Result.bottom := iy;
101   end;
102   if (Result.right <= Result.left) or (Result.bottom <= Result.top) then
103     Result := EmptyRect;
104 end;
105 
106 procedure DrawCheckers(bmp: TBGRABitmap);
107 const
108   tx = 8;
109   ty = 8;
110 var
111   xb, yb, x, y: integer;
112   oddColor, evenColor: TBGRAPixel;
113 begin
114   oddColor := BGRA(220, 220, 220);
115   evenColor := BGRA(255, 255, 255);
116   y := 0;
117   for yb := 0 to (bmp.Height - 1) div ty do
118   begin
119     x := 0;
120     for xb := 0 to (bmp.Width - 1) div tx do
121     begin
122       if odd(xb + yb) then
123         bmp.FillRect(x, y, x + tx, y + ty, oddColor, dmSet)
124       else
125         bmp.FillRect(x, y, x + tx, y + ty, evenColor, dmSet);
126       Inc(x, tx);
127     end;
128     Inc(y, ty);
129   end;
130 end;
131 
132 procedure DrawGrid(bmp: TBGRABitmap; sizex, sizey: single);
133 var
134   xb, yb: integer;
135   imgGrid: TBGRABitmap;
136   alpha: byte;
137 begin
138   imgGrid := TBGRABitmap.Create(bmp.Width, 1);
139   alpha := min(96, round((abs(sizex) + abs(sizey)) * (96 / 16 / 2)));
140   imgGrid.DrawLineAntialias(0, 0, imgGrid.Width - 1, 0, BGRA(255, 255, 255, alpha),
141     BGRA(0, 0, 0, alpha),
142     min(3, max(1, round(sizex / 8))), True);
143   for yb := 1 to trunc(bmp.Height / sizey) do
144     bmp.PutImage(0, round(yb * sizey), imgGrid, dmFastBlend);
145   imgGrid.Free;
146 
147   imgGrid := TBGRABitmap.Create(1, bmp.Height);
148   imgGrid.DrawLineAntialias(0, 0, 0, imgGrid.Height - 1, BGRA(0, 0, 0, alpha),
149     BGRA(255, 255, 255, alpha),
150     min(3, max(1, round(sizey / 8))), True);
151   for xb := 1 to trunc(bmp.Width / sizex) do
152     bmp.PutImage(round(xb * sizex), 0, imgGrid, dmFastBlend);
153   imgGrid.Free;
154 end;
155 
156 procedure RenderCloudsOn(bmp: TBGRABitmap; color: TBGRAPixel);
157 const
158   minDensity = 180;
159   maxDensity = 240;
160 var
161   i, k, x, y: integer;
162   fact, radius: single;
163   tempBmp: TBGRABitmap;
164   ptemp: PBGRAPixel;
165 begin
166   if color.alpha = 0 then
167     exit;
168 
169   tempBmp := TBGRABitmap.Create(bmp.Width, bmp.Height, BGRABlack);
170   fact := (bmp.Width + bmp.Height) / 15;
171   for i := 120 downto 20 do
172   begin
173     for k := 1 to 2 do
174     begin
175       radius := ((i + random(50)) / 100) * fact;
176       x := random(bmp.Width);
177       y := random(bmp.Height);
178       tempBmp.GradientFill(floor(x - radius), floor(y - radius), ceil(
179         x + radius), ceil(y + radius), BGRA(255, 255, 255, 128), BGRAPixelTransparent,
180         gtRadial, pointf(x, y), pointf(x + radius + 0.5, y), dmFastBlend, False);
181     end;
182   end;
183 
184   ptemp := tempBmp.Data;
185   for i := tempBmp.nbPixels - 1 downto 0 do
186   begin
187     if ptemp^.red < minDensity then
188       ptemp^ := BGRAPixelTransparent
189     else
190     if ptemp^.red > maxDensity then
191       ptemp^ := color
192     else
193       ptemp^ := BGRA(color.red, color.green, color.blue, color.alpha *
194         (ptemp^.red - minDensity) div (maxDensity - minDensity));
195     Inc(ptemp);
196   end;
197   bmp.PutImage(0, 0, tempBmp, dmDrawWithTransparency);
198   tempBmp.Free;
199 end;
200 
201 procedure RenderWaterOn(bmp: TBGRABitmap; waterColor, skyColor: TBGRAPixel);
202 var
203   Noise, Temp: TBGRABitmap;
204   Phong: TPhongShading;
205 begin
206   Noise := CreateCyclicPerlinNoiseMap(bmp.Width, bmp.Height, 1, 1, 1.2);
207   Temp := Noise.FilterBlurRadial(1, rbFast) as TBGRABitmap;
208   Noise.Free;
209   Noise := Temp;
210   Noise.ApplyGlobalOpacity(waterColor.alpha);
211   waterColor.alpha := 255;
212 
213   Phong := TPhongShading.Create;
214   Phong.NegativeDiffusionFactor := 0.1;
215   Phong.AmbientFactor := 0.7;
216   Phong.LightSourceDistanceFactor := 0;
217   Phong.LightDestFactor := 0;
218   Phong.LightSourceIntensity := 300;
219   Phong.LightPosition := Point(-500, -500);
220   Phong.LightColor := skyColor;
221   Phong.Draw(bmp, Noise, 30, 0, 0, waterColor);
222   Noise.Free;
223   Phong.Free;
224 end;
225 
Interp256null226 function Interp256(value1, value2, position: integer): integer; inline;
227 begin
228   Result := (value1 * (256 - position) + value2 * position) shr 8;
229 end;
230 
Interp256null231 function Interp256(color1, color2: TBGRAPixel; position: integer): TBGRAPixel; inline;
232 begin
233   Result.red := Interp256(color1.red, color2.red, position);
234   Result.green := Interp256(color1.green, color2.green, position);
235   Result.blue := Interp256(color1.blue, color2.blue, position);
236   Result.alpha := Interp256(color1.alpha, color2.alpha, position);
237 end;
238 
CreateWoodTexturenull239 function CreateWoodTexture(tx, ty: integer): TBGRABitmap;
240 var
241   colorOscillation, globalColorVariation: integer;
242   p: PBGRAPixel;
243   i: integer;
244 begin
245   Result := CreateCyclicPerlinNoiseMap(tx, ty, 1.5, 1.5, 1, rfBestQuality);
246   p := Result.Data;
247   for i := 0 to Result.NbPixels - 1 do
248   begin
249     colorOscillation := round(sqrt((sin(p^.red * Pi / 16) + 1) / 2) * 256);
250     globalColorVariation := p^.red;
251     p^ := Interp256(Interp256(BGRA(247, 188, 120), BGRA(255, 218, 170),
252       colorOscillation), Interp256(BGRA(157, 97, 60), BGRA(202, 145, 112),
253       colorOscillation), globalColorVariation);
254     Inc(p);
255   end;
256 end;
257 
CreateVerticalWoodTexturenull258 function CreateVerticalWoodTexture(tx, ty: integer): TBGRABitmap;
259 var
260   globalPos: single;
261   colorOscillation, globalColorVariation: integer;
262   p: PBGRAPixel;
263   i: integer;
264   x, nbVertical: integer;
265 begin
266   Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1, rfBestQuality);
267   p := Result.Data;
268   x := 0;
269   nbVertical := tx div 128;
270   if nbVertical = 0 then
271     nbVertical := 1;
272   for i := 0 to Result.NbPixels - 1 do
273   begin
274     globalPos := p^.red * Pi / 32 + nbVertical * x * 2 * Pi / tx * 8;
275     colorOscillation := round(sqrt((sin(globalPos) + 1) / 2) * 256);
276     globalColorVariation := p^.red; //round(sin(globalPos/8)*128+128);
277     p^ := Interp256(Interp256(BGRA(247, 188, 120), BGRA(255, 218, 170),
278       colorOscillation), Interp256(BGRA(157, 97, 60), BGRA(202, 145, 112),
279       colorOscillation), globalColorVariation);
280     Inc(p);
281     Inc(x);
282     if x = tx then
283       x := 0;
284   end;
285 end;
286 
ClearTypeFilternull287 function ClearTypeFilter(Source: TBGRACustomBitmap): TBGRACustomBitmap;
288 var
289   mul3, temp: TBGRACustomBitmap;
290   xb, yb: integer;
291   pmul3, pdest: PBGRAPixel;
292   a: byte;
293 begin
294   Source.ResampleFilter := rfSpline;
295   mul3 := Source.Resample(Source.Width * 3 - 2, Source.Height);
296   temp := Source.NewBitmap(Source.Width * 3, Source.Height);
297   temp.PutImage(1, 0, mul3, dmSet);
298   for yb := 0 to temp.Height - 1 do
299   begin
300     temp.SetPixel(0, yb, temp.GetPixel(1, yb));
301     temp.SetPixel(temp.Width - 1, yb, temp.GetPixel(temp.Width - 2, yb));
302   end;
303   mul3.Free;
304   mul3 := temp;
305   Result := Source.NewBitmap(Source.Width, Source.Height);
306   for yb := 0 to Result.Height - 1 do
307   begin
308     pmul3 := mul3.ScanLine[yb];
309     pdest := Result.ScanLine[yb];
310     for xb := Result.Width - 1 downto 0 do
311     begin
312       a := (pmul3 + 1)^.alpha;
313       if a = 0 then
314         pdest^ := BGRAPixelTransparent
315       else
316       begin
317         pdest^.alpha := a;
318         if pmul3^.alpha = 0 then
319           pdest^.red := 128
320         else
321           pdest^.red := pmul3^.red;
322         pdest^.green := (pmul3 + 1)^.green;
323         if (pmul3 + 2)^.alpha = 0 then
324           pdest^.blue := 128
325         else
326           pdest^.blue := (pmul3 + 2)^.blue;
327       end;
328       Inc(pdest);
329       Inc(pmul3, 3);
330     end;
331   end;
332   mul3.Free;
333 end;
334 
ClearTypeInverseSubFilternull335 function ClearTypeInverseSubFilter(Source: TBGRACustomBitmap): TBGRACustomBitmap;
336 const
337   blueA = 20;
338   blueB = 0;
339   blueC = 2;
340   redA = 20;
341   redB = 0;
342   redC = 2;
343 
344   maxV = 255;
345 
346 var
347   yb, xb: integer;
348   psrc, pdest, pgray: PBGRAPixel;
349   a, v: integer;
350   grayscale, temp: TBGRACustomBitmap;
351 
Merge3null352   function Merge3(c1, c2, c3: TBGRAPixel): TBGRAPixel;
353   var
354     c123: cardinal;
355   begin
356     if (c1.alpha = 0) then
357       Result := MergeBGRA(c2, c3)
358     else
359     if (c2.alpha = 0) then
360       Result := MergeBGRA(c1, c3)
361     else
362     if (c3.alpha = 0) then
363       Result := MergeBGRA(c1, c2)
364     else
365     begin
366       c123 := c1.alpha + c2.alpha + c3.alpha;
367       Result.red := (c1.red * c1.alpha + c2.red * c2.alpha + c3.red *
368         c3.alpha + c123 shr 1) div c123;
369       Result.green := (c1.green * c1.alpha + c2.green * c2.alpha +
370         c3.green * c3.alpha + c123 shr 1) div c123;
371       Result.blue := (c1.blue * c1.alpha + c2.blue * c2.alpha +
372         c3.blue * c3.alpha + c123 shr 1) div c123;
373       Result.alpha := (c123 + 1) div 3;
374     end;
375   end;
376 
377 begin
378   if Source.Width <= 1 then
379   begin
380     Result := Source.duplicate;
381     exit;
382   end;
383   grayscale := Source;
384   temp := Source.NewBitmap(Source.Width, Source.Height);
385   for yb := 0 to Source.Height - 1 do
386   begin
387     psrc := Source.Scanline[yb];
388     pgray := grayscale.ScanLine[yb];
389     pdest := temp.Scanline[yb];
390     pdest^.red := psrc^.red;
391     pdest^.green := psrc^.green;
392     pdest^.alpha := psrc^.alpha;
393     a := (psrc^.alpha * blueA) - ((psrc + 1)^.alpha * (blueB));
394     if a > 0 then
395     begin
396       v := ((integer(psrc^.blue) * blueA) * psrc^.alpha - integer(
397         (psrc + 1)^.blue * blueB) * (psrc + 1)^.alpha) div a;
398       if v >= maxV then
399         pdest^.blue := 255
400       else
401       if v > 0 then
402         pdest^.blue := v
403       else
404         pdest^.blue := 0;
405     end
406     else
407       pdest^.blue := psrc^.blue;
408     Inc(pdest);
409     Inc(psrc);
410     Inc(pgray);
411     for xb := Source.Width - 3 downto 0 do
412     begin
413       pdest^.green := psrc^.green;
414       pdest^.alpha := psrc^.alpha;
415 
416       a := (psrc^.alpha * redA) - ((psrc - 1)^.alpha * (redB));
417       if a > 0 then
418       begin
419         v := ((integer(psrc^.red) * redA) * psrc^.alpha - integer(
420           (psrc - 1)^.red * redB + ((pgray - 1)^.green - pgray^.green) * redC) *
421           (psrc - 1)^.alpha) div a;
422         if v >= maxV then
423           pdest^.red := 255
424         else
425         if v > 0 then
426           pdest^.red := v
427         else
428           pdest^.red := 0;
429       end
430       else
431         pdest^.red := psrc^.red;
432 
433       a := (psrc^.alpha * blueA) - ((psrc + 1)^.alpha * (blueB));
434       if a > 0 then
435       begin
436         v := ((integer(psrc^.blue) * blueA) * psrc^.alpha - integer(
437           (psrc + 1)^.blue * blueB + ((pgray + 1)^.green - pgray^.green) * blueC) *
438           (psrc + 1)^.alpha) div a;
439         if v >= maxV then
440           pdest^.blue := 255
441         else
442         if v > 0 then
443           pdest^.blue := v
444         else
445           pdest^.blue := 0;
446       end
447       else
448         pdest^.blue := psrc^.blue;
449       Inc(pdest);
450       Inc(psrc);
451       Inc(pgray);
452     end;
453     pdest^.green := psrc^.green;
454     pdest^.blue := psrc^.blue;
455     pdest^.alpha := psrc^.alpha;
456 
457     a := (psrc^.alpha * redA) - ((psrc - 1)^.alpha * (redB));
458     if a > 0 then
459     begin
460       v := ((integer(psrc^.red) * redA) * psrc^.alpha - integer(
461         (psrc - 1)^.red * redB) * (psrc - 1)^.alpha) div a;
462       if v >= maxV then
463         pdest^.red := 255
464       else
465       if v > 0 then
466         pdest^.red := v
467       else
468         pdest^.red := 0;
469     end
470     else
471       pdest^.red := psrc^.red;
472   end;
473 
474   Result := temp;
475 end;
476 
ClearTypeSharpenFilternull477 function ClearTypeSharpenFilter(Source, diffbmp: TBGRACustomBitmap): TBGRACustomBitmap;
478 const
479   factnum = 3;
480   factdenom = 5;
481 var
482   xb, yb, maxx: integer;
483   psrc, pdest, pdiff: PBGRAPixel;
484   d1, d2: integer;
485 
clampnull486   function clamp(Value: integer): byte;
487   begin
488     if Value <= 0 then
489       Result := 0
490     else if Value >= 255 then
491       Result := 255
492     else
493       Result := Value;
494   end;
495 
adjustDiffnull496   function adjustDiff(ref, v1, v2: integer): integer;
497   begin
498     v1 -= ref;
499     v2 -= ref;
500     Result := v1 + v2;
501   end;
502 
503 begin
504   if diffbmp = nil then
505     diffbmp := Source;
506   if (Source.Width <= 1) or (diffbmp.Width <> Source.Width) or
507     (diffbmp.Height <> Source.Height) then
508   begin
509     Result := Source.Duplicate();
510     exit;
511   end;
512   Result := Source.NewBitmap(Source.Width, Source.Height);
513   for yb := 0 to Result.Height - 1 do
514   begin
515     psrc := Source.ScanLine[yb];
516     pdest := Result.ScanLine[yb];
517     pdiff := diffbmp.ScanLine[yb];
518     maxx := Result.Width - 1;
519     for xb := 0 to maxx do
520     begin
521       if psrc^.alpha <> 0 then
522       begin
523         if (xb > 0) and ((psrc - 1)^.alpha <> 0) and (xb < maxx) and
524           ((psrc + 1)^.alpha <> 0) then
525         begin
526           d1 := BGRADiff((pdiff - 1)^, pdiff^);
527           d2 := BGRADiff((pdiff + 1)^, pdiff^);
528           if (d1 > 20) and (d2 > 20) and (d1 + d2 > 100) then
529           begin
530             pdest^.red := clamp(psrc^.red -
531               (adjustDiff(psrc^.red, (psrc + 1)^.red, (psrc - 1)^.red)) *
532               factnum div (2 * factdenom));
533             pdest^.green := psrc^.green;
534             pdest^.blue := clamp(psrc^.blue -
535               (adjustDiff(psrc^.blue, (psrc + 1)^.blue, (psrc - 1)^.blue)) *
536               factnum div (2 * factdenom));
537             pdest^.alpha := psrc^.alpha;
538           end
539           else
540             pdest^ := psrc^;
541         end
542         else
543         if (xb < maxx) and ((psrc + 1)^.alpha <> 0) then
544         begin
545           pdest^.red := clamp(psrc^.red - ((psrc + 1)^.red - psrc^.red) *
546             factnum div factdenom);
547           pdest^.green := psrc^.green;
548           pdest^.blue := clamp(psrc^.blue - ((psrc + 1)^.blue - psrc^.blue) *
549             factnum div factdenom);
550           pdest^.alpha := psrc^.alpha;
551         end
552         else
553         if (xb > 0) and ((psrc - 1)^.alpha <> 0) then
554         begin
555           pdest^.red := clamp(psrc^.red - ((psrc - 1)^.red - psrc^.red) *
556             factnum div factdenom);
557           pdest^.green := psrc^.green;
558           pdest^.blue := clamp(psrc^.blue - ((psrc - 1)^.blue - psrc^.blue) *
559             factnum div factdenom);
560           pdest^.alpha := psrc^.alpha;
561         end
562         else
563           pdest^ := psrc^;
564       end
565       else
566         pdest^ := BGRAPixelTransparent;
567 
568       Inc(pdest);
569       Inc(psrc);
570       Inc(pdiff);
571     end;
572   end;
573 end;
574 
ClearTypeRemoveContradictionnull575 function ClearTypeRemoveContradiction(Source: TBGRACustomBitmap): TBGRACustomBitmap;
576 var
577   xb, yb: integer;
578   dr, db: integer;
579   ratio: single;
580   psrc, pdest: PBGRAPixel;
581 
582 begin
583   if Source.Width <= 1 then
584   begin
585     Result := Source.Duplicate();
586     exit;
587   end;
588   Result := Source.NewBitmap(Source.Width, Source.Height);
589   for yb := 0 to Result.Height - 1 do
590   begin
591     psrc := Source.ScanLine[yb];
592     pdest := Result.ScanLine[yb];
593     pdest^ := psrc^;
594     for xb := Result.Width - 2 downto 0 do
595     begin
596       (pdest +1)^ := (psrc + 1)^;
597       if (psrc^.alpha > 10) and ((psrc + 1)^.alpha > 10) then
598       begin
599         dr := psrc^.red - (psrc + 1)^.red;
600         db := psrc^.blue - (psrc + 1)^.blue;
601         if ((db < 0) and (dr > 0)) or ((db > 0) and (dr < 0)) then
602         begin
603           ratio := abs(dr / db);
604           if (ratio > 0.2) and (ratio < 5) then
605           begin
606             dr := (psrc^.red * psrc^.alpha + (psrc + 1)^.red * (psrc + 1)^.alpha) div
607               (psrc^.alpha + (psrc + 1)^.alpha);
608             db := (psrc^.blue * psrc^.alpha + (psrc + 1)^.blue * (psrc + 1)^.alpha) div
609               (psrc^.alpha + (psrc + 1)^.alpha);
610             pdest^.red := dr;
611             pdest^.blue := db;
612             (pdest +1)^.red := dr;
613             (pdest +1)^.blue := db;
614           end;
615         end;
616       end;
617       Inc(pdest);
618       Inc(psrc);
619     end;
620   end;
621 end;
622 
ClearTypeInverseFilternull623 function ClearTypeInverseFilter(Source: TBGRACustomBitmap): TBGRACustomBitmap;
624 var
625   mul3, temp: TBGRACustomBitmap;
626   xb, yb: integer;
627   pmul3, pdest: PBGRAPixel;
628   a: byte;
629 begin
630   Source.ResampleFilter := rfSpline;
631   mul3 := Source.Resample(Source.Width * 3 - 2, Source.Height);
632   temp := Source.NewBitmap(Source.Width * 3, Source.Height);
633   temp.PutImage(1, 0, mul3, dmSet);
634   for yb := 0 to temp.Height - 1 do
635   begin
636     temp.SetPixel(0, yb, temp.GetPixel(1, yb));
637     temp.SetPixel(temp.Width - 1, yb, temp.GetPixel(temp.Width - 2, yb));
638   end;
639   mul3.Free;
640   mul3 := temp;
641   Result := Source.NewBitmap(Source.Width, Source.Height);
642   for yb := 0 to Result.Height - 1 do
643   begin
644     pmul3 := mul3.ScanLine[yb];
645     pdest := Result.ScanLine[yb];
646     for xb := Result.Width - 1 downto 0 do
647     begin
648       a := (pmul3 + 1)^.alpha;
649       if a = 0 then
650         pdest^ := BGRAPixelTransparent
651       else
652       begin
653         pdest^.alpha := a;
654         if (pmul3 + 2)^.alpha = 0 then
655           pdest^.red := 128
656         else
657           pdest^.red := (pmul3 + 2)^.red;
658         pdest^.green := (pmul3 + 1)^.green;
659         if pmul3^.alpha = 0 then
660           pdest^.blue := 128
661         else
662           pdest^.blue := pmul3^.blue;
663       end;
664       Inc(pdest);
665       Inc(pmul3, 3);
666     end;
667   end;
668   mul3.Free;
669 
670   temp := ClearTypeRemoveContradiction(Result);
671   Result.Free;
672   Result := temp;
673 
674   temp := Result;
675   Result := ClearTypeSharpenFilter(temp, Source);
676   temp.Free;
677 
678   temp := ClearTypeRemoveContradiction(Result);
679   Result.Free;
680   Result := temp;
681 end;
682 
DoResamplenull683 function DoResample(Source: TBGRABitmap; newWidth, newHeight: integer;
684   StretchMode: TResampleMode): TBGRABitmap;
685 begin
686   Result := Source.Resample(newWidth, newHeight, StretchMode) as TBGRABitmap;
687 end;
688 
CreateMarbleTexturenull689 function CreateMarbleTexture(tx, ty: integer): TBGRABitmap;
690 var
691   colorOscillation: integer;
692   p: PBGRAPixel;
693   i: integer;
694 begin
695   Result := CreateCyclicPerlinNoiseMap(tx, ty, 0.5, 0.5, 0.8, rfBestQuality);
696   p := Result.Data;
697   for i := 0 to Result.NbPixels - 1 do
698   begin
699     colorOscillation := round(sqrt(sqrt((sin(p^.red * Pi / 128 + 0.5) + 1) / 2)) * 256);
700     p^ := Interp256(BGRA(161, 117, 105), BGRA(218, 197, 180), colorOscillation);
701     Inc(p);
702   end;
703 end;
704 
CreateWaterTexturenull705 function CreateWaterTexture(tx, ty: integer): TBGRABitmap;
706 const
707   blurSize = 5;
708 var
709   temp: TBGRABitmap;
710   phong: TPhongShading;
711 begin
712   Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1.2, rfBestQuality);
713   temp := Result.GetPart(rect(-blurSize, -blurSize, tx + blurSize, ty + blurSize)) as
714     TBGRABitmap;
715   BGRAReplace(temp, temp.FilterBlurRadial(blurSize, rbFast));
716   phong := TPhongShading.Create;
717   phong.LightSourceDistanceFactor := 0;
718   phong.LightDestFactor := 0;
719   phong.LightSourceIntensity := 150;
720   phong.LightPositionZ := 80;
721   phong.LightColor := BGRA(105, 233, 240);
722   phong.NegativeDiffusionFactor := 0.3;
723   phong.SpecularIndex := 20;
724   phong.AmbientFactor := 0.4;
725   phong.Draw(Result, temp, 20, -blurSize, -blurSize, BGRA(28, 139, 166));
726   phong.Free;
727   temp.Free;
728 end;
729 
CreateStoneTexturenull730 function CreateStoneTexture(tx, ty: integer): TBGRABitmap;
731 var
732   temp: TBGRABitmap;
733   phong: TPhongShading;
734 begin
735   Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 0.6);
736   temp := Result.GetPart(rect(-2, -2, tx + 2, ty + 2)) as TBGRABitmap;
737   phong := TPhongShading.Create;
738   phong.LightSourceDistanceFactor := 0;
739   phong.LightDestFactor := 0;
740   phong.LightSourceIntensity := 100;
741   phong.LightPositionZ := 100;
742   phong.NegativeDiffusionFactor := 0.3;
743   phong.AmbientFactor := 0.5;
744   phong.Draw(Result, temp, 30, -2, -2, BGRA(170, 170, 170));
745   phong.Free;
746   temp.Free;
747 end;
748 
CreateRoundStoneTexturenull749 function CreateRoundStoneTexture(tx, ty: integer): TBGRABitmap;
750 var
751   temp: TBGRABitmap;
752   phong: TPhongShading;
753 begin
754   Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1.2, rfBestQuality);
755   temp := Result.GetPart(rect(-2, -2, tx + 2, ty + 2)) as TBGRABitmap;
756   BGRAReplace(temp, temp.FilterBlurRadial(2, rbFast));
757   phong := TPhongShading.Create;
758   phong.LightSourceDistanceFactor := 0;
759   phong.LightDestFactor := 0;
760   phong.LightSourceIntensity := 70;
761   phong.LightPositionZ := 100;
762   phong.NegativeDiffusionFactor := 0;
763   phong.SpecularIndex := 10;
764   phong.AmbientFactor := 0.5;
765   phong.LightColor := BGRA(255, 255, 192);
766   phong.Draw(Result, temp, 30, -2, -2, BGRA(170, 170, 170));
767   phong.Free;
768   temp.Free;
769 end;
770 
CreateSnowPrintTexturenull771 function CreateSnowPrintTexture(tx, ty: integer): TBGRABitmap;
772 var
773   v: single;
774   p: PBGRAPixel;
775   i: integer;
776 
777   temp: TBGRABitmap;
778   phong: TPhongShading;
779 begin
780   Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1.2, rfBestQuality);
781 
782   p := Result.Data;
783   for i := 0 to Result.NbPixels - 1 do
784   begin
785     v := p^.red;
786     if v > 80 then
787       v := (v - 80) / 10 + 80;
788     if v < 50 then
789       v := 50 - (50 - v) / 10;
790     p^ := MapHeightToBGRA(v / 255, 255);
791     Inc(p);
792   end;
793 
794   temp := Result.GetPart(rect(-2, -2, tx + 2, ty + 2)) as TBGRABitmap;
795   phong := TPhongShading.Create;
796   phong.LightSourceDistanceFactor := 0;
797   phong.LightDestFactor := 0;
798   phong.LightSourceIntensity := 100;
799   phong.LightPositionZ := 100;
800   phong.NegativeDiffusionFactor := 0.3;
801   phong.Draw(Result, temp, 30, -2, -2, BGRAWhite);
802   phong.Free;
803   temp.Free;
804 end;
805 
CreateCamouflageTexturenull806 function CreateCamouflageTexture(tx, ty: integer): TBGRABitmap;
807 var
808   v: integer;
809   p: PBGRAPixel;
810   i: integer;
811 
812   temp: TBGRABitmap;
813 begin
814   Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1, rfBestQuality);
815 
816   p := Result.Data;
817   for i := 0 to Result.NbPixels - 1 do
818   begin
819     v := p^.red;
820     if v < 64 then
821       p^ := BGRA(31, 33, 46)
822     else
823     if v < 128 then
824       p^ := BGRA(89, 71, 57)
825     else
826     if v < 192 then
827       p^ := BGRA(80, 106, 67)
828     else
829       p^ := BGRA(161, 157, 121);
830     Inc(p);
831   end;
832 
833   temp := Result.getPart(rect(-2, -2, tx + 2, ty + 2)) as TBGRABitmap;
834   BGRAReplace(temp, temp.FilterMedian(moMediumSmooth));
835   Result.PutImage(-2, -2, temp, dmSet);
836   temp.Free;
837 end;
838 
CreatePlastikTexturenull839 function CreatePlastikTexture(tx, ty: integer): TBGRABitmap;
840 const
841   blurSize = 2;
842 var
843   temp: TBGRABitmap;
844   phong: TPhongShading;
845   p: PBGRAPixel;
846   i: integer;
847   v: byte;
848 begin
849   Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1);
850 
851   p := Result.Data;
852   for i := 0 to Result.NbPixels - 1 do
853   begin
854     v := p^.red;
855     if v < 32 then
856       v := v * 2
857     else
858     if (v > 32) and (v < 224) then
859       v := (v - 32) div 2 + 64
860     else
861     if v >= 224 then
862       v := (v - 224) * 2 + (224 - 32) div 2;
863     p^ := BGRA(v, v, v);
864     Inc(p);
865   end;
866 
867   temp := Result.GetPart(rect(-blurSize, -blurSize, tx + blurSize, ty + blurSize)) as
868     TBGRABitmap;
869   BGRAReplace(temp, temp.FilterNormalize(False));
870   BGRAReplace(temp, temp.FilterBlurMotion(ty div 6, 90, False));
871   BGRAReplace(temp, temp.FilterBlurRadial(blurSize, rbFast));
872 
873   phong := TPhongShading.Create;
874   phong.LightSourceDistanceFactor := 0;
875   phong.LightDestFactor := 0;
876   phong.LightSourceIntensity := 300;
877   phong.LightPositionZ := 10;
878   phong.NegativeDiffusionFactor := 0;
879   phong.AmbientFactor := 0.6;
880   phong.SpecularIndex := 25;
881   phong.SpecularFactor := 10;
882   phong.Draw(Result, temp, 10, -blurSize, -blurSize, BGRA(58, 206, 113));
883   phong.Free;
884   temp.Free;
885 end;
886 
CreateMetalFloorTexturenull887 function CreateMetalFloorTexture(tx: integer): TBGRABitmap;
888 var
889   temp, noise: TBGRABitmap;
890   phong: TPhongShading;
891   ty: integer;
892 begin
893   ty := tx div 2;
894   Result := TBGRABitmap.Create(tx, ty, BGRABlack);
895   Result.FillEllipseAntialias(tx * 1.2 / 8, ty / 2, tx / 20, ty / 3,
896     BGRA(240, 240, 240));
897   Result.FillEllipseAntialias(tx * 2.8 / 8, ty / 2, tx / 20, ty / 3,
898     BGRA(240, 240, 240));
899   Result.FillEllipseAntialias(tx * 3 / 4, ty * 1.2 / 4, ty / 3, tx /
900     20, BGRA(240, 240, 240));
901   Result.FillEllipseAntialias(tx * 3 / 4, ty * 2.8 / 4, ty / 3, tx /
902     20, BGRA(240, 240, 240));
903   BGRAReplace(Result, Result.FilterBlurRadial(1, rbFast));
904 
905   noise := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1);
906   noise.FillRect(0, 0, tx, ty, BGRA(0, 0, 0, 220), dmLinearBlend);
907   Result.BlendImage(0, 0, noise, boAdditive);
908   noise.Free;
909 
910   temp := Result.GetPart(rect(-2, -2, tx + 2, ty + 2)) as TBGRABitmap;
911   phong := TPhongShading.Create;
912   phong.LightSourceDistanceFactor := 0;
913   phong.LightDestFactor := 0;
914   phong.LightSourceIntensity := 100;
915   phong.LightPositionZ := 80;
916   phong.NegativeDiffusionFactor := 0;
917   phong.AmbientFactor := 0.5;
918   phong.Draw(Result, temp, 10, -2, -2, BGRA(116, 116, 116));
919   phong.Free;
920   temp.Free;
921 end;
922 
ComputeAnglenull923 function ComputeAngle(dx, dy: single): single;
924 begin
925   if dy = 0 then
926   begin
927     if dx < 0 then
928       Result := 180
929     else
930       Result := 0;
931   end
932   else
933   if dx = 0 then
934   begin
935     if dy < 0 then
936       Result := -90
937     else
938       Result := 90;
939   end
940   else
941   begin
942     Result := ArcTan(dy / dx) * 180 / Pi;
943     if dx < 0 then
944       Result += 180;
945   end;
946 end;
947 
GetSelectionCenternull948 function GetSelectionCenter(bmp: TBGRABitmap): TPointF;
949 var
950   xb, yb: integer;
951   p: PBGRAPixel;
952   xsum, ysum, asum, alpha: single;
953 begin
954   xsum := 0;
955   ysum := 0;
956   asum := 0;
957   for yb := 0 to bmp.Height - 1 do
958   begin
959     p := bmp.ScanLine[yb];
960     for xb := 0 to bmp.Width - 1 do
961     begin
962       alpha := p^.red / 255;
963       Inc(p);
964       xsum += xb * alpha;
965       ysum += yb * alpha;
966       asum += alpha;
967     end;
968   end;
969   if asum = 0 then
970     Result := pointF(bmp.Width / 2 - 0.5, bmp.Height / 2 - 0.5)
971   else
972     Result := pointF(xsum / asum, ysum / asum);
973 end;
974 
975 procedure ComputeSelectionMask(image: TBGRABitmap; destMask: TBGRABitmap);
976 var
977   maxx, maxy: integer;
978   aimage: byte;
979   xb, yb: integer;
980   pimage, pmask: PBGRAPixel;
981 begin
982   maxx := min(image.Width, destMask.Width) - 1;
983   maxy := min(image.Height, destMask.Height) - 1;
984   for yb := 0 to maxy do
985   begin
986     pimage := image.ScanLine[yb];
987     pmask := destMask.ScanLine[yb];
988     for xb := 0 to maxx do
989     begin
990       aimage := pimage^.alpha;
991       pmask^ := BGRA(aimage, aimage, aimage, 255);
992       if aimage <> 0 then
993         pimage^.alpha := 255;
994       Inc(pimage);
995       Inc(pmask);
996     end;
997   end;
998 end;
999 
1000 procedure SubstractMask(image: TBGRABitmap; mask: TBGRABitmap);
1001 var
1002   maxx, maxy: integer;
1003   xb, yb: integer;
1004   pimage, pmask: PBGRAPixel;
1005   aimage, amask: byte;
1006 begin
1007   maxx := min(image.Width, Mask.Width) - 1;
1008   maxy := min(image.Height, Mask.Height) - 1;
1009   for yb := 0 to maxy do
1010   begin
1011     pimage := image.ScanLine[yb];
1012     pmask := Mask.ScanLine[yb];
1013     for xb := 0 to maxx do
1014     begin
1015       amask := pmask^.red;
1016       if amask <> 0 then
1017       begin
1018         aimage := pimage^.alpha;
1019         if aimage > amask then
1020           pimage^.alpha := aimage - amask
1021         else
1022           pimage^ := BGRAPixelTransparent;
1023       end;
1024       Inc(pimage);
1025       Inc(pmask);
1026     end;
1027   end;
1028 end;
1029 
1030 procedure NicePoint(bmp: TBGRABitmap; x, y: single);
1031 begin
1032   bmp.EllipseAntialias(x, y, 4, 4, BGRA(0, 0, 0, 192), 1);
1033   bmp.EllipseAntialias(x, y, 3, 3, BGRA(255, 255, 255, 192), 1);
1034   bmp.EllipseAntialias(x, y, 2, 2, BGRA(0, 0, 0, 192), 1);
1035 end;
1036 
1037 procedure NicePoint(bmp: TBGRABitmap; ptF: TPointF);
1038 begin
1039   NicePoint(bmp, ptF.x, ptF.y);
1040 end;
1041 
1042 procedure NiceLine(bmp: TBGRABitmap; x1, y1, x2, y2: single);
1043 begin
1044   bmp.DrawLineAntialias(round(x1), round(y1), round(x2),
1045     round(y2), BGRA(0, 0, 0, 192), 3, True);
1046   bmp.DrawLineAntialias(round(x1), round(y1), round(x2),
1047     round(y2), BGRA(255, 255, 255, 192), 1, True);
1048 end;
1049 
ComputeColorCirclenull1050 function ComputeColorCircle(tx, ty: integer; light: word;
1051   hueCorrection: boolean = True): TBGRABitmap;
1052 var
1053   xb, yb: integer;
1054   pdest: PBGRAPixel;
1055   angle, xc, yc: single;
1056   ec: TExpandedPixel;
1057   c: TBGRAPixel;
1058   gray, level: word;
1059 begin
1060   Result := TBGRABitmap.Create(tx, ty);
1061   Result.FillEllipseAntialias(tx / 2 - 0.5, ty / 2 - 0.5, tx / 2, ty / 2, BGRABlack);
1062   xc := tx / 2 - 0.5;
1063   yc := ty / 2 - 0.5;
1064   for yb := 0 to ty - 1 do
1065   begin
1066     pdest := Result.scanline[yb];
1067     for xb := 0 to tx - 1 do
1068     begin
1069       if pdest^.alpha <> 0 then
1070       begin
1071         ec.alpha := $FFFF;
1072         angle := ComputeAngle(xb - xc, yb - yc);
1073         if angle < 0 then
1074           angle += 360;
1075         if hueCorrection then
1076           angle := GtoH(round(angle / 360 * 65536) and 65535) / 65536 * 360;
1077         if angle < 60 then
1078         begin
1079           ec.red := $FFFF;
1080           ec.green := round(angle / 60 * $FFFF);
1081           ec.blue := $0000;
1082         end
1083         else
1084         if angle < 120 then
1085         begin
1086           ec.red := $FFFF - round((angle - 60) / 60 * $FFFF);
1087           ec.green := $FFFF;
1088           ec.blue := $0000;
1089         end
1090         else
1091         if angle < 180 then
1092         begin
1093           ec.red := $0000;
1094           ec.green := $FFFF;
1095           ec.blue := round((angle - 120) / 60 * $FFFF);
1096         end
1097         else
1098         if angle < 240 then
1099         begin
1100           ec.red := $0000;
1101           ec.green := $FFFFF - round((angle - 180) / 60 * $FFFF);
1102           ec.blue := $FFFF;
1103         end
1104         else
1105         if angle < 300 then
1106         begin
1107           ec.red := round((angle - 240) / 60 * $FFFF);
1108           ec.green := $0000;
1109           ec.blue := $FFFF;
1110         end
1111         else
1112         begin
1113           ec.red := $FFFF;
1114           ec.green := $0000;
1115           ec.blue := $FFFFF - round((angle - 300) / 60 * $FFFF);
1116         end;
1117         gray := min($FFFF, max(0, $FFFF - round(
1118           (sqrt(sqr((xb - xc) / (tx / 2)) + sqr((yb - yc) / (ty / 2))) *
1119           1.2 - 0.1) * $FFFF)));
1120         level := max(max(ec.red, ec.green), ec.blue);
1121         {$hints off}
1122         ec.red := (ec.red * ($FFFF - gray) + level * gray) shr 16;
1123         ec.green := (ec.green * ($FFFF - gray) + level * gray) shr 16;
1124         ec.blue := (ec.blue * ($FFFF - gray) + level * gray) shr 16;
1125         {$hints on}
1126         ec.red := (ec.red * light) shr 16;
1127         ec.green := (ec.green * light) shr 16;
1128         ec.blue := (ec.blue * light) shr 16;
1129         c := GammaCompression(ec);
1130         c.alpha := pdest^.alpha;
1131         pdest^ := c;
1132       end;
1133       Inc(pdest);
1134     end;
1135   end;
1136 end;
1137 
ChangeCanvasSizenull1138 function ChangeCanvasSize(bmp: TBGRABitmap; newWidth, newHeight: integer;
1139   anchor: string; background: TBGRAPixel; repeatImage: boolean;
1140   flipMode: boolean = False): TBGRABitmap;
1141 var
1142   origin: TPoint;
1143   xb, yb: integer;
1144   dx, dy: integer;
1145   minx, miny, maxx, maxy: integer;
1146   flippedImages: array[boolean, boolean] of TBGRABitmap;
1147 begin
1148   if (newWidth < 1) or (newHeight < 1) then
1149     raise Exception.Create('Invalid canvas size');
1150   origin := Point((newWidth - bmp.Width) div 2, (newHeight - bmp.Height) div 2);
1151   anchor := UTF8LowerCase(anchor);
1152   if (anchor = 'topleft') or (anchor = 'top') or (anchor = 'topright') then
1153     origin.Y := 0;
1154   if (anchor = 'bottomleft') or (anchor = 'bottom') or (anchor = 'bottomright') then
1155     origin.Y := newHeight - bmp.Height;
1156   if (anchor = 'topleft') or (anchor = 'left') or (anchor = 'bottomleft') then
1157     origin.X := 0;
1158   if (anchor = 'topright') or (anchor = 'right') or (anchor = 'bottomright') then
1159     origin.X := newWidth - bmp.Width;
1160   Result := TBGRABitmap.Create(newWidth, newHeight, background);
1161   dx := bmp.Width;
1162   dy := bmp.Height;
1163   if repeatImage then
1164   begin
1165     minx := (0 - origin.X - bmp.Width + 1) div bmp.Width;
1166     miny := (0 - origin.Y - bmp.Width + 1) div bmp.Width;
1167     maxx := (newWidth - origin.X + bmp.Width - 1) div bmp.Width;
1168     maxy := (newHeight - origin.Y + bmp.Width - 1) div bmp.Width;
1169   end
1170   else
1171   begin
1172     minx := 0;
1173     miny := 0;
1174     maxx := 0;
1175     maxy := 0;
1176   end;
1177   if flipMode and repeatImage then
1178   begin
1179     flippedImages[False, False] := bmp;
1180     if (minx <> 0) or (miny <> 0) or (maxx <> 0) or (maxy <> 0) then
1181     begin
1182       flippedImages[True, False] := bmp.Duplicate as TBGRABitmap;
1183       flippedImages[True, False].HorizontalFlip;
1184       flippedImages[True, True] := flippedImages[True, False].Duplicate as TBGRABitmap;
1185       flippedImages[True, True].VerticalFlip;
1186       flippedImages[False, True] := bmp.Duplicate as TBGRABitmap;
1187       flippedImages[False, True].VerticalFlip;
1188     end
1189     else
1190     begin
1191       flippedImages[True, False] := nil;  //never used
1192       flippedImages[True, True] := nil;
1193       flippedImages[False, True] := nil;
1194     end;
1195     for xb := minx to maxx do
1196       for yb := miny to maxy do
1197         Result.PutImage(origin.x + xb * dx, origin.Y + yb * dy,
1198           flippedImages[odd(xb), odd(yb)], dmSet);
1199     flippedImages[True, False].Free;
1200     flippedImages[True, True].Free;
1201     flippedImages[False, True].Free;
1202   end
1203   else
1204   begin
1205     for xb := minx to maxx do
1206       for yb := miny to maxy do
1207         Result.PutImage(origin.x + xb * dx, origin.Y + yb * dy, bmp, dmSet);
1208   end;
1209 end;
1210 
MakeThumbnailnull1211 function MakeThumbnail(bmp: TBGRABitmap; Width, Height: integer): TBGRABitmap;
1212 var
1213   resampled: TBGRABitmap;
1214 begin
1215   Result := TBGRABitmap.Create(Width, Height);
1216   if (Width <> 0) and (Height <> 0) and (bmp.Width <> 0) and (bmp.Height <> 0) then
1217   begin
1218     if bmp.Width / bmp.Height > Width / Height then
1219       resampled := bmp.Resample(Width,
1220         max(1, round(bmp.Height * (Width / bmp.Width)))) as TBGRABitmap
1221 
1222     else
1223       resampled := bmp.Resample(max(1, round(bmp.Width * (Height / bmp.Height))),
1224         Height) as TBGRABitmap;
1225     Result.PutImage((Result.Width - resampled.Width) div 2,
1226       (Result.Height - resampled.Height) div 2, resampled, dmSet);
1227     resampled.Free;
1228   end;
1229 end;
1230 
1231 initialization
1232 
1233   Randomize;
1234 
1235 end.
1236