Упрощённо. Надо скопировать кусок из одного изображения в другое и сохранить его в файл BMP.
Изображение-то копируется, но после сохранения я имею файл BMP залитый чёрным цветом, а не кусок скопированного изображения.
Укажите на ошибку, пожалуйста!
Прототип:
- Код: Выделить всё
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, LCLIntf, LCLType;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Image2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Image2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
BitMap: TBitMap;
FlagDown:Boolean;
DownX, DownY: Integer;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FlagDown := True;
DownX := X;
DownY := Y;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Picture.SaveToFile('C:\2priemn.bmp');
Image3.Picture.Assign(Image1.Picture);
Image1.Picture.SaveToFile('C:\3.bmp');
Image2.Picture.SaveToFile('C:\1orig.bmp');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Repaint;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
BitMap := TBitMap.Create;
BitMap.PixelFormat := pf32bit;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
BitMap.Free;
end;
procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FlagDown then
begin
with Image2 do
begin
Canvas.Pen.Color := clRed;
Canvas.Pen.Width := 2;
Canvas.Pen.Style := psSolid;
Canvas.Brush.Color := clNone;
Canvas.Brush.Style := bsClear;
Repaint;
Canvas.Rectangle(DownX, DownY, X, Y);
end;
end;
end;
procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Rect: TRect;
DC: HDC;
begin
FlagDown := False;
Rect.Left := DownX;
Rect.Top := DownY;
Rect.Right := X;
Rect.Bottom := Y;
BitMap.Width := Rect.Right - Rect.Left;
BitMap.Height := Rect.Bottom - Rect.Top;
BitMap.PixelFormat := Image2.Picture.Bitmap.PixelFormat;
BitBlt(BitMap.Canvas.Handle, 0, 0, Rect.Width, Rect.Height, Image2.Picture.Bitmap.Canvas.Handle, Rect.Left, Rect.Top, SRCCOPY);
Image1.Picture.Assign(BitMap);
//BitMap.SaveToFile(Edit1.Text);
end;
end.
Скачать прототип: https://cloud.mail.ru/public/Apd5/wBXyHXRXs