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