Вырезать картинку с канвы.

[sergeyrulit]

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Permission:= true;
  StartX:= X;
  StartY:= Y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  BufferScreenShot: TBitMap;
begin
  if Permission then
  begin
    try
      BufferScreenShot:= TBitMap.Create;
      BufferScreenShot.Assign(MaskScreenShotImage);
      BufferScreenShot.Canvas.Brush.Bitmap:= SourceScreenShotImage;
      BufferScreenShot.Canvas.Pen.Width:= 1;
      BufferScreenShot.Canvas.Pen.Style:= psDot;
      BufferScreenShot.Canvas.Pen.Color:= ClRed;
      BufferScreenShot.Canvas.Rectangle(StartX, StartY, X, Y);
      Form1.Canvas.Draw(0,0, BufferScreenShot);
    finally
      BufferScreenShot.Free;
    end;
  end;
end;


procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  RCut: TRect;
  DoneScreenShot: TBitMap;
begin
  Permission:= false;
  RCut:= Rect(StartX, StartY, X, Y);
  DoneScreenShot:= TBitMap.Create;
  DoneScreenShot.PixelFormat:= pf24bit;
  DoneScreenShot.Height:= RCut.Bottom - RCut.Top;
  DoneScreenShot.Width:= RCut.Right - RCut.Left;
  DoneScreenShot.Canvas.CopyRect(DoneScreenShot.Canvas.ClipRect,   SourceScreenShotImage.Canvas, RCut);
  DoneScreenShot.SaveToFile('C:\MyBitmap.bmp');
  DoneScreenShot.Free;
end;

Пытаюсь вырезать через CopyRect, но возникает ошибка: Out of system resources. Почему? Можно по другому вырезать?

[mihali4]

В свое время Алар дал такой пример :

var 
ScreenDC:HDC; 
Canvas:TCanvas; 
Image3:TImage;
begin 
ScreenDC := GetDC(0); 
Canvas:=TCanvas.Create();
Canvas.Handle:=ScreenDC;
Image3 := TImage.Create(nil);
Image3.Width := 200;
Image3.Height := 200;
Image3.Canvas.CopyRect(Rect(0, 0, Image3.Width, Image3.Height), Canvas, Rect(0, 0, 200, 200));
Image1.Picture.Assign(Image3.Picture);
ReleaseDC(0,ScreenDC);
Canvas.Free; 
end;

Работает отлично.

[sergeyrulit]

Работает, но через раз . Иногда ошибка: неверно указан параметр (в строке Image3.Canvas.CopyRect)..

Не нужно цитировать предыдущее сообщение! Это - флуд.
Рекомендую. Помимо общих правил форума есть и дополнения к ним в каждом разделе...
А кроме кнопки "Цитата" внизу есть простое окно для ввода своего сообщения.
Или маленькая кнопочка "Быстрый ответ" справа от кнопки "Цитата".
Попадаете туда же.
Модератор

[maxionans]

не совсем понятно, что нужно ТС, но всё же приведу свой полностью рабочий пример копирования изображения.

var
  DC : HDC;
  Bmp : TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    DC := GetDC( 0 );

    Bmp.SetSize( 100, 100 );
    BitBlt( Bmp.Canvas.Handle, 0, 0, 100, 100, DC, 0, 0, SRCCOPY );
    Bmp.SaveToFile( 'c:\test.bmp' );

    ReleaseDC( 0, DC );
  finally
    Bmp.Free;
  end;
end;