From: "Joël Joly" <joel.joly@wanadoo.fr>
Subject: Re: Cropping an image
Date: 04 Mar 2000 00:00:00 GMT
Message-ID: <89qpc9$rn31@bornews.borland.com>
References: <89g0l6$j123@bornews.borland.com>
X-Priority: 3
X-MimeOLE: Produced By Microsoft MimeOLE V5.00.2615.200
Organization: technojoly
X-MSMail-Priority: Normal
Reply-To: "Joël Joly" <joel.joly@wanadoo.fr>
Newsgroups: borland.public.delphi.graphics

i had writing this unit and i call function with timage event
reset is used for clear rectangular zone selected

http://perso.wanadoo.fr/joel.joly/

unit crop;


interface

uses windows, Messages, SysUtils, graphics, Classes,
Controls,clipbrd,ExtCtrls;

 procedure CropMouseMove(image : Timage;zx,zy : integer; Shift: TShiftState;
X,Y: Integer);
 procedure CropMouseUp(Image : TImage;zx,zy : integer; Button:
TMouseButton;Shift: TShiftState; X, Y: Integer);
 procedure CropCopy(image : timage;zx,zy : integer);
 procedure CropPaste(image : timage;zx,zy : integer);
 procedure CropReset(image : timage);

var memrect : trect;

implementation


Procedure CropReset(image : timage);
var tmpbmp : tbitmap;

begin
  if image.Picture.Graphic is ticon then exit;
  if image.Picture.Graphic is tmetafile then exit;
  tmpbmp:=Tbitmap.Create;
  try
   tmpbmp.Assign(image.Picture.Graphic);
   tmpbmp.Canvas.DrawFocusRect(memrect);
   image.Picture.Assign(tmpbmp);
  finally
   MemRect.Left:=0;
   MemRect.Top:=0;
   MemRect.Right:=0;
   MemRect.Bottom:=0;
   tmpbmp.Free;
  end;
end;

procedure CropMouseMove(image : Timage;zx,zy : integer; Shift: TShiftState;
X,Y: Integer);
var rect : trect;
    tmpbmp : tbitmap;
begin
 if shift=[ssleft] then
 begin
 tmpbmp:=Tbitmap.Create;
 try
  with rect do
  begin
   Left:=Zx;
   Top:=Zy;
   Right:=x;
   Bottom:=y;
   if top>bottom then
   begin
    top:=y;
    bottom:=zy;
   end;
   if left>right then
   begin
    left:=x;
    right:=zx;
   end;
   if right>image.Width then right:=image.Width;
   if bottom>image.Height then bottom:=image.Height;
  end;
  tmpbmp.Assign(image.Picture.Graphic);
  tmpbmp.Canvas.DrawFocusRect(memrect);
  tmpbmp.Canvas.DrawFocusRect(rect);
  image.Picture.Assign(tmpbmp);
  memrect:=rect;
 finally
  tmpbmp.Free;
 end;
 end;
end;

procedure CropMouseUp(Image : TImage;zx,zy : integer; Button:
TMouseButton;Shift: TShiftState; X, Y: Integer);
var rect : trect;
    tmpbmp : TBitmap;
begin
 if button=mbleft then
 begin
 tmpbmp:=Tbitmap.Create;
 try
  with rect do
  begin
   Left:=Zx;
   Top:=Zy;
   Right:=x;
   Bottom:=y;
   if top>bottom then
   begin
    top:=y;
    bottom:=zy;
   end;
   if left>right then
   begin
    left:=x;
    right:=zx;
   end;
   if right>image.Width then right:=image.Width;
   if bottom>image.Height then bottom:=image.Height;
  end;
  tmpbmp.Assign(image.Picture.Graphic);
  tmpbmp.Canvas.DrawFocusRect(memrect);
  tmpbmp.Canvas.DrawFocusRect(rect);
  image.Picture.Assign(tmpbmp);
  memrect:=rect;
 finally
  tmpbmp.Free;
 end;
 end;
end;

procedure CropCopy(Image : Timage;zx,zy : integer);
var rect,destrect : trect;
    tmpbmp : Tbitmap;

begin
 tmpbmp:=Tbitmap.Create;
 try
  rect.Left:=memrect.Left+1;
  rect.Top:=memrect.Top+1;
  rect.Right:=memrect.Right-1;
  rect.Bottom:=memrect.Bottom-1;
  tmpbmp.Width := image.Picture.Width;
  tmpbmp.Height := image.Picture.Height;
  tmpbmp.Palette:=CopyPalette(Image.Picture.Graphic.Palette);
  tmpbmp.Canvas.Draw(0,0,image.Picture.Graphic);
  tmpbmp.Width := memrect.Right-memrect.Left;
  tmpbmp.Height := memrect.Bottom-memrect.Top;
  Destrect.Left:=0;
  Destrect.Top:=0;
  Destrect.Right:=tmpbmp.Width;
  Destrect.Bottom:=tmpbmp.Height;
  tmpbmp.Canvas.CopyRect(destrect,image.Canvas,rect);
  Clipboard.Assign(tmpbmp);
  Cropreset(image);
 finally
  tmpbmp.Free;
 end;
end;

procedure CropPaste(image : timage;zx,zy : integer);
var sourcerect,destrect: Trect;
    tmpbmp,destbmp : tbitmap;

begin
 if not(clipboard.HasFormat(cf_Picture)) then exit;
 tmpbmp:=Tbitmap.Create;
 destbmp:=Tbitmap.Create;
 try
  tmpbmp.Assign(clipboard);
  destrect.Left:=Zx;
  destrect.Top:=Zy;
  destrect.Right:=tmpbmp.Width+Zx;
  destrect.Bottom:=tmpbmp.Height+Zy;
  destbmp.Width:=image.Width;
  destbmp.Height:=image.Height;
  destbmp.Assign(image.Picture.Graphic);
  Sourcerect.Left:=0;
  Sourcerect.Top:=0;
  Sourcerect.Right:=tmpbmp.Width;
  Sourcerect.Bottom:=tmpbmp.Height;
  destbmp.Canvas.CopyRect(destrect,tmpbmp.Canvas,sourcerect);
  image.Picture.Assign(destbmp);
 finally
  tmpbmp.Free;
  destbmp.Free;
 end;
end;

end.
Arch Reynolds <areynolds@ardcs.net> a écrit dans le message :
89g0l6$j123@bornews.borland.com...
> I am trying to crop part of an image and paste it into a new image. Using
> copyrect works ok for
> a normal size image but it does'nt work when the stretch property of the
> source image is set
> to true. I have tried using stretchblt but I get the same results. Any
ideas
> ?
>
> Thanks
> Arch