unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
BGRABitmap, BGRABitmapTypes, BGRAGradients, math;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
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);
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;
procedure TForm1.FormPaint(Sender: TObject);
var
image,tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
tex := CreateWoodTexture(100,100);
image.FillRoundRectAntialias(20,20,300,200,20,20,tex);
image.RoundRectAntialias(20,20,300,200,20,20,BGRABlack,1);
tex.free;
image.Draw(Canvas,0,0,True);
image.free;
end;
end.