GLScene/Externals/Graphics32x/Demo/fxGR32.pas

unit fxGR32;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Objects,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  System.Math.Vectors,
  GR32_Transforms,
  GR32, System.Math,
  FMX.Layouts,
  TypInfo,
  FMX.Platform,
  FMX.ListBox,
  GR32_Resamplers;

type
  TfxFMXGR32 = class(TForm)
    Image1: TImage;
    Layout2: TLayout;
    Image2: TImage;
    Rectangle3: TRectangle;
    Label13: TLabel;
    Rectangle1: TRectangle;
    Label1: TLabel;
    CmbResamplerClassNames: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Layout2Resize(Sender: TObject);
    procedure CmbResamplerClassNamesChange(Sender: TObject);
  private const
    DESIRE_FORMAT: TPixelFormat =
    {$IFDEF RGBA_FORMAT}
    TPixelFormat.RGBA
    {$ELSE}
    TPixelFormat.BGRA
    {$ENDIF}
    ;
  private
    { Private declarations }
    Transformation: TProjectiveTransformation;
    FScaleFactor: Single;
    Vertices: array [0..3] of TPointF;
    procedure DoPointChanged(Sender: TObject; var X, Y: Single);
    procedure DoTransform;
  public
    { Public declarations }
  end;

var
  fxFMXGR32: TfxFMXGR32;

implementation
{$R *.fmx}

procedure TfxFMXGR32.Button1Click(Sender: TObject);
//var
//  M: TMatrix;
begin
//  M.m11 := 0.945039331912994;
//  m.m21 := 0;
//  m.m31 := -0.000584687339141965;
//  m.m12 := 0;
//  m.m22 := 0.535142779350281;
//  m.m32 := -0.00280034448951483;
//  m.m13 := 0;
//  m.m23 := 0;
//  m.m33 := 1;
//
//
//  PaintBox1.Canvas.BeginScene();
//  paintBox1.Canvas.MultiplyMatrix(M);
//  PaintBox1.Canvas.DrawBitmap(Image1.Bitmap, RectF(0,0,Image1.Bitmap.Width,Image1.Bitmap.Height), PaintBox1.LocalRect, 1);
//  paintBox1.Canvas.EndScene;

  DoTransform;
end;

procedure TfxFMXGR32.CmbResamplerClassNamesChange(Sender: TObject);
begin
  DoTransform;
end;

procedure TfxFMXGR32.DoPointChanged(Sender: TObject; var X, Y: Single);
var
  idx: Integer;
begin
  idx := (Sender as TComponent).Tag;
  Vertices[idx].X := X;
  Vertices[idx].Y := Y;
  DoTransform;
end;

procedure TfxFMXGR32.DoTransform;
var
  src, dst: TBitmap32;
  maxx,maxy: Single;
  I: Integer;
  s: string;
  dstBitmap, tmp: TBitmap;
begin
  if image1.Bitmap.PixelFormat <> DESIRE_FORMAT then
  begin
    s := TypInfo.GetEnumName(TypeInfo(TPixelFormat), Integer(image1.Bitmap.PixelFormat));
    ShowMessage('wrong with ' + s);
    Exit;
  end;

  maxx := 0;
  maxy := 0;
  for I := 0 to 3 do
  begin
    maxx := max(maxx, Vertices[I].X);
    maxy := max(maxy, Vertices[I].Y);
  end;

  Transformation.X0 := Vertices[0].X;
  Transformation.Y0 := Vertices[0].Y;
  Transformation.X1 := Vertices[1].X;
  Transformation.Y1 := Vertices[1].Y;
  Transformation.X2 := Vertices[2].X;
  Transformation.Y2 := Vertices[2].Y;
  Transformation.X3 := Vertices[3].X;
  Transformation.Y3 := Vertices[3].Y;
  Transformation.SrcRect := FloatRect(0,0,200,200);
  src := TBitmap32.Create();
  dst := TBitmap32.Create();
  dstBitmap := TBitmap.Create;
  try
    src.Assign(Image1.Bitmap);
    with CmbResamplerClassNames do
      if ItemIndex >= 0 then
        Src.ResamplerClassName := Items[ ItemIndex ];
    dst.SetSize(ceil(maxx), ceil(maxy));
    Dst.Clear($00000000);
    Transform(Dst, Src, Transformation);
    dstBitmap.Assign(dst);
    if FScaleFactor = 1 then
      Image2.Bitmap := dstBitmap
    else
    begin
      tmp := TBitmap.Create;
      try
        tmp.SetSize(Round(dstBitmap.Width * FScaleFactor), Round(dstBitmap.Height * FScaleFactor));
        tmp.Canvas.BeginScene;
        tmp.Clear(0);
        tmp.Canvas.DrawBitmap(dstBitmap, dstBitmap.Bounds, tmp.Bounds, 1);
        tmp.Canvas.EndScene;
        Image2.Bitmap := tmp;
      finally
        tmp.Free;
      end;
    end;
  finally
    dstBitmap.Free;
    dst.Free;
    src.Free;
  end;
end;

procedure TfxFMXGR32.FormCreate(Sender: TObject);
var
  I: Integer;
  Shape: TSelectionPoint;
  ScreenSrv: IFMXScreenService;
begin

  if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService, ScreenSrv) then
    FScaleFactor := ScreenSrv.GetScreenScale
  else
    FScaleFactor := 1;

  Transformation := TProjectiveTransformation.Create;
  Vertices[0] := Point(-10,-20);
  Vertices[1] := Point(200,0);
  Vertices[2] := Point(200,200);
  Vertices[3] := Point(0,200);
//  Vertices[0] := Point(18,49);
//  Vertices[1] := Point(265,6);
//  Vertices[2] := Point(292,196);
//  Vertices[3] := Point(58,239);
  for I := 0 to 3 do
  begin
    Shape := TSelectionPoint.Create(Self);
    Shape.Parent := Image2;
    Shape.GripSize := 9;
    Shape.Position.X := Vertices[i].X;
    Shape.Position.Y := Vertices[i].Y;
    Shape.OnTrack := DoPointChanged;
    Shape.Tag := i;
  end;
  ResamplerList.GetClassNames(CmbResamplerClassNames.Items);
  CmbResamplerClassNames.ItemIndex := 0;
end;

procedure TfxFMXGR32.Layout2Resize(Sender: TObject);
begin
  Image1.Position.Point := TPoint.Zero;
  if Layout2.Width > Layout2.Height then
  begin
    Image1.Size.Size := TSizeF.Create(Layout2.Width / 2, Layout2.Height);
    Image2.Position.Point := PointF(Layout2.Width/2, 0);
    Image2.Size.Size := TSizeF.Create(Layout2.Width / 2, Layout2.Height);
  end
  else
  begin
    Image1.Size.Size := TSizeF.Create(Layout2.Width, Layout2.Height/2);
    Image2.Position.Point := PointF(0, Layout2.Height/2);
    Image2.Size.Size := TSizeF.Create(Layout2.Width, Layout2.Height/2);
  end;
end;

end.