这个球上的光点会跟随鼠标转动。
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 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;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));
image.FillRect(0,0,80*7,80*4,chocolate,dmSet);
phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));
image.Draw(Canvas,0,0,True);
image.free;
end;
end.