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

unit Unit1;{$mode objfpc}{$H+}interfaceuses  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.