GLScene/Externals/GR32/Examples/Drawing/Blurs/MainUnit.pas

unit MainUnit;

interface

uses
  {$IFNDEF FPC} Windows, {$ELSE} LCLIntf, LCLType, {$ENDIF}
  SysUtils, Classes, Graphics, Controls, Forms, Menus, Dialogs, ComCtrls,
  ExtCtrls, StdCtrls, Math, GR32, GR32_Image, GR32_Layers, GR32_System;

type
  TFrmBlurs = class(TForm)
    MnuBlurType: TMenuItem;
    CbxBidirectional: TCheckBox;
    MnuFile: TMenuItem;
    ImgViewPage1: TImgView32;
    ImgViewPage2: TImgView32;
    ImgViewPage3: TImgView32;
    LblBlurAngle: TLabel;
    LblBlurRadius: TLabel;
    MainMenu: TMainMenu;
    MnuExit: TMenuItem;
    MnuFastGaussian: TMenuItem;
    MnuGaussianType: TMenuItem;
    MnuMotion: TMenuItem;
    MnuNone: TMenuItem;
    N1: TMenuItem;
    MnuOpen: TMenuItem;
    OpenDialog: TOpenDialog;
    PageControl: TPageControl;
    PnlControl: TPanel;
    RgpBlurType: TRadioGroup;
    SbrMain: TStatusBar;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TbrBlurAngle: TTrackBar;
    TbrBlurRadius: TTrackBar;
    CheckBoxCorrectGamma: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MnuExitClick(Sender: TObject);
    procedure MnuGaussianTypeClick(Sender: TObject);
    procedure MnuOpenClick(Sender: TObject);
    procedure PageControlChange(Sender: TObject);
    procedure RgpBlurTypeClick(Sender: TObject);
    procedure TbrBlurAngleChange(Sender: TObject);
    procedure TbrBlurRadiusChange(Sender: TObject);
  private
    FPerfTimer: TPerfTimer;
    FDuration: string;

    FReDrawFlag: Boolean;

    FStoneWeedImage: TBitmap32;
    FIcelandImage: TBitmap32;
    FRandBoxImage: TBitmap32;
    FBmpLayer: TBitmapLayer;
    procedure ReDraw;
  end;

var
  FrmBlurs: TFrmBlurs;

implementation

uses
  {$IFNDEF FPC} JPEG, {$ELSE} LazJPG, {$ENDIF}
  GR32_Polygons, GR32_VectorUtils, GR32_Blurs, GR32_Resamplers;

{$IFDEF FPC}
{$R *.lfm}
{$ELSE}
{$R *.dfm}
{$ENDIF}

{ Miscellaneous functions }

procedure DrawFramedBox(Bmp32: TBitmap32; const Rec: TRect;
  Color1, Color2: TColor32; LineWidth: TFloat);
var
  Pts: TArrayOfFloatPoint;
begin
  if LineWidth < 1 then LineWidth := 1;
  SetLength(Pts, 6);
  with Rec do
  begin
    Pts[0] := FloatPoint(Left, Bottom);
    Pts[1] := FloatPoint(Left, Top);
    Pts[2] := FloatPoint(Right, Top);
    Pts[3] := FloatPoint(Right - LineWidth, Top + LineWidth);
    Pts[4] := FloatPoint(Left + LineWidth, Top + LineWidth);
    Pts[5] := FloatPoint(Left + LineWidth, Bottom - LineWidth);
    PolygonFS(Bmp32, Pts, Color1);
    Pts[1] := FloatPoint(Right, Bottom);
    Pts[2] := FloatPoint(Right, Top);
    Pts[3] := FloatPoint(Right - LineWidth, Top + LineWidth);
    Pts[4] := FloatPoint(Right - LineWidth, Bottom - LineWidth);
    Pts[5] := FloatPoint(Left + LineWidth, Bottom - LineWidth);
    PolygonFS(Bmp32, Pts, Color2);
  end;
