Canvas обрезать, сохранить..

[sergeyrulit]

Есть форма (Form3). Она растянута на весь экран, и фон у неё картинка (того же размера что и форма).

Вообщем функцией DrawFocusRect я узнаю координаты прямоугольника который нужно сохранить.

StartPlace.x := X;
 StartPlace.y := Y;
 EndPlace.x := X;
 EndPlace.y := Y;

Как по этим координатам обрезать канвас формы, и сохранить в файл?

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Jpeg;

type
  TForm3 = class(TForm)
    Image1: TImage;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    Capturing : bool;
    Captured : bool;
    StartPlace : TPoint;
    EndPlace : TPoint;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;
  Capturing : bool;
  Captured : bool;
  StartPlace : TPoint;
  EndPlace : TPoint;

implementation

{$R *.dfm}

function MakeRect(Pt1 : TPoint; Pt2 : TPoint) : TRect;
begin
  if pt1.x < pt2.x then
  begin
    Result.Left := pt1.x;
    Result.Right := pt2.x;
  end
  else
  begin
    Result.Left := pt2.x;
    Result.Right := pt1.x;
  end;

  if pt1.y < pt2.y then
  begin
    Result.Top := pt1.y;
    Result.Bottom := pt2.y;
  end
  else
  begin
    Result.Top := pt2.y;
    Result.Bottom := pt1.y;
  end;
end;


procedure TForm3.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Captured then
  DrawFocusRect(Form3.Canvas.Handle,MakeRect(StartPlace,EndPlace));
  StartPlace.x := X;
  StartPlace.y := Y;
  EndPlace.x := X;
  EndPlace.y := Y;
  DrawFocusRect(Form3.Canvas.Handle,MakeRect(StartPlace,EndPlace));
  Capturing := true;
  Captured := true;
end;

procedure TForm3.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Capturing then
  begin
    DrawFocusRect(Form3.Canvas.Handle,MakeRect(StartPlace,EndPlace));
    EndPlace.x := X;
    EndPlace.y := Y;
    DrawFocusRect(Form3.Canvas.Handle,MakeRect(StartPlace,EndPlace));
  end;
end;

procedure TForm3.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Capturing := false;
end;

end.

Form1:

  Form3.Show;
  Form3.Canvas.Draw(0, 0, ABitmap);

[x128]

Создай битмап и далее Canvas.CopyRect или апишный BitBlt

[sergeyrulit]

Все утро пытаюсь через CopyRect.. Но не получается. Может кто кодом поможет..

[x128]

как-то так:

var
  r: TRect;
...
  r:=Rect(StartPlace.X, StartPlace.Y, EndPlace.X, EndPlace.Y);
  bmp:=TBitmap.Create;
  bmp.PixelFormat:=pf24bit;
  bmp.Height:=r.Bottom-r.Top;
  bmp.Width:=r.Right-r.Left;
  bmp.Canvas.CopyRect(bmp.Canvas.ClipRect, Canvas, r);
  bmp.SaveToFile('MyBitmap.bmp');
  bmp.Destroy;

[sergeyrulit]

Спасибо, но почему то обрезает не совсем так. Допустим, вот что получилось после обрезания: http://s004.radikal.ru/i206/1008/af/1f9ad5957bf0.jpg .. Видишь там белое в верхнем левом угле, а должен быть рисунок...

Я выделял полностью это окно, но оно на половину обрезалось.

[x128]

Спасибо, но почему то обрезает не совсем так.

Я редактировал пост, строка bmp.Canvas.CopyRect(bmp.Canvas.Clip Rect, Canvas, r);, вариант который я написал сначала был с ошибкой.

[sergeyrulit]

большое спасибо.