I would like to crop an image or a rectangle in Firemonkey. How can I do this?

CodePudding user response：

I have uploaded a demo for you.

below is the code, if you don't want to mess with it, download the demo.

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Objects;

type
  TMain = class(TForm)
    Image: TImage;
    Rectangle_CropPos: TRectangle;
    Timer_Startup: TTimer;
    procedure Timer_StartupTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Main: TMain;

implementation

{$R *.fmx}

uses Unit2;



procedure TMain.Timer_StartupTimer(Sender: TObject);
var
  lBmp: TBitmap;
  xScale, yScale, scale: extended;
  iRect: TRect;
  OffsetX, OffsetY: extended;
  BmpHwRatio: extended;
  DispRatio: extended;

begin
 Timer_Startup.Enabled:=False;
 // --------------------------

 if Rectangle_CropPos.Visible then
 begin
    lBmp := TBitmap.Create;
    try
      xScale := Image.Bitmap.Width / Image.Width;
      yScale := Image.Bitmap.Height / Image.Height;

      if xScale > yScale
      then yscale := xScale
      else xscale := yScale;

      lBmp.Width := round(Rectangle_CropPos.Width * xScale);
      lBmp.Height := round(Rectangle_CropPos.Height * yScale);

      // added offset terms to compensate for the space between
      // picture and Image1 border
      offsetx := (Image.Width - Image.Bitmap.Width / xscale) / 2;
      offsety := (Image.Height - Image.Bitmap.Height / yscale) / 2;
// You can test without the offset calculations
//      offsetx := 0;
//      offsety := 0;

      // offset terms added here
      iRect.Left   := round((Rectangle_CropPos.Position.X - offsetx) * xscale);
      iRect.Top    := round((Rectangle_CropPos.Position.Y - offsety) * yscale);
      iRect.Width  := round(Rectangle_CropPos.Width * xscale);
      iRect.Height := round(Rectangle_CropPos.Height * yscale);

      if iRect.Left < 0 then iRect.Left := 0;
      if iRect.Top  < 0 then iRect.Top  := 0;
      if iRect.Width < 1 then iRect.Width := 1;
      if iRect.Height > (LBMp.Height-1) then iRect.Height := LBmp.Height;

      lBmp.CopyFromBitmap(Image.Bitmap, iRect, 0, 0);


      if (fImagePreview.Visible=False) then
       fImagePreview.Show;
      fImagePreview.Left:=Self.Left Self.ClientWidth 3;
      fImagePreview.Top:=Self.Top;

      fImagePreview.Image.Bitmap.Assign(lBmp);

    finally
      FreeAndNil(lBmp);
    end;
  end;
  {
  else
  begin
    Rectangle_CropPos.Visible := True;
    Rectangle_CropPos.Width := Round(Panel1.Width * 0.5);
    Rectangle_CropPos.Height := Round(Rectangle_CropPos.Width * 1.41);
    Rectangle_CropPos.Position.X := Round(Panel1.Width * 0.5)-(Rectangle_CropPos.Width * 0.5);
    Rectangle_CropPos.Position.Y := Round(Panel1.Height * 0.5)-(Rectangle_CropPos.Height * 0.5);
  end;
  }

end;

procedure TMain.FormCreate(Sender: TObject);
begin
 Timer_Startup.Enabled:=True;
end;

end.