Forum > General

How allow user to select part of image and copy it to file ?

(1/2) > >>

seba22:
Welcome,

I would ask  a question.

How can I allow in my application to select part of image and copy selected area to new file ?

Is there any component what allow action like this one ?

I mean, i would like open picture saved in c:\test.jpg
And display it to user. User should select part (RECTANGLE) of that image and click copy.
Then it should save selected area.

I was never trying to something like that that's why i don't know where i should look.

In Delphi i can remember there was option called   Image.Canvas.CopyRect but i have input  dimensions, i mean location of my rectangle.
How Can i get that rectangle from user ?


Regards


garlar27:
You can use a TImage in the form and catch coordinates from the
MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) and
MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer)
events to get coordinates start and end coordinates to use in the CopyRect.

seba22:
Welcome,

Few days ago i ask question about copying part of image.

Today i would like show you some code, and ask... why it's not working well :)

First screenshot working application...
http://photoadder.com/show-image.php?id=168729d2ac78ec19afad3bc0274bfdb1

but, when i start drawing my rectangle from bottom right to top it looks like that

http://photoadder.com/show-image.php?id=9589b27b8098453df044c5f8441e4b47


Any idea, how can i make it working (allow user to select, like he want, from any direction ) ;)

I attach sourcecode

--- Code: ---unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image: TImage;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
    Drawing : boolean ;
    P : TPoint ;
    P2 : TPoint ;
implementation

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Drawing := False ;
end;

procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Drawing := True ;


P := Point(X, Y) ;
P2 := P ;
Image.Canvas.Pen.Color := clRed ;  // color 'pen'
Image.Canvas.Brush.Style := bsClear ; // 'remove'
Image.Canvas.Pen.Style := psDashDot ; // dotted dash
Image.Picture.LoadFromFile('/home/laboratory2/Desktop/test.bmp');
end;

procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Drawing = true then
 begin
Image.Canvas.Pen.Mode := pmNotXor ;
Image.Canvas.Rectangle(P.X, P.Y, P2.X, P2.Y);
P2.X := X ;
P2.Y := Y ;
Image.Canvas.Pen.Mode := pmNotXor ;
Image.Canvas.Rectangle(P.X, P.Y, P2.X, P2.Y);
 end;
end;

procedure TForm1.ImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
 B: TBitmap ;
begin
Drawing := False ;
B := TBitmap.Create ;
 B.Width := Abs(P2.X - P.X);
  B.Height := Abs(P2.Y - P.Y);
  B.Canvas.CopyRect(Rect(0, 0, b.Width, b.Height), Image.Canvas,
    Rect(P.X, P.Y, P2.X, P2.Y));
    Image2.width:=Abs(P2.X - P.X);
    Image2.height:=Abs(P2.Y - P.Y);

  Image2.Canvas.Draw(0, 0, B);

//B.SaveToFile('C:\somthing.bmp');
end;

initialization
  {$I unit1.lrs}

end.

--- End code ---

 

Regards :)

typo:
Use Canvas.DrawFocusRect;

seba22:
I rewrited it to use DrawFocusRect but still not solve my problem with copying selected part...
from left to right working, from right to left = fail.

--- Code: ---unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image: TImage;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
    Drawing : boolean ;
    P : TPoint ;
    P2 : TPoint ;
implementation

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Drawing := False ;
end;

procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Drawing := True ;


P := Point(X, Y) ;
P2 := P ;
  Image.Canvas.DrawFocusRect(Rect(x, y, x, y));
Image.Picture.LoadFromFile('/home/laboratory2/Desktop/test.bmp');
end;

procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Drawing = true then
 begin
    Image.Canvas.DrawFocusRect(Rect(P.x, P.y, P2.x,P2.y));
    P2 := Point(x, y);
    Image.Canvas.DrawFocusRect(Rect(P.x, P.y, x, y));


 end;
end;

procedure TForm1.ImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
 B: TBitmap ;
 Bitmapa:TBitmap;

begin

  Image.Canvas.DrawFocusRect(Rect(P.x, P.y, P2.x, P2.y));
  Image.Canvas.DrawFocusRect(Rect(P.x, P.y, x, y));
  //P := Point(x, y);


Drawing := False ;

B := TBitmap.Create ;
B.Width := Round(abs(P2.x - P.x));
B.Height := Round(abs(P2.y - P.y));
B.Canvas.CopyRect(Rect(0, 0, b.Width, b.Height), Image.Canvas,
Rect(P.X, P.Y, P2.X, P2.Y));
Image2.Width := Round(abs(P2.x - P.x));
Image2.Height := Round(abs(P2.y - P.y));
 // showmessage(inttostr(B.Width));
  //  showmessage(inttostr(B.height));

Image2.Canvas.Draw(0, 0, B);




//B.SaveToFile('C:\somthing.bmp');
end;

initialization
  {$I unit1.lrs}

end.

--- End code ---

Navigation

[0] Message Index

[#] Next page

Go to full version