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.