end;

procedure LoadJPGResource(const ResName: string; Bmp32: TBitmap32);
var
  ResStream: TResourceStream;
  JPEG: TJPEGImage;
begin
  JPEG := TJPEGImage.Create;
  ResStream := TResourceStream.Create(hInstance, ResName, RT_RCDATA);
  try
    JPEG.LoadFromStream(ResStream);
    Bmp32.Assign(JPEG);
  finally
    ResStream.Free;
    JPEG.Free;
  end;
end;


{ TFrmBlurs }

procedure TFrmBlurs.FormCreate(Sender: TObject);
var
  I, J: Integer;
const
  Colors: array [0 .. 21] of TColor32 = (clAliceBlue32, clAquamarine32,
    clAzure32, clBeige32, clBlueViolet32, clCadetblue32, clChocolate32,
    clCoral32, clCornFlowerBlue32, clCornSilk32, clCrimson32,
    clDarkBlue32, clDarkCyan32, clDarkGoldenRod32, clDarkGreen32,
    clDarkMagenta32, clDarkOrange32, clDarkOrchid32, clDarkRed32,
    clDarkSalmon32, clDarkSeaGreen32, clDarkSlateBlue32);
begin
  FStoneWeedImage := TBitmap32.create;
  FIcelandImage := TBitmap32.create;

  // Just use FStoneWeedImage momentarily to load a 600*400 image of ICELAND ...
  LoadJPGResource('ICELAND', FStoneWeedImage);
  FIcelandImage.SetSize(600, 400);
  FStoneWeedImage.DrawTo(FIcelandImage, FIcelandImage.BoundsRect,
    FStoneWeedImage.BoundsRect);
  // Now load the real STONEWEED image ...
  LoadJPGResource('STONEWEED', FStoneWeedImage);

  FPerfTimer := TPerfTimer.Create;

  Randomize;
  FRandBoxImage := TBitmap32.create;
  //generate an image of full of random boxes ...
  FRandBoxImage.SetSize(192, 272);
  for I := 0 to 11 do
    for J := 0 to 16 do
      FRandBoxImage.FillRectS(I * 16, J * 16, 300 + (I + 1) * 16,
        40 + (J +1) * 16, SetAlpha(Colors[Random(22)], 128));

  FBmpLayer := TBitmapLayer(ImgViewPage3.Layers.Add(TBitmapLayer));
  FBmpLayer.Bitmap.DrawMode := dmBlend;

  ReDraw;
end;

procedure TFrmBlurs.FormDestroy(Sender: TObject);
begin
  FPerfTimer.Free;
  FStoneWeedImage.Free;
  FIcelandImage.Free;
  FRandBoxImage.Free;
end;

procedure TFrmBlurs.ReDraw;
var
  Radius: Integer;
  Rec, Rec2: TRect;
  Pts, Pts2: TArrayOfFloatPoint;
  WithGamma: Boolean;
