BGRABitmap图像操作8:大理石纹理

来源:互联网 发布:oauth2.0 java 编辑:程序博客网 时间:2024/04/30 12:42





unit Unit1;{$mode objfpc}{$H+}interfaceuses  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,  BGRABitmap, BGRABitmapTypes, BGRAGradients, math;type  { TForm1 }  TForm1 = class(TForm)    procedure FormPaint(Sender: TObject);  private    { private declarations }  public    { public declarations }  end;var  Form1: TForm1;implementation{$R *.lfm}{ TForm1 }function Interp256(value1,value2,position: integer): integer; inline;begin     result := (value1*(256-position) + value2*position) shr 8;end;function Interp256(color1,color2: TBGRAPixel; position: integer): TBGRAPixel; inline;begin     result.red := Interp256(color1.red,color2.red, position);     result.green := Interp256(color1.green,color2.green, position);     result.blue := Interp256(color1.blue,color2.blue, position);     result.alpha := Interp256(color1.alpha,color2.alpha, position);end;function CreateCustomTexture(tx,ty: integer): TBGRABitmap;var  colorOscillation: integer;  p: PBGRAPixel;  i: Integer;begin  result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1);  p := result.Data;  for i := 0 to result.NbPixels-1 do  begin    //colorOscillation := round(((sin(p^.red*Pi/32)+1)/2)*256);    colorOscillation := round(power((sin(p^.red*Pi/80)+1)/2,0.2)*256);    p^ := Interp256(BGRA(181,157,105),BGRA(228,227,180),colorOscillation);    inc(p);  end;end;procedure TForm1.FormPaint(Sender: TObject);var  image,tex: TBGRABitmap;begin    image := TBGRABitmap.Create(ClientWidth,ClientHeight,ColorToBGRA(ColorToRGB(clBtnFace)));    tex := CreateCustomTexture(100,100);    image.FillRoundRectAntialias(20,20,300,200,20,20,tex);    image.RoundRectAntialias(20,20,300,200,20,20,BGRABlack,1);    tex.free;    image.Draw(Canvas,0,0,True);    image.free;end;end.


0 0