BGRABitmap图像操作8：另一个阈值控制方式，生成迷彩纹理

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
BGRABitmap, BGRABitmapTypes, BGRAGradients;

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;

procedure TForm1.FormPaint(Sender: TObject);
var
image,tex: TBGRABitmap;
p: PBGRAPixel;
i: Integer;
v: Byte;

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

tex := CreateCyclicPerlinNoiseMap(100,100);

p := tex.Data;
for i := 0 to tex.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;

image.FillRect(0,0,image.Width,image.Height, tex, dmSet);
tex.free;

image.Draw(Canvas,0,0,True);
image.free;

end;

end.