BGRABitmap图像操作8：轴向的木质纹理

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;

function CreateVerticalWoodTexture(tx,ty: integer): TBGRABitmap;
var
  globalPos: single;
  colorOscillation, globalColorVariation: integer;
  p: PBGRAPixel;
  i: Integer;
  x: integer;
begin
  result := CreateCyclicPerlinNoiseMap(tx,ty);
  p := result.Data;
  x := 0;
  for i := 0 to result.NbPixels-1 do
  begin
    globalPos := p^.red*Pi/32+x*2*Pi/tx*8;
    colorOscillation := round(sqrt((sin(globalPos)+1)/2)*256);
    globalColorVariation := 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;

procedure TForm1.FormPaint(Sender: TObject);
var
  image,tex: TBGRABitmap;

begin
    image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));

    tex := CreateVerticalWoodTexture(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.