begin
  if FReDrawFlag then
    Exit;
  FReDrawFlag := True;
  Radius := TbrBlurRadius.Position;
  Screen.Cursor := crHourGlass;
  WithGamma := CheckBoxCorrectGamma.Checked;
  case PageControl.ActivePageIndex of
    0:
      begin
        ImgViewPage1.BeginUpdate;
        ImgViewPage1.Bitmap.Assign(FIcelandImage);

        FPerfTimer.Start;
        case RgpBlurType.ItemIndex of
          1:
            GaussianBlurSimple[WithGamma](ImgViewPage1.Bitmap, Radius);
          2:
            FastBlurSimple[WithGamma](ImgViewPage1.Bitmap, Radius);
          3:
            if WithGamma then
              MotionBlurGamma(ImgViewPage1.Bitmap, Radius,
               TbrBlurAngle.Position, CbxBidirectional.Checked)
            else
              MotionBlur(ImgViewPage1.Bitmap, Radius,
               TbrBlurAngle.Position, CbxBidirectional.Checked)
        end;
        FDuration := FPerfTimer.ReadMilliseconds;
        ImgViewPage1.EndUpdate;
        ImgViewPage1.Repaint;
        Application.ProcessMessages;
      end;
    1:
      begin
        ImgViewPage2.BeginUpdate;
        ImgViewPage2.Bitmap.Assign(FStoneWeedImage);

        Pts := Star(130, 150, 90, 5, -0.5 * Pi);
        Pts2 := Ellipse(350, 250, 100, 60);

        FPerfTimer.Start;
        case RgpBlurType.ItemIndex of
          1:
            begin
              GaussianBlurRegion[WithGamma](ImgViewPage2.Bitmap, Radius, Pts);
              GaussianBlurRegion[WithGamma](ImgViewPage2.Bitmap, Radius, Pts2);
            end;
          2:
            begin
              FastBlurRegion[WithGamma](ImgViewPage2.Bitmap, Radius, Pts);
              FastBlurRegion[WithGamma](ImgViewPage2.Bitmap, Radius, Pts2);
            end;
          3:
            if WithGamma then
            begin
              MotionBlurGamma(ImgViewPage2.Bitmap, Radius, TbrBlurAngle.Position,
                Pts, CbxBidirectional.Checked);
              MotionBlurGamma(ImgViewPage2.Bitmap, Radius, TbrBlurAngle.Position,
                Pts2, CbxBidirectional.Checked);
            end
            else
            begin
              MotionBlur(ImgViewPage2.Bitmap, Radius, TbrBlurAngle.Position,
                Pts, CbxBidirectional.Checked);
              MotionBlur(ImgViewPage2.Bitmap, Radius, TbrBlurAngle.Position,
                Pts2, CbxBidirectional.Checked);
            end;
        end;
        FDuration := FPerfTimer.ReadMilliseconds;
        Application.ProcessMessages;

        PolylineFS(ImgViewPage2.Bitmap, Pts, clBlack32, True, 2.5);
        PolylineFS(ImgViewPage2.Bitmap, Pts2, clBlack32, True, 2.5);
        ImgViewPage2.EndUpdate;
        ImgViewPage2.Repaint;
      end;
    2:
      begin
        ImgViewPage3.BeginUpdate;
        ImgViewPage3.SetupBitmap(True, Color32(clBtnFace));
        FBmpLayer.Bitmap.Clear(0);

        with ImgViewPage3.GetBitmapRect do
        begin
          FBmpLayer.Location := FloatRect(Left, Top, Right, Bottom);
          FBmpLayer.Bitmap.SetSize(Right - Left, Bottom - Top)
        end;
        FBmpLayer.Bitmap.Draw(300, 40, FRandBoxImage);

        Rec := Rect(40, 40, 240, 120);
        DrawFramedBox(ImgViewPage3.Bitmap, Rec, clWhite32, clGray32, Radius div 2);

        Rec2 := Rect(40, 160, 240, 320);
        with Rec2 do
          FBmpLayer.Bitmap.FillRect(Left, Top, Right, Bottom, clRed32);
        InflateRect(Rec2, 20, 20);

        Pts := Ellipse(395, 175, 60, 100);

        FPerfTimer.Start;
        case RgpBlurType.ItemIndex of
          1:
            begin
              GaussianBlurBounds[WithGamma](ImgViewPage3.Bitmap, Radius, Rec);
              GaussianBlurBounds[WithGamma](FBmpLayer.Bitmap, Radius, Rec2);
              GaussianBlurRegion[WithGamma](FBmpLayer.Bitmap, Radius, Pts);
            end;
          2:
            begin
              FastBlurBounds[WithGamma](ImgViewPage3.Bitmap, Radius, Rec);
              FastBlurBounds[WithGamma](FBmpLayer.Bitmap, Radius, Rec2);
              FastBlurRegion[WithGamma](FBmpLayer.Bitmap, Radius, Pts);
            end;
          3:
            if WithGamma then
            begin
              MotionBlurGamma(ImgViewPage3.Bitmap, Radius,
                TbrBlurAngle.Position, Rec, CbxBidirectional.Checked);
              MotionBlurGamma(FBmpLayer.Bitmap, Radius,
                TbrBlurAngle.Position, Rec2, CbxBidirectional.Checked);
              MotionBlurGamma(FBmpLayer.Bitmap, Radius,
                TbrBlurAngle.Position, Pts, CbxBidirectional.Checked);
            end
            else
            begin
              MotionBlur(ImgViewPage3.Bitmap, Radius,
                TbrBlurAngle.Position, Rec, CbxBidirectional.Checked);
              MotionBlur(FBmpLayer.Bitmap, Radius,
                TbrBlurAngle.Position, Rec2, CbxBidirectional.Checked);
              MotionBlur(FBmpLayer.Bitmap, Radius,
                TbrBlurAngle.Position, Pts, CbxBidirectional.Checked);
            end;
        end;
        FDuration := FPerfTimer.ReadMilliseconds;
        Application.ProcessMessages;

        PolylineFS(FBmpLayer.Bitmap, Pts, clBlack32, True, 2.5);

        with Rec2 do
          PolylineFS(
            FBmpLayer.Bitmap,
            BuildPolygonF([
              Left, Top, Right, Top, Right, Bottom, Left, Bottom]),
            clBlack32,
            True,
            0.5);

        ImgViewPage3.EndUpdate;
        ImgViewPage3.Repaint;
      end;
  end;
  SbrMain.SimpleText := Format('  Blur drawing time: %s ms', [FDuration]);
  Screen.Cursor := crDefault;
  FReDrawFlag := False;
