lasarus_compotents/bgrabitmap/test/bgraaggtest/blur_main.pas

unit blur_main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  ExtCtrls, StdCtrls, BGRABitmap, BGRABitmapTypes, EpikTimer, LMessages,
  BGRAGrayscaleMask;

type

  { TForm1 }

  TForm1 = class(TForm)
    Label_RadiusValueY: TLabel;
    Label_RadiusX: TLabel;
    Label2: TLabel;
    Label_RadiusY: TLabel;
    Label_RadiusValueX: TLabel;
    Panel1: TPanel;
    Radio_Box: TRadioButton;
    Radio_Motion: TRadioButton;
    Radio_Fast: TRadioButton;
    Radio_Corona: TRadioButton;
    Radio_Disk: TRadioButton;
    Radio_OrientedMotion: TRadioButton;
    Radio_Radial: TRadioButton;
    TrackBar_BlurRadiusX: TTrackBar;
    TrackBar_BlurRadiusY: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      {%H-}Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure Radio_Change(Sender: TObject);
    procedure TrackBar_BlurRadiusChange(Sender: TObject);
    procedure WMEraseBkgnd(var {%H-}Message: TLMEraseBkgnd); message LM_ERASEBKGND;
  private
    { private declarations }
    procedure UpdateLabelRadius;
  public
    { public declarations }
    image: TBGRABitmap;
    shadowBase: TGrayscaleMask;
    timer : TEpikTimer;
    movingShadow: boolean;
    movingOrigin,shadowOfs: TPoint;
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

function ComputeAngle(dx, dy: single): single;
begin
     if dy = 0 then
     begin
       if dx < 0 then result := 180 else result := 0;
     end else
     if dx = 0 then
     begin
       if dy < 0 then result := -90 else result := 90;
     end else
     begin
       result := ArcTan(dy/dx)*180/Pi;
       if dx < 0 then result += 180;
     end;
end;

{ TForm1 }

procedure TForm1.FormPaint(Sender: TObject);
var bmp: TBGRABitmap;
    ombre: TGrayscaleMask;
    x,y,tx,ty: integer;
    blurType: TRadialBlurType;
    radiusX,radiusY,len: single;
begin
  tx := clientWidth;
  ty := Panel1.Top;
  bmp := TBGRABitmap.Create(tx,ty,BGRAWhite);
  x := (tx-image.Width) div 2;
  y := (ty-image.Height) div 2;

  radiusX := TrackBar_BlurRadiusX.Position/10;
  radiusY := TrackBar_BlurRadiusY.Position/10;

  timer.Clear;
  timer.Start;
  if Radio_Motion.Checked or Radio_OrientedMotion.Checked then
  begin
    len := sqrt(sqr(radiusX)+sqr(radiusY));
    ombre := shadowBase.FilterBlurMotion(len*2,ComputeAngle(radiusX,radiusY),Radio_OrientedMotion.Checked) as TGrayscaleMask;
  end else
  begin
    if Radio_Box.Checked then
    begin
      blurType := rbBox;
      ombre := shadowBase.FilterBlurRadial(radiusX,radiusY,blurType) as TGrayscaleMask;
    end else
    begin
      if Radio_Fast.Checked then blurType := rbFast else
      if Radio_Corona.Checked then blurType := rbCorona else
      if Radio_Disk.Checked then blurType := rbDisk else
      if Radio_Radial.Checked then blurType := rbNormal;
      ombre := shadowBase.FilterBlurRadial(radiusX,radiusY,blurType) as TGrayscaleMask;
    end;
  end;
  timer.Stop;
  ombre.Rectangle(0,0,ombre.width,ombre.height,TByteMask.New(128));
  bmp.FillMask(x+shadowOfs.x,y+shadowOfs.y,ombre,BGRA(64,128,64), dmDrawWithTransparency);
  ombre.free;

  bmp.PutImage(x,y,image,dmDrawWithTransparency);
  bmp.TextOut(0,0,inttostr(round(timer.Elapsed*1000))+' ms',BGRABlack);
  bmp.Draw(Canvas,0,0);
  bmp.Free;
end;

procedure TForm1.Radio_Change(Sender: TObject);
begin
  Invalidate;
end;

procedure TForm1.TrackBar_BlurRadiusChange(Sender: TObject);
begin
  UpdateLabelRadius;
  Repaint;
end;

procedure TForm1.WMEraseBkgnd(var Message: TLMEraseBkgnd);
begin
  //
end;

procedure TForm1.UpdateLabelRadius;
begin
  Label_RadiusValueX.Caption := '= '+FloatToStrF(TrackBar_BlurRadiusX.Position/10,ffFixed,7,1);
  Label_RadiusValueY.Caption := '= '+FloatToStrF(TrackBar_BlurRadiusY.Position/10,ffFixed,7,1);
  Label_RadiusValueX.Update;
  Label_RadiusValueY.Update;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  image := TBGRABitmap.Create(160,200);
  image.FontName := 'Times New Roman';
  image.FontHeight := 300;
  image.FontAntialias:= true;
  image.TextOut(image.Width div 2,-100,'a',BGRA(128,192,128,255),taCenter);
  shadowBase := TGrayscaleMask.Create(image, cAlpha);
  UpdateLabelRadius;
  timer := TEpikTimer.Create(Self);
  shadowOfs := Point(10,10);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  image.free;
  shadowBase.free;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    movingOrigin := Point(X,Y);
    movingShadow := true;
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if movingShadow then
  begin
    inc(shadowOfs.x, X-movingOrigin.X);
    inc(shadowOfs.y, Y-movingOrigin.Y);
    movingOrigin := Point(X,Y);
    Invalidate;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    movingShadow:= false;
end;

end.