BGRABitmap图像操作9c:同时使用莫林杂点和 phong 阴影制作纹理

来源:互联网 发布:js.type 编辑:程序博客网 时间:2024/05/17 08:54




    纹理随鼠标不停变化,有点像水面。



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 CreateStoneTexture(tx,ty: integer): TBGRABitmap;const blurSize = 5;var  temp: TBGRABitmap;  phong: TPhongShading;begin  result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);  temp:= result.GetPart(rect(-blurSize,-blurSize,tx+blurSize,ty+blurSize)) as TBGRABitmap;  BGRAReplace(temp,temp.FilterBlurRadial(blurSize,rbFast));  phong := TPhongShading.Create;  phong.LightSourceDistanceFactor := 0;  phong.LightDestFactor := 0;  phong.LightSourceIntensity := 150;  phong.LightPositionZ := 80;  phong.LightColor := BGRA(105,233,240);  phong.NegativeDiffusionFactor := 0.3;  phong.SpecularIndex := 20;  phong.AmbientFactor := 0.4;  phong.Draw(result,temp,20,-blurSize,-blurSize,BGRA(28,139,166));  phong.Free;  temp.Free;end;function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;var  square,map: TBGRABitmap;  phong: TPhongShading;  margin: integer;begin  margin := tx div 20; //empty space around the square  square := CreateRectangleMap(tx-2*margin,ty-2*margin,tx div 8);  //create a map with the square at the middle  map := TBGRABitmap.Create(tx,ty,BGRABlack);  map.PutImage(margin,margin,square,dmDrawWithTransparency);  //apply blur to make it smoother  BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));  square.free;  //create resulting bitmap  result := TBGRABitmap.Create(tx,ty);  //use phong shading  phong := TPhongShading.Create;  phong.LightSourceDistanceFactor := 0;  phong.LightDestFactor := 0;  phong.LightSourceIntensity := 200;  phong.AmbientFactor := 0.5;  phong.LightPosition := Point(-50,-100);  phong.LightPositionZ := 80;  //draw the piece of chocolate with max altitude 20  phong.Draw(result,map,20,0,0,BGRA(86,41,38));  map.Free;  phong.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 := CreateStoneTexture(100,100);    image.FillEllipseAntialias(100,100,250,150,stone);    stone.free;    image.Draw(Canvas,0,0,True);    image.free;end;end.




0 0