end;

procedure TFrmBlurs.MnuExitClick(Sender: TObject);
begin
  Close;
end;

procedure TFrmBlurs.RgpBlurTypeClick(Sender: TObject);
begin
  MnuNone.Checked := RgpBlurType.ItemIndex = 0;
  MnuGaussianType.Checked := RgpBlurType.ItemIndex = 1;
  MnuFastGaussian.Checked := RgpBlurType.ItemIndex = 2;
  MnuMotion.Checked := RgpBlurType.ItemIndex = 3;
  LblBlurAngle.Enabled := MnuMotion.Checked;
  TbrBlurAngle.Enabled := MnuMotion.Checked;
  CbxBidirectional.Enabled := MnuMotion.Checked;
  ReDraw;
end;

procedure TFrmBlurs.TbrBlurRadiusChange(Sender: TObject);
begin
  LblBlurRadius.Caption :=
    Format('Blur &Radius (%d)', [TbrBlurRadius.Position]);
  ReDraw;
end;

procedure TFrmBlurs.TbrBlurAngleChange(Sender: TObject);
begin
  LblBlurAngle.Caption :=
    Format('Blur &Angle (%d)', [TbrBlurAngle.Position]);
  ReDraw;
end;

procedure TFrmBlurs.MnuGaussianTypeClick(Sender: TObject);
begin
  if Sender = MnuNone then
    RgpBlurType.ItemIndex := 0
  else if Sender = MnuGaussianType then
    RgpBlurType.ItemIndex := 1
  else if Sender = MnuFastGaussian then
    RgpBlurType.ItemIndex := 2
  else
    RgpBlurType.ItemIndex := 3;
end;

procedure TFrmBlurs.MnuOpenClick(Sender: TObject);
var
  Extension: String;
begin
  if OpenDialog.Execute then
  begin
    Extension := Lowercase(ExtractFileExt(OpenDialog.FileName));
    FIcelandImage.LoadFromFile(OpenDialog.FileName);
    PageControl.ActivePageIndex := 0;
    ReDraw;
  end;
end;

procedure TFrmBlurs.PageControlChange(Sender: TObject);
begin
  ReDraw;
end;

end.