1236 lines
34 KiB
ObjectPascal
1236 lines
34 KiB
ObjectPascal
unit ugraph;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, bgrabitmap, bgrabitmaptypes, Graphics;
|
|
|
|
const
|
|
FrameDashLength = 4;
|
|
|
|
function RectUnion(const rect1, Rect2: TRect): TRect;
|
|
function RectOfs(const ARect: TRect; ofsX, ofsY: integer): TRect;
|
|
function GetShapeBounds(const pts: array of TPointF; Width: single): TRect;
|
|
procedure DrawCheckers(bmp: TBGRABitmap);
|
|
procedure DrawGrid(bmp: TBGRABitmap; sizex, sizey: single);
|
|
function ComputeAngle(dx, dy: single): single;
|
|
function GetSelectionCenter(bmp: TBGRABitmap): TPointF;
|
|
procedure ComputeSelectionMask(image: TBGRABitmap; destMask: TBGRABitmap);
|
|
procedure SubstractMask(image: TBGRABitmap; mask: TBGRABitmap);
|
|
procedure NicePoint(bmp: TBGRABitmap; x, y: single); overload;
|
|
procedure NicePoint(bmp: TBGRABitmap; ptF: TPointF); overload;
|
|
procedure NiceLine(bmp: TBGRABitmap; x1, y1, x2, y2: single);
|
|
function ComputeColorCircle(tx, ty: integer; light: word;
|
|
hueCorrection: boolean = True): TBGRABitmap;
|
|
function ChangeCanvasSize(bmp: TBGRABitmap; newWidth, newHeight: integer;
|
|
anchor: string; background: TBGRAPixel; repeatImage: boolean;
|
|
flipMode: boolean = False): TBGRABitmap; overload;
|
|
|
|
procedure RenderCloudsOn(bmp: TBGRABitmap; color: TBGRAPixel);
|
|
procedure RenderWaterOn(bmp: TBGRABitmap; waterColor, skyColor: TBGRAPixel);
|
|
|
|
function CreateMetalFloorTexture(tx: integer): TBGRABitmap;
|
|
function CreatePlastikTexture(tx, ty: integer): TBGRABitmap;
|
|
function CreateCamouflageTexture(tx, ty: integer): TBGRABitmap;
|
|
function CreateSnowPrintTexture(tx, ty: integer): TBGRABitmap;
|
|
function CreateRoundStoneTexture(tx, ty: integer): TBGRABitmap;
|
|
function CreateStoneTexture(tx, ty: integer): TBGRABitmap;
|
|
function CreateWaterTexture(tx, ty: integer): TBGRABitmap;
|
|
function CreateMarbleTexture(tx, ty: integer): TBGRABitmap;
|
|
function CreateWoodTexture(tx, ty: integer): TBGRABitmap;
|
|
function CreateVerticalWoodTexture(tx, ty: integer): TBGRABitmap;
|
|
|
|
function ClearTypeFilter(Source: TBGRACustomBitmap): TBGRACustomBitmap;
|
|
function ClearTypeInverseFilter(Source: TBGRACustomBitmap): TBGRACustomBitmap;
|
|
|
|
function DoResample(Source: TBGRABitmap; newWidth, newHeight: integer;
|
|
StretchMode: TResampleMode): TBGRABitmap;
|
|
|
|
implementation
|
|
|
|
uses Math, Types, LCLProc, BGRAGradients;
|
|
|
|
function RectUnion(const rect1, Rect2: TRect): TRect;
|
|
begin
|
|
if IsRectEmpty(rect1) then
|
|
begin
|
|
if IsRectEmpty(rect2) then
|
|
Result := EmptyRect
|
|
else
|
|
Result := rect2;
|
|
end
|
|
else
|
|
begin
|
|
Result := rect1;
|
|
if not IsRectEmpty(rect2) then
|
|
UnionRect(Result, Result, rect2);
|
|
end;
|
|
end;
|
|
|
|
function RectOfs(const ARect: TRect; ofsX, ofsY: integer): TRect;
|
|
begin
|
|
Result := ARect;
|
|
OffsetRect(Result, ofsX, ofsY);
|
|
end;
|
|
|
|
function GetShapeBounds(const pts: array of TPointF; Width: single): TRect;
|
|
var
|
|
ix, iy, i: integer;
|
|
begin
|
|
Width /= 2;
|
|
Result.Left := high(integer);
|
|
Result.Top := high(integer);
|
|
Result.Right := low(integer);
|
|
Result.Bottom := low(integer);
|
|
for i := 0 to high(pts) do
|
|
begin
|
|
ix := floor(pts[i].x - Width);
|
|
iy := floor(pts[i].y - Width);
|
|
if ix < Result.left then
|
|
Result.left := ix;
|
|
if iy < Result.Top then
|
|
Result.top := iy;
|
|
ix := ceil(pts[i].x + Width) + 2;
|
|
iy := ceil(pts[i].y + Width) + 2;
|
|
if ix > Result.right then
|
|
Result.right := ix;
|
|
if iy > Result.bottom then
|
|
Result.bottom := iy;
|
|
end;
|
|
if (Result.right <= Result.left) or (Result.bottom <= Result.top) then
|
|
Result := EmptyRect;
|
|
end;
|
|
|
|
procedure DrawCheckers(bmp: TBGRABitmap);
|
|
const
|
|
tx = 8;
|
|
ty = 8;
|
|
var
|
|
xb, yb, x, y: integer;
|
|
oddColor, evenColor: TBGRAPixel;
|
|
begin
|
|
oddColor := BGRA(220, 220, 220);
|
|
evenColor := BGRA(255, 255, 255);
|
|
y := 0;
|
|
for yb := 0 to (bmp.Height - 1) div ty do
|
|
begin
|
|
x := 0;
|
|
for xb := 0 to (bmp.Width - 1) div tx do
|
|
begin
|
|
if odd(xb + yb) then
|
|
bmp.FillRect(x, y, x + tx, y + ty, oddColor, dmSet)
|
|
else
|
|
bmp.FillRect(x, y, x + tx, y + ty, evenColor, dmSet);
|
|
Inc(x, tx);
|
|
end;
|
|
Inc(y, ty);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawGrid(bmp: TBGRABitmap; sizex, sizey: single);
|
|
var
|
|
xb, yb: integer;
|
|
imgGrid: TBGRABitmap;
|
|
alpha: byte;
|
|
begin
|
|
imgGrid := TBGRABitmap.Create(bmp.Width, 1);
|
|
alpha := min(96, round((abs(sizex) + abs(sizey)) * (96 / 16 / 2)));
|
|
imgGrid.DrawLineAntialias(0, 0, imgGrid.Width - 1, 0, BGRA(255, 255, 255, alpha),
|
|
BGRA(0, 0, 0, alpha),
|
|
min(3, max(1, round(sizex / 8))), True);
|
|
for yb := 1 to trunc(bmp.Height / sizey) do
|
|
bmp.PutImage(0, round(yb * sizey), imgGrid, dmFastBlend);
|
|
imgGrid.Free;
|
|
|
|
imgGrid := TBGRABitmap.Create(1, bmp.Height);
|
|
imgGrid.DrawLineAntialias(0, 0, 0, imgGrid.Height - 1, BGRA(0, 0, 0, alpha),
|
|
BGRA(255, 255, 255, alpha),
|
|
min(3, max(1, round(sizey / 8))), True);
|
|
for xb := 1 to trunc(bmp.Width / sizex) do
|
|
bmp.PutImage(round(xb * sizex), 0, imgGrid, dmFastBlend);
|
|
imgGrid.Free;
|
|
end;
|
|
|
|
procedure RenderCloudsOn(bmp: TBGRABitmap; color: TBGRAPixel);
|
|
const
|
|
minDensity = 180;
|
|
maxDensity = 240;
|
|
var
|
|
i, k, x, y: integer;
|
|
fact, radius: single;
|
|
tempBmp: TBGRABitmap;
|
|
ptemp: PBGRAPixel;
|
|
begin
|
|
if color.alpha = 0 then
|
|
exit;
|
|
|
|
tempBmp := TBGRABitmap.Create(bmp.Width, bmp.Height, BGRABlack);
|
|
fact := (bmp.Width + bmp.Height) / 15;
|
|
for i := 120 downto 20 do
|
|
begin
|
|
for k := 1 to 2 do
|
|
begin
|
|
radius := ((i + random(50)) / 100) * fact;
|
|
x := random(bmp.Width);
|
|
y := random(bmp.Height);
|
|
tempBmp.GradientFill(floor(x - radius), floor(y - radius), ceil(
|
|
x + radius), ceil(y + radius), BGRA(255, 255, 255, 128), BGRAPixelTransparent,
|
|
gtRadial, pointf(x, y), pointf(x + radius + 0.5, y), dmFastBlend, False);
|
|
end;
|
|
end;
|
|
|
|
ptemp := tempBmp.Data;
|
|
for i := tempBmp.nbPixels - 1 downto 0 do
|
|
begin
|
|
if ptemp^.red < minDensity then
|
|
ptemp^ := BGRAPixelTransparent
|
|
else
|
|
if ptemp^.red > maxDensity then
|
|
ptemp^ := color
|
|
else
|
|
ptemp^ := BGRA(color.red, color.green, color.blue, color.alpha *
|
|
(ptemp^.red - minDensity) div (maxDensity - minDensity));
|
|
Inc(ptemp);
|
|
end;
|
|
bmp.PutImage(0, 0, tempBmp, dmDrawWithTransparency);
|
|
tempBmp.Free;
|
|
end;
|
|
|
|
procedure RenderWaterOn(bmp: TBGRABitmap; waterColor, skyColor: TBGRAPixel);
|
|
var
|
|
Noise, Temp: TBGRABitmap;
|
|
Phong: TPhongShading;
|
|
begin
|
|
Noise := CreateCyclicPerlinNoiseMap(bmp.Width, bmp.Height, 1, 1, 1.2);
|
|
Temp := Noise.FilterBlurRadial(1, rbFast) as TBGRABitmap;
|
|
Noise.Free;
|
|
Noise := Temp;
|
|
Noise.ApplyGlobalOpacity(waterColor.alpha);
|
|
waterColor.alpha := 255;
|
|
|
|
Phong := TPhongShading.Create;
|
|
Phong.NegativeDiffusionFactor := 0.1;
|
|
Phong.AmbientFactor := 0.7;
|
|
Phong.LightSourceDistanceFactor := 0;
|
|
Phong.LightDestFactor := 0;
|
|
Phong.LightSourceIntensity := 300;
|
|
Phong.LightPosition := Point(-500, -500);
|
|
Phong.LightColor := skyColor;
|
|
Phong.Draw(bmp, Noise, 30, 0, 0, waterColor);
|
|
Noise.Free;
|
|
Phong.Free;
|
|
end;
|
|
|
|
function Interp256(value1, value2, position: integer): integer; inline;
|
|
begin
|
|
Result := (value1 * (256 - position) + value2 * position) shr 8;
|
|
end;
|
|
|
|
function Interp256(color1, color2: TBGRAPixel; position: integer): TBGRAPixel; inline;
|
|
begin
|
|
Result.red := Interp256(color1.red, color2.red, position);
|
|
Result.green := Interp256(color1.green, color2.green, position);
|
|
Result.blue := Interp256(color1.blue, color2.blue, position);
|
|
Result.alpha := Interp256(color1.alpha, color2.alpha, position);
|
|
end;
|
|
|
|
function CreateWoodTexture(tx, ty: integer): TBGRABitmap;
|
|
var
|
|
colorOscillation, globalColorVariation: integer;
|
|
p: PBGRAPixel;
|
|
i: integer;
|
|
begin
|
|
Result := CreateCyclicPerlinNoiseMap(tx, ty, 1.5, 1.5, 1, rfBestQuality);
|
|
p := Result.Data;
|
|
for i := 0 to Result.NbPixels - 1 do
|
|
begin
|
|
colorOscillation := round(sqrt((sin(p^.red * Pi / 16) + 1) / 2) * 256);
|
|
globalColorVariation := p^.red;
|
|
p^ := Interp256(Interp256(BGRA(247, 188, 120), BGRA(255, 218, 170),
|
|
colorOscillation), Interp256(BGRA(157, 97, 60), BGRA(202, 145, 112),
|
|
colorOscillation), globalColorVariation);
|
|
Inc(p);
|
|
end;
|
|
end;
|
|
|
|
function CreateVerticalWoodTexture(tx, ty: integer): TBGRABitmap;
|
|
var
|
|
globalPos: single;
|
|
colorOscillation, globalColorVariation: integer;
|
|
p: PBGRAPixel;
|
|
i: integer;
|
|
x, nbVertical: integer;
|
|
begin
|
|
Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1, rfBestQuality);
|
|
p := Result.Data;
|
|
x := 0;
|
|
nbVertical := tx div 128;
|
|
if nbVertical = 0 then
|
|
nbVertical := 1;
|
|
for i := 0 to Result.NbPixels - 1 do
|
|
begin
|
|
globalPos := p^.red * Pi / 32 + nbVertical * x * 2 * Pi / tx * 8;
|
|
colorOscillation := round(sqrt((sin(globalPos) + 1) / 2) * 256);
|
|
globalColorVariation := p^.red; //round(sin(globalPos/8)*128+128);
|
|
p^ := Interp256(Interp256(BGRA(247, 188, 120), BGRA(255, 218, 170),
|
|
colorOscillation), Interp256(BGRA(157, 97, 60), BGRA(202, 145, 112),
|
|
colorOscillation), globalColorVariation);
|
|
Inc(p);
|
|
Inc(x);
|
|
if x = tx then
|
|
x := 0;
|
|
end;
|
|
end;
|
|
|
|
function ClearTypeFilter(Source: TBGRACustomBitmap): TBGRACustomBitmap;
|
|
var
|
|
mul3, temp: TBGRACustomBitmap;
|
|
xb, yb: integer;
|
|
pmul3, pdest: PBGRAPixel;
|
|
a: byte;
|
|
begin
|
|
Source.ResampleFilter := rfSpline;
|
|
mul3 := Source.Resample(Source.Width * 3 - 2, Source.Height);
|
|
temp := Source.NewBitmap(Source.Width * 3, Source.Height);
|
|
temp.PutImage(1, 0, mul3, dmSet);
|
|
for yb := 0 to temp.Height - 1 do
|
|
begin
|
|
temp.SetPixel(0, yb, temp.GetPixel(1, yb));
|
|
temp.SetPixel(temp.Width - 1, yb, temp.GetPixel(temp.Width - 2, yb));
|
|
end;
|
|
mul3.Free;
|
|
mul3 := temp;
|
|
Result := Source.NewBitmap(Source.Width, Source.Height);
|
|
for yb := 0 to Result.Height - 1 do
|
|
begin
|
|
pmul3 := mul3.ScanLine[yb];
|
|
pdest := Result.ScanLine[yb];
|
|
for xb := Result.Width - 1 downto 0 do
|
|
begin
|
|
a := (pmul3 + 1)^.alpha;
|
|
if a = 0 then
|
|
pdest^ := BGRAPixelTransparent
|
|
else
|
|
begin
|
|
pdest^.alpha := a;
|
|
if pmul3^.alpha = 0 then
|
|
pdest^.red := 128
|
|
else
|
|
pdest^.red := pmul3^.red;
|
|
pdest^.green := (pmul3 + 1)^.green;
|
|
if (pmul3 + 2)^.alpha = 0 then
|
|
pdest^.blue := 128
|
|
else
|
|
pdest^.blue := (pmul3 + 2)^.blue;
|
|
end;
|
|
Inc(pdest);
|
|
Inc(pmul3, 3);
|
|
end;
|
|
end;
|
|
mul3.Free;
|
|
end;
|
|
|
|
function ClearTypeInverseSubFilter(Source: TBGRACustomBitmap): TBGRACustomBitmap;
|
|
const
|
|
blueA = 20;
|
|
blueB = 0;
|
|
blueC = 2;
|
|
redA = 20;
|
|
redB = 0;
|
|
redC = 2;
|
|
|
|
maxV = 255;
|
|
|
|
var
|
|
yb, xb: integer;
|
|
psrc, pdest, pgray: PBGRAPixel;
|
|
a, v: integer;
|
|
grayscale, temp: TBGRACustomBitmap;
|
|
|
|
function Merge3(c1, c2, c3: TBGRAPixel): TBGRAPixel;
|
|
var
|
|
c123: cardinal;
|
|
begin
|
|
if (c1.alpha = 0) then
|
|
Result := MergeBGRA(c2, c3)
|
|
else
|
|
if (c2.alpha = 0) then
|
|
Result := MergeBGRA(c1, c3)
|
|
else
|
|
if (c3.alpha = 0) then
|
|
Result := MergeBGRA(c1, c2)
|
|
else
|
|
begin
|
|
c123 := c1.alpha + c2.alpha + c3.alpha;
|
|
Result.red := (c1.red * c1.alpha + c2.red * c2.alpha + c3.red *
|
|
c3.alpha + c123 shr 1) div c123;
|
|
Result.green := (c1.green * c1.alpha + c2.green * c2.alpha +
|
|
c3.green * c3.alpha + c123 shr 1) div c123;
|
|
Result.blue := (c1.blue * c1.alpha + c2.blue * c2.alpha +
|
|
c3.blue * c3.alpha + c123 shr 1) div c123;
|
|
Result.alpha := (c123 + 1) div 3;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if Source.Width <= 1 then
|
|
begin
|
|
Result := Source.duplicate;
|
|
exit;
|
|
end;
|
|
grayscale := Source;
|
|
temp := Source.NewBitmap(Source.Width, Source.Height);
|
|
for yb := 0 to Source.Height - 1 do
|
|
begin
|
|
psrc := Source.Scanline[yb];
|
|
pgray := grayscale.ScanLine[yb];
|
|
pdest := temp.Scanline[yb];
|
|
pdest^.red := psrc^.red;
|
|
pdest^.green := psrc^.green;
|
|
pdest^.alpha := psrc^.alpha;
|
|
a := (psrc^.alpha * blueA) - ((psrc + 1)^.alpha * (blueB));
|
|
if a > 0 then
|
|
begin
|
|
v := ((integer(psrc^.blue) * blueA) * psrc^.alpha - integer(
|
|
(psrc + 1)^.blue * blueB) * (psrc + 1)^.alpha) div a;
|
|
if v >= maxV then
|
|
pdest^.blue := 255
|
|
else
|
|
if v > 0 then
|
|
pdest^.blue := v
|
|
else
|
|
pdest^.blue := 0;
|
|
end
|
|
else
|
|
pdest^.blue := psrc^.blue;
|
|
Inc(pdest);
|
|
Inc(psrc);
|
|
Inc(pgray);
|
|
for xb := Source.Width - 3 downto 0 do
|
|
begin
|
|
pdest^.green := psrc^.green;
|
|
pdest^.alpha := psrc^.alpha;
|
|
|
|
a := (psrc^.alpha * redA) - ((psrc - 1)^.alpha * (redB));
|
|
if a > 0 then
|
|
begin
|
|
v := ((integer(psrc^.red) * redA) * psrc^.alpha - integer(
|
|
(psrc - 1)^.red * redB + ((pgray - 1)^.green - pgray^.green) * redC) *
|
|
(psrc - 1)^.alpha) div a;
|
|
if v >= maxV then
|
|
pdest^.red := 255
|
|
else
|
|
if v > 0 then
|
|
pdest^.red := v
|
|
else
|
|
pdest^.red := 0;
|
|
end
|
|
else
|
|
pdest^.red := psrc^.red;
|
|
|
|
a := (psrc^.alpha * blueA) - ((psrc + 1)^.alpha * (blueB));
|
|
if a > 0 then
|
|
begin
|
|
v := ((integer(psrc^.blue) * blueA) * psrc^.alpha - integer(
|
|
(psrc + 1)^.blue * blueB + ((pgray + 1)^.green - pgray^.green) * blueC) *
|
|
(psrc + 1)^.alpha) div a;
|
|
if v >= maxV then
|
|
pdest^.blue := 255
|
|
else
|
|
if v > 0 then
|
|
pdest^.blue := v
|
|
else
|
|
pdest^.blue := 0;
|
|
end
|
|
else
|
|
pdest^.blue := psrc^.blue;
|
|
Inc(pdest);
|
|
Inc(psrc);
|
|
Inc(pgray);
|
|
end;
|
|
pdest^.green := psrc^.green;
|
|
pdest^.blue := psrc^.blue;
|
|
pdest^.alpha := psrc^.alpha;
|
|
|
|
a := (psrc^.alpha * redA) - ((psrc - 1)^.alpha * (redB));
|
|
if a > 0 then
|
|
begin
|
|
v := ((integer(psrc^.red) * redA) * psrc^.alpha - integer(
|
|
(psrc - 1)^.red * redB) * (psrc - 1)^.alpha) div a;
|
|
if v >= maxV then
|
|
pdest^.red := 255
|
|
else
|
|
if v > 0 then
|
|
pdest^.red := v
|
|
else
|
|
pdest^.red := 0;
|
|
end
|
|
else
|
|
pdest^.red := psrc^.red;
|
|
end;
|
|
|
|
Result := temp;
|
|
end;
|
|
|
|
function ClearTypeSharpenFilter(Source, diffbmp: TBGRACustomBitmap): TBGRACustomBitmap;
|
|
const
|
|
factnum = 3;
|
|
factdenom = 5;
|
|
var
|
|
xb, yb, maxx: integer;
|
|
psrc, pdest, pdiff: PBGRAPixel;
|
|
d1, d2: integer;
|
|
|
|
function clamp(Value: integer): byte;
|
|
begin
|
|
if Value <= 0 then
|
|
Result := 0
|
|
else if Value >= 255 then
|
|
Result := 255
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
function adjustDiff(ref, v1, v2: integer): integer;
|
|
begin
|
|
v1 -= ref;
|
|
v2 -= ref;
|
|
Result := v1 + v2;
|
|
end;
|
|
|
|
begin
|
|
if diffbmp = nil then
|
|
diffbmp := Source;
|
|
if (Source.Width <= 1) or (diffbmp.Width <> Source.Width) or
|
|
(diffbmp.Height <> Source.Height) then
|
|
begin
|
|
Result := Source.Duplicate();
|
|
exit;
|
|
end;
|
|
Result := Source.NewBitmap(Source.Width, Source.Height);
|
|
for yb := 0 to Result.Height - 1 do
|
|
begin
|
|
psrc := Source.ScanLine[yb];
|
|
pdest := Result.ScanLine[yb];
|
|
pdiff := diffbmp.ScanLine[yb];
|
|
maxx := Result.Width - 1;
|
|
for xb := 0 to maxx do
|
|
begin
|
|
if psrc^.alpha <> 0 then
|
|
begin
|
|
if (xb > 0) and ((psrc - 1)^.alpha <> 0) and (xb < maxx) and
|
|
((psrc + 1)^.alpha <> 0) then
|
|
begin
|
|
d1 := BGRADiff((pdiff - 1)^, pdiff^);
|
|
d2 := BGRADiff((pdiff + 1)^, pdiff^);
|
|
if (d1 > 20) and (d2 > 20) and (d1 + d2 > 100) then
|
|
begin
|
|
pdest^.red := clamp(psrc^.red -
|
|
(adjustDiff(psrc^.red, (psrc + 1)^.red, (psrc - 1)^.red)) *
|
|
factnum div (2 * factdenom));
|
|
pdest^.green := psrc^.green;
|
|
pdest^.blue := clamp(psrc^.blue -
|
|
(adjustDiff(psrc^.blue, (psrc + 1)^.blue, (psrc - 1)^.blue)) *
|
|
factnum div (2 * factdenom));
|
|
pdest^.alpha := psrc^.alpha;
|
|
end
|
|
else
|
|
pdest^ := psrc^;
|
|
end
|
|
else
|
|
if (xb < maxx) and ((psrc + 1)^.alpha <> 0) then
|
|
begin
|
|
pdest^.red := clamp(psrc^.red - ((psrc + 1)^.red - psrc^.red) *
|
|
factnum div factdenom);
|
|
pdest^.green := psrc^.green;
|
|
pdest^.blue := clamp(psrc^.blue - ((psrc + 1)^.blue - psrc^.blue) *
|
|
factnum div factdenom);
|
|
pdest^.alpha := psrc^.alpha;
|
|
end
|
|
else
|
|
if (xb > 0) and ((psrc - 1)^.alpha <> 0) then
|
|
begin
|
|
pdest^.red := clamp(psrc^.red - ((psrc - 1)^.red - psrc^.red) *
|
|
factnum div factdenom);
|
|
pdest^.green := psrc^.green;
|
|
pdest^.blue := clamp(psrc^.blue - ((psrc - 1)^.blue - psrc^.blue) *
|
|
factnum div factdenom);
|
|
pdest^.alpha := psrc^.alpha;
|
|
end
|
|
else
|
|
pdest^ := psrc^;
|
|
end
|
|
else
|
|
pdest^ := BGRAPixelTransparent;
|
|
|
|
Inc(pdest);
|
|
Inc(psrc);
|
|
Inc(pdiff);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ClearTypeRemoveContradiction(Source: TBGRACustomBitmap): TBGRACustomBitmap;
|
|
var
|
|
xb, yb: integer;
|
|
dr, db: integer;
|
|
ratio: single;
|
|
psrc, pdest: PBGRAPixel;
|
|
|
|
begin
|
|
if Source.Width <= 1 then
|
|
begin
|
|
Result := Source.Duplicate();
|
|
exit;
|
|
end;
|
|
Result := Source.NewBitmap(Source.Width, Source.Height);
|
|
for yb := 0 to Result.Height - 1 do
|
|
begin
|
|
psrc := Source.ScanLine[yb];
|
|
pdest := Result.ScanLine[yb];
|
|
pdest^ := psrc^;
|
|
for xb := Result.Width - 2 downto 0 do
|
|
begin
|
|
(pdest +1)^ := (psrc + 1)^;
|
|
if (psrc^.alpha > 10) and ((psrc + 1)^.alpha > 10) then
|
|
begin
|
|
dr := psrc^.red - (psrc + 1)^.red;
|
|
db := psrc^.blue - (psrc + 1)^.blue;
|
|
if ((db < 0) and (dr > 0)) or ((db > 0) and (dr < 0)) then
|
|
begin
|
|
ratio := abs(dr / db);
|
|
if (ratio > 0.2) and (ratio < 5) then
|
|
begin
|
|
dr := (psrc^.red * psrc^.alpha + (psrc + 1)^.red * (psrc + 1)^.alpha) div
|
|
(psrc^.alpha + (psrc + 1)^.alpha);
|
|
db := (psrc^.blue * psrc^.alpha + (psrc + 1)^.blue * (psrc + 1)^.alpha) div
|
|
(psrc^.alpha + (psrc + 1)^.alpha);
|
|
pdest^.red := dr;
|
|
pdest^.blue := db;
|
|
(pdest +1)^.red := dr;
|
|
(pdest +1)^.blue := db;
|
|
end;
|
|
end;
|
|
end;
|
|
Inc(pdest);
|
|
Inc(psrc);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ClearTypeInverseFilter(Source: TBGRACustomBitmap): TBGRACustomBitmap;
|
|
var
|
|
mul3, temp: TBGRACustomBitmap;
|
|
xb, yb: integer;
|
|
pmul3, pdest: PBGRAPixel;
|
|
a: byte;
|
|
begin
|
|
Source.ResampleFilter := rfSpline;
|
|
mul3 := Source.Resample(Source.Width * 3 - 2, Source.Height);
|
|
temp := Source.NewBitmap(Source.Width * 3, Source.Height);
|
|
temp.PutImage(1, 0, mul3, dmSet);
|
|
for yb := 0 to temp.Height - 1 do
|
|
begin
|
|
temp.SetPixel(0, yb, temp.GetPixel(1, yb));
|
|
temp.SetPixel(temp.Width - 1, yb, temp.GetPixel(temp.Width - 2, yb));
|
|
end;
|
|
mul3.Free;
|
|
mul3 := temp;
|
|
Result := Source.NewBitmap(Source.Width, Source.Height);
|
|
for yb := 0 to Result.Height - 1 do
|
|
begin
|
|
pmul3 := mul3.ScanLine[yb];
|
|
pdest := Result.ScanLine[yb];
|
|
for xb := Result.Width - 1 downto 0 do
|
|
begin
|
|
a := (pmul3 + 1)^.alpha;
|
|
if a = 0 then
|
|
pdest^ := BGRAPixelTransparent
|
|
else
|
|
begin
|
|
pdest^.alpha := a;
|
|
if (pmul3 + 2)^.alpha = 0 then
|
|
pdest^.red := 128
|
|
else
|
|
pdest^.red := (pmul3 + 2)^.red;
|
|
pdest^.green := (pmul3 + 1)^.green;
|
|
if pmul3^.alpha = 0 then
|
|
pdest^.blue := 128
|
|
else
|
|
pdest^.blue := pmul3^.blue;
|
|
end;
|
|
Inc(pdest);
|
|
Inc(pmul3, 3);
|
|
end;
|
|
end;
|
|
mul3.Free;
|
|
|
|
temp := ClearTypeRemoveContradiction(Result);
|
|
Result.Free;
|
|
Result := temp;
|
|
|
|
temp := Result;
|
|
Result := ClearTypeSharpenFilter(temp, Source);
|
|
temp.Free;
|
|
|
|
temp := ClearTypeRemoveContradiction(Result);
|
|
Result.Free;
|
|
Result := temp;
|
|
end;
|
|
|
|
function DoResample(Source: TBGRABitmap; newWidth, newHeight: integer;
|
|
StretchMode: TResampleMode): TBGRABitmap;
|
|
begin
|
|
Result := Source.Resample(newWidth, newHeight, StretchMode) as TBGRABitmap;
|
|
end;
|
|
|
|
function CreateMarbleTexture(tx, ty: integer): TBGRABitmap;
|
|
var
|
|
colorOscillation: integer;
|
|
p: PBGRAPixel;
|
|
i: integer;
|
|
begin
|
|
Result := CreateCyclicPerlinNoiseMap(tx, ty, 0.5, 0.5, 0.8, rfBestQuality);
|
|
p := Result.Data;
|
|
for i := 0 to Result.NbPixels - 1 do
|
|
begin
|
|
colorOscillation := round(sqrt(sqrt((sin(p^.red * Pi / 128 + 0.5) + 1) / 2)) * 256);
|
|
p^ := Interp256(BGRA(161, 117, 105), BGRA(218, 197, 180), colorOscillation);
|
|
Inc(p);
|
|
end;
|
|
end;
|
|
|
|
function CreateWaterTexture(tx, ty: integer): TBGRABitmap;
|
|
const
|
|
blurSize = 5;
|
|
var
|
|
temp: TBGRABitmap;
|
|
phong: TPhongShading;
|
|
begin
|
|
Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1.2, rfBestQuality);
|
|
temp := Result.GetPart(rect(-blurSize, -blurSize, tx + blurSize, ty + blurSize)) as
|
|
TBGRABitmap;
|
|
BGRAReplace(temp, temp.FilterBlurRadial(blurSize, rbFast));
|
|
phong := TPhongShading.Create;
|
|
phong.LightSourceDistanceFactor := 0;
|
|
phong.LightDestFactor := 0;
|
|
phong.LightSourceIntensity := 150;
|
|
phong.LightPositionZ := 80;
|
|
phong.LightColor := BGRA(105, 233, 240);
|
|
phong.NegativeDiffusionFactor := 0.3;
|
|
phong.SpecularIndex := 20;
|
|
phong.AmbientFactor := 0.4;
|
|
phong.Draw(Result, temp, 20, -blurSize, -blurSize, BGRA(28, 139, 166));
|
|
phong.Free;
|
|
temp.Free;
|
|
end;
|
|
|
|
function CreateStoneTexture(tx, ty: integer): TBGRABitmap;
|
|
var
|
|
temp: TBGRABitmap;
|
|
phong: TPhongShading;
|
|
begin
|
|
Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 0.6);
|
|
temp := Result.GetPart(rect(-2, -2, tx + 2, ty + 2)) as TBGRABitmap;
|
|
phong := TPhongShading.Create;
|
|
phong.LightSourceDistanceFactor := 0;
|
|
phong.LightDestFactor := 0;
|
|
phong.LightSourceIntensity := 100;
|
|
phong.LightPositionZ := 100;
|
|
phong.NegativeDiffusionFactor := 0.3;
|
|
phong.AmbientFactor := 0.5;
|
|
phong.Draw(Result, temp, 30, -2, -2, BGRA(170, 170, 170));
|
|
phong.Free;
|
|
temp.Free;
|
|
end;
|
|
|
|
function CreateRoundStoneTexture(tx, ty: integer): TBGRABitmap;
|
|
var
|
|
temp: TBGRABitmap;
|
|
phong: TPhongShading;
|
|
begin
|
|
Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1.2, rfBestQuality);
|
|
temp := Result.GetPart(rect(-2, -2, tx + 2, ty + 2)) as TBGRABitmap;
|
|
BGRAReplace(temp, temp.FilterBlurRadial(2, rbFast));
|
|
phong := TPhongShading.Create;
|
|
phong.LightSourceDistanceFactor := 0;
|
|
phong.LightDestFactor := 0;
|
|
phong.LightSourceIntensity := 70;
|
|
phong.LightPositionZ := 100;
|
|
phong.NegativeDiffusionFactor := 0;
|
|
phong.SpecularIndex := 10;
|
|
phong.AmbientFactor := 0.5;
|
|
phong.LightColor := BGRA(255, 255, 192);
|
|
phong.Draw(Result, temp, 30, -2, -2, BGRA(170, 170, 170));
|
|
phong.Free;
|
|
temp.Free;
|
|
end;
|
|
|
|
function CreateSnowPrintTexture(tx, ty: integer): TBGRABitmap;
|
|
var
|
|
v: single;
|
|
p: PBGRAPixel;
|
|
i: integer;
|
|
|
|
temp: TBGRABitmap;
|
|
phong: TPhongShading;
|
|
begin
|
|
Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1.2, rfBestQuality);
|
|
|
|
p := Result.Data;
|
|
for i := 0 to Result.NbPixels - 1 do
|
|
begin
|
|
v := p^.red;
|
|
if v > 80 then
|
|
v := (v - 80) / 10 + 80;
|
|
if v < 50 then
|
|
v := 50 - (50 - v) / 10;
|
|
p^ := MapHeightToBGRA(v / 255, 255);
|
|
Inc(p);
|
|
end;
|
|
|
|
temp := Result.GetPart(rect(-2, -2, tx + 2, ty + 2)) as TBGRABitmap;
|
|
phong := TPhongShading.Create;
|
|
phong.LightSourceDistanceFactor := 0;
|
|
phong.LightDestFactor := 0;
|
|
phong.LightSourceIntensity := 100;
|
|
phong.LightPositionZ := 100;
|
|
phong.NegativeDiffusionFactor := 0.3;
|
|
phong.Draw(Result, temp, 30, -2, -2, BGRAWhite);
|
|
phong.Free;
|
|
temp.Free;
|
|
end;
|
|
|
|
function CreateCamouflageTexture(tx, ty: integer): TBGRABitmap;
|
|
var
|
|
v: integer;
|
|
p: PBGRAPixel;
|
|
i: integer;
|
|
|
|
temp: TBGRABitmap;
|
|
begin
|
|
Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1, rfBestQuality);
|
|
|
|
p := Result.Data;
|
|
for i := 0 to Result.NbPixels - 1 do
|
|
begin
|
|
v := p^.red;
|
|
if v < 64 then
|
|
p^ := BGRA(31, 33, 46)
|
|
else
|
|
if v < 128 then
|
|
p^ := BGRA(89, 71, 57)
|
|
else
|
|
if v < 192 then
|
|
p^ := BGRA(80, 106, 67)
|
|
else
|
|
p^ := BGRA(161, 157, 121);
|
|
Inc(p);
|
|
end;
|
|
|
|
temp := Result.getPart(rect(-2, -2, tx + 2, ty + 2)) as TBGRABitmap;
|
|
BGRAReplace(temp, temp.FilterMedian(moMediumSmooth));
|
|
Result.PutImage(-2, -2, temp, dmSet);
|
|
temp.Free;
|
|
end;
|
|
|
|
function CreatePlastikTexture(tx, ty: integer): TBGRABitmap;
|
|
const
|
|
blurSize = 2;
|
|
var
|
|
temp: TBGRABitmap;
|
|
phong: TPhongShading;
|
|
p: PBGRAPixel;
|
|
i: integer;
|
|
v: byte;
|
|
begin
|
|
Result := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1);
|
|
|
|
p := Result.Data;
|
|
for i := 0 to Result.NbPixels - 1 do
|
|
begin
|
|
v := p^.red;
|
|
if v < 32 then
|
|
v := v * 2
|
|
else
|
|
if (v > 32) and (v < 224) then
|
|
v := (v - 32) div 2 + 64
|
|
else
|
|
if v >= 224 then
|
|
v := (v - 224) * 2 + (224 - 32) div 2;
|
|
p^ := BGRA(v, v, v);
|
|
Inc(p);
|
|
end;
|
|
|
|
temp := Result.GetPart(rect(-blurSize, -blurSize, tx + blurSize, ty + blurSize)) as
|
|
TBGRABitmap;
|
|
BGRAReplace(temp, temp.FilterNormalize(False));
|
|
BGRAReplace(temp, temp.FilterBlurMotion(ty div 6, 90, False));
|
|
BGRAReplace(temp, temp.FilterBlurRadial(blurSize, rbFast));
|
|
|
|
phong := TPhongShading.Create;
|
|
phong.LightSourceDistanceFactor := 0;
|
|
phong.LightDestFactor := 0;
|
|
phong.LightSourceIntensity := 300;
|
|
phong.LightPositionZ := 10;
|
|
phong.NegativeDiffusionFactor := 0;
|
|
phong.AmbientFactor := 0.6;
|
|
phong.SpecularIndex := 25;
|
|
phong.SpecularFactor := 10;
|
|
phong.Draw(Result, temp, 10, -blurSize, -blurSize, BGRA(58, 206, 113));
|
|
phong.Free;
|
|
temp.Free;
|
|
end;
|
|
|
|
function CreateMetalFloorTexture(tx: integer): TBGRABitmap;
|
|
var
|
|
temp, noise: TBGRABitmap;
|
|
phong: TPhongShading;
|
|
ty: integer;
|
|
begin
|
|
ty := tx div 2;
|
|
Result := TBGRABitmap.Create(tx, ty, BGRABlack);
|
|
Result.FillEllipseAntialias(tx * 1.2 / 8, ty / 2, tx / 20, ty / 3,
|
|
BGRA(240, 240, 240));
|
|
Result.FillEllipseAntialias(tx * 2.8 / 8, ty / 2, tx / 20, ty / 3,
|
|
BGRA(240, 240, 240));
|
|
Result.FillEllipseAntialias(tx * 3 / 4, ty * 1.2 / 4, ty / 3, tx /
|
|
20, BGRA(240, 240, 240));
|
|
Result.FillEllipseAntialias(tx * 3 / 4, ty * 2.8 / 4, ty / 3, tx /
|
|
20, BGRA(240, 240, 240));
|
|
BGRAReplace(Result, Result.FilterBlurRadial(1, rbFast));
|
|
|
|
noise := CreateCyclicPerlinNoiseMap(tx, ty, 1, 1, 1);
|
|
noise.FillRect(0, 0, tx, ty, BGRA(0, 0, 0, 220), dmLinearBlend);
|
|
Result.BlendImage(0, 0, noise, boAdditive);
|
|
noise.Free;
|
|
|
|
temp := Result.GetPart(rect(-2, -2, tx + 2, ty + 2)) as TBGRABitmap;
|
|
phong := TPhongShading.Create;
|
|
phong.LightSourceDistanceFactor := 0;
|
|
phong.LightDestFactor := 0;
|
|
phong.LightSourceIntensity := 100;
|
|
phong.LightPositionZ := 80;
|
|
phong.NegativeDiffusionFactor := 0;
|
|
phong.AmbientFactor := 0.5;
|
|
phong.Draw(Result, temp, 10, -2, -2, BGRA(116, 116, 116));
|
|
phong.Free;
|
|
temp.Free;
|
|
end;
|
|
|
|
function ComputeAngle(dx, dy: single): single;
|
|
begin
|
|
if dy = 0 then
|
|
begin
|
|
if dx < 0 then
|
|
Result := 180
|
|
else
|
|
Result := 0;
|
|
end
|
|
else
|
|
if dx = 0 then
|
|
begin
|
|
if dy < 0 then
|
|
Result := -90
|
|
else
|
|
Result := 90;
|
|
end
|
|
else
|
|
begin
|
|
Result := ArcTan(dy / dx) * 180 / Pi;
|
|
if dx < 0 then
|
|
Result += 180;
|
|
end;
|
|
end;
|
|
|
|
function GetSelectionCenter(bmp: TBGRABitmap): TPointF;
|
|
var
|
|
xb, yb: integer;
|
|
p: PBGRAPixel;
|
|
xsum, ysum, asum, alpha: single;
|
|
begin
|
|
xsum := 0;
|
|
ysum := 0;
|
|
asum := 0;
|
|
for yb := 0 to bmp.Height - 1 do
|
|
begin
|
|
p := bmp.ScanLine[yb];
|
|
for xb := 0 to bmp.Width - 1 do
|
|
begin
|
|
alpha := p^.red / 255;
|
|
Inc(p);
|
|
xsum += xb * alpha;
|
|
ysum += yb * alpha;
|
|
asum += alpha;
|
|
end;
|
|
end;
|
|
if asum = 0 then
|
|
Result := pointF(bmp.Width / 2 - 0.5, bmp.Height / 2 - 0.5)
|
|
else
|
|
Result := pointF(xsum / asum, ysum / asum);
|
|
end;
|
|
|
|
procedure ComputeSelectionMask(image: TBGRABitmap; destMask: TBGRABitmap);
|
|
var
|
|
maxx, maxy: integer;
|
|
aimage: byte;
|
|
xb, yb: integer;
|
|
pimage, pmask: PBGRAPixel;
|
|
begin
|
|
maxx := min(image.Width, destMask.Width) - 1;
|
|
maxy := min(image.Height, destMask.Height) - 1;
|
|
for yb := 0 to maxy do
|
|
begin
|
|
pimage := image.ScanLine[yb];
|
|
pmask := destMask.ScanLine[yb];
|
|
for xb := 0 to maxx do
|
|
begin
|
|
aimage := pimage^.alpha;
|
|
pmask^ := BGRA(aimage, aimage, aimage, 255);
|
|
if aimage <> 0 then
|
|
pimage^.alpha := 255;
|
|
Inc(pimage);
|
|
Inc(pmask);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SubstractMask(image: TBGRABitmap; mask: TBGRABitmap);
|
|
var
|
|
maxx, maxy: integer;
|
|
xb, yb: integer;
|
|
pimage, pmask: PBGRAPixel;
|
|
aimage, amask: byte;
|
|
begin
|
|
maxx := min(image.Width, Mask.Width) - 1;
|
|
maxy := min(image.Height, Mask.Height) - 1;
|
|
for yb := 0 to maxy do
|
|
begin
|
|
pimage := image.ScanLine[yb];
|
|
pmask := Mask.ScanLine[yb];
|
|
for xb := 0 to maxx do
|
|
begin
|
|
amask := pmask^.red;
|
|
if amask <> 0 then
|
|
begin
|
|
aimage := pimage^.alpha;
|
|
if aimage > amask then
|
|
pimage^.alpha := aimage - amask
|
|
else
|
|
pimage^ := BGRAPixelTransparent;
|
|
end;
|
|
Inc(pimage);
|
|
Inc(pmask);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure NicePoint(bmp: TBGRABitmap; x, y: single);
|
|
begin
|
|
bmp.EllipseAntialias(x, y, 4, 4, BGRA(0, 0, 0, 192), 1);
|
|
bmp.EllipseAntialias(x, y, 3, 3, BGRA(255, 255, 255, 192), 1);
|
|
bmp.EllipseAntialias(x, y, 2, 2, BGRA(0, 0, 0, 192), 1);
|
|
end;
|
|
|
|
procedure NicePoint(bmp: TBGRABitmap; ptF: TPointF);
|
|
begin
|
|
NicePoint(bmp, ptF.x, ptF.y);
|
|
end;
|
|
|
|
procedure NiceLine(bmp: TBGRABitmap; x1, y1, x2, y2: single);
|
|
begin
|
|
bmp.DrawLineAntialias(round(x1), round(y1), round(x2),
|
|
round(y2), BGRA(0, 0, 0, 192), 3, True);
|
|
bmp.DrawLineAntialias(round(x1), round(y1), round(x2),
|
|
round(y2), BGRA(255, 255, 255, 192), 1, True);
|
|
end;
|
|
|
|
function ComputeColorCircle(tx, ty: integer; light: word;
|
|
hueCorrection: boolean = True): TBGRABitmap;
|
|
var
|
|
xb, yb: integer;
|
|
pdest: PBGRAPixel;
|
|
angle, xc, yc: single;
|
|
ec: TExpandedPixel;
|
|
c: TBGRAPixel;
|
|
gray, level: word;
|
|
begin
|
|
Result := TBGRABitmap.Create(tx, ty);
|
|
Result.FillEllipseAntialias(tx / 2 - 0.5, ty / 2 - 0.5, tx / 2, ty / 2, BGRABlack);
|
|
xc := tx / 2 - 0.5;
|
|
yc := ty / 2 - 0.5;
|
|
for yb := 0 to ty - 1 do
|
|
begin
|
|
pdest := Result.scanline[yb];
|
|
for xb := 0 to tx - 1 do
|
|
begin
|
|
if pdest^.alpha <> 0 then
|
|
begin
|
|
ec.alpha := $FFFF;
|
|
angle := ComputeAngle(xb - xc, yb - yc);
|
|
if angle < 0 then
|
|
angle += 360;
|
|
if hueCorrection then
|
|
angle := GtoH(round(angle / 360 * 65536) and 65535) / 65536 * 360;
|
|
if angle < 60 then
|
|
begin
|
|
ec.red := $FFFF;
|
|
ec.green := round(angle / 60 * $FFFF);
|
|
ec.blue := $0000;
|
|
end
|
|
else
|
|
if angle < 120 then
|
|
begin
|
|
ec.red := $FFFF - round((angle - 60) / 60 * $FFFF);
|
|
ec.green := $FFFF;
|
|
ec.blue := $0000;
|
|
end
|
|
else
|
|
if angle < 180 then
|
|
begin
|
|
ec.red := $0000;
|
|
ec.green := $FFFF;
|
|
ec.blue := round((angle - 120) / 60 * $FFFF);
|
|
end
|
|
else
|
|
if angle < 240 then
|
|
begin
|
|
ec.red := $0000;
|
|
ec.green := $FFFFF - round((angle - 180) / 60 * $FFFF);
|
|
ec.blue := $FFFF;
|
|
end
|
|
else
|
|
if angle < 300 then
|
|
begin
|
|
ec.red := round((angle - 240) / 60 * $FFFF);
|
|
ec.green := $0000;
|
|
ec.blue := $FFFF;
|
|
end
|
|
else
|
|
begin
|
|
ec.red := $FFFF;
|
|
ec.green := $0000;
|
|
ec.blue := $FFFFF - round((angle - 300) / 60 * $FFFF);
|
|
end;
|
|
gray := min($FFFF, max(0, $FFFF - round(
|
|
(sqrt(sqr((xb - xc) / (tx / 2)) + sqr((yb - yc) / (ty / 2))) *
|
|
1.2 - 0.1) * $FFFF)));
|
|
level := max(max(ec.red, ec.green), ec.blue);
|
|
{$hints off}
|
|
ec.red := (ec.red * ($FFFF - gray) + level * gray) shr 16;
|
|
ec.green := (ec.green * ($FFFF - gray) + level * gray) shr 16;
|
|
ec.blue := (ec.blue * ($FFFF - gray) + level * gray) shr 16;
|
|
{$hints on}
|
|
ec.red := (ec.red * light) shr 16;
|
|
ec.green := (ec.green * light) shr 16;
|
|
ec.blue := (ec.blue * light) shr 16;
|
|
c := GammaCompression(ec);
|
|
c.alpha := pdest^.alpha;
|
|
pdest^ := c;
|
|
end;
|
|
Inc(pdest);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ChangeCanvasSize(bmp: TBGRABitmap; newWidth, newHeight: integer;
|
|
anchor: string; background: TBGRAPixel; repeatImage: boolean;
|
|
flipMode: boolean = False): TBGRABitmap;
|
|
var
|
|
origin: TPoint;
|
|
xb, yb: integer;
|
|
dx, dy: integer;
|
|
minx, miny, maxx, maxy: integer;
|
|
flippedImages: array[boolean, boolean] of TBGRABitmap;
|
|
begin
|
|
if (newWidth < 1) or (newHeight < 1) then
|
|
raise Exception.Create('Invalid canvas size');
|
|
origin := Point((newWidth - bmp.Width) div 2, (newHeight - bmp.Height) div 2);
|
|
anchor := LowerCase(anchor);
|
|
if (anchor = 'topleft') or (anchor = 'top') or (anchor = 'topright') then
|
|
origin.Y := 0;
|
|
if (anchor = 'bottomleft') or (anchor = 'bottom') or (anchor = 'bottomright') then
|
|
origin.Y := newHeight - bmp.Height;
|
|
if (anchor = 'topleft') or (anchor = 'left') or (anchor = 'bottomleft') then
|
|
origin.X := 0;
|
|
if (anchor = 'topright') or (anchor = 'right') or (anchor = 'bottomright') then
|
|
origin.X := newWidth - bmp.Width;
|
|
Result := TBGRABitmap.Create(newWidth, newHeight, background);
|
|
dx := bmp.Width;
|
|
dy := bmp.Height;
|
|
if repeatImage then
|
|
begin
|
|
minx := (0 - origin.X - bmp.Width + 1) div bmp.Width;
|
|
miny := (0 - origin.Y - bmp.Width + 1) div bmp.Width;
|
|
maxx := (newWidth - origin.X + bmp.Width - 1) div bmp.Width;
|
|
maxy := (newHeight - origin.Y + bmp.Width - 1) div bmp.Width;
|
|
end
|
|
else
|
|
begin
|
|
minx := 0;
|
|
miny := 0;
|
|
maxx := 0;
|
|
maxy := 0;
|
|
end;
|
|
if flipMode and repeatImage then
|
|
begin
|
|
flippedImages[False, False] := bmp;
|
|
if (minx <> 0) or (miny <> 0) or (maxx <> 0) or (maxy <> 0) then
|
|
begin
|
|
flippedImages[True, False] := bmp.Duplicate as TBGRABitmap;
|
|
flippedImages[True, False].HorizontalFlip;
|
|
flippedImages[True, True] := flippedImages[True, False].Duplicate as TBGRABitmap;
|
|
flippedImages[True, True].VerticalFlip;
|
|
flippedImages[False, True] := bmp.Duplicate as TBGRABitmap;
|
|
flippedImages[False, True].VerticalFlip;
|
|
end
|
|
else
|
|
begin
|
|
flippedImages[True, False] := nil; //never used
|
|
flippedImages[True, True] := nil;
|
|
flippedImages[False, True] := nil;
|
|
end;
|
|
for xb := minx to maxx do
|
|
for yb := miny to maxy do
|
|
Result.PutImage(origin.x + xb * dx, origin.Y + yb * dy,
|
|
flippedImages[odd(xb), odd(yb)], dmSet);
|
|
flippedImages[True, False].Free;
|
|
flippedImages[True, True].Free;
|
|
flippedImages[False, True].Free;
|
|
end
|
|
else
|
|
begin
|
|
for xb := minx to maxx do
|
|
for yb := miny to maxy do
|
|
Result.PutImage(origin.x + xb * dx, origin.Y + yb * dy, bmp, dmSet);
|
|
end;
|
|
end;
|
|
|
|
function MakeThumbnail(bmp: TBGRABitmap; Width, Height: integer): TBGRABitmap;
|
|
var
|
|
resampled: TBGRABitmap;
|
|
begin
|
|
Result := TBGRABitmap.Create(Width, Height);
|
|
if (Width <> 0) and (Height <> 0) and (bmp.Width <> 0) and (bmp.Height <> 0) then
|
|
begin
|
|
if bmp.Width / bmp.Height > Width / Height then
|
|
resampled := bmp.Resample(Width,
|
|
max(1, round(bmp.Height * (Width / bmp.Width)))) as TBGRABitmap
|
|
|
|
else
|
|
resampled := bmp.Resample(max(1, round(bmp.Width * (Height / bmp.Height))),
|
|
Height) as TBGRABitmap;
|
|
Result.PutImage((Result.Width - resampled.Width) div 2,
|
|
(Result.Height - resampled.Height) div 2, resampled, dmSet);
|
|
resampled.Free;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
|
|
Randomize;
|
|
|
|
end.
|