BGRABitmap图像操作9e：用阈值制作雪上印迹纹理

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
{ private declarations }
phong: TPhongShading;
chocolate: TBGRABitmap;
public
{ public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

function CreateSnowPrintTexture(tx,ty: integer): TBGRABitmap;
var
v: integer;
p: PBGRAPixel;
i: Integer;

temp: TBGRABitmap;
phong: TPhongShading;
begin
//here a random map is generated
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);

//now we apply thresholds
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
v := p^.red;
//if the value is above 80 or under 50, then we divide it by 10 to make it almost horizontal
if v > 80 then v := (v-80) div 10+80;
if v < 50 then v := 50-(50-v) div 10;
p^.red := v;
p^.green := v;
p^.blue := v;
inc(p);
end;

//to make phong shader aware of the cycle
temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;
//apply a radial blur
BGRAReplace(temp,temp.FilterBlurRadial(2,rbFast));
phong := TPhongShading.Create;
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 100;
phong.LightPositionZ := 100;
phong.NegativeDiffusionFactor := 0.3; //want shadows
phong.Draw(result,temp,30,-2,-2,BGRAWhite);
phong.Free;
temp.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
phong := TPhongShading.Create;
phong.LightPositionZ := 150;
phong.SpecularIndex := 20;
phong.AmbientFactor := 0.4;
phong.LightSourceIntensity := 250;
phong.LightSourceDistanceTerm := 200;

//chocolate := CreateChocolateTexture(80,80);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
phong.Free;
chocolate.Free;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
phong.LightPosition := point(X,Y);
FormPaint(Sender);
end;

procedure TForm1.FormPaint(Sender: TObject);
var
image: TBGRABitmap;
stone: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));

stone := CreateSnowPrintTexture(100,100);
image.FillEllipseAntialias(100,100,250,150,stone);
stone.free;

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

end.