担伸与保存已经解决。
至于托动,你参考上面兄弟的代码,我就不写了。
a.拉伸,点击Image1,Image左上角出现一黑点,
用鼠标拖动,即可拉伸。右键击Image1,取消拉伸。
(我只做一个点,其它你自己去加)。
b.保存。点“合成”按钮,即可保存。
源码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Image2: TImage;
Image1: TImage;
Shape1: TShape;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
ShapeMouseDown: Boolean;
OldPoint, ShapePoint: TPoint;
ImageWidth, ImageHeight: integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ScrollBox1.DoubleBuffered := true;
Image1.Picture.LoadFromFile('D:/66.bmp');
Image2.Picture.LoadFromFile('D:/77.bmp');
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
ImageWidth := Image1.Width;
ImageHeight := Image1.Height;
Shape1.Left := Image1.Left - (Shape1.Width div 2);
Shape1.Top := Image1.Top - (Shape1.Height div 2);
Shape1.Visible := true;
end else
begin
Shape1.Visible := false;
end;
end;
procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
ShapeMouseDown := true;
GetCursorPos(OldPoint);
ShapePoint.X := Shape1.Left;
ShapePoint.Y := Shape1.Top;
end;
end;
procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
NewPoint: TPoint;
lLeft, lTop: integer;
begin
if ShapeMouseDown then
begin
GetCursorPos(NewPoint);
lLeft := ShapePoint.X + NewPoint.X - OldPoint.X;
lTop := ShapePoint.Y + NewPoint.Y - OldPoint.Y;
Shape1.Left := lLeft;
Shape1.Top := lTop;
Image1.Left := lLeft + (Shape1.Width div 2);
Image1.Top := lTop + (Shape1.Height div 2);
Image1.Width := ImageWidth - (NewPoint.X - OldPoint.X);
Image1.Height := ImageHeight - (NewPoint.Y - OldPoint.Y);
end;
end;
procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ShapeMouseDown then
begin
ShapeMouseDown := false;
ImageWidth := Image1.Width;
ImageHeight := Image1.Height;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp, Bmp2: TBitmap;
lx, ly: integer;
begin
Bmp := TBitmap.Create;
Bmp.PixelFormat := pf24Bit;
Bmp.Width := Image1.Width;
Bmp.Height := Image1.Height;
Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect, Image1.Picture.Bitmap);
Bmp2 := TBitmap.Create;
Bmp2.PixelFormat := pf24Bit;
Bmp2.Width := Image2.Width;
Bmp2.Height := Image2.Height;
Bmp2.Canvas.StretchDraw(Bmp2.Canvas.ClipRect, Image2.Picture.Bitmap);
lx := Image2.Left-Image1.Left;
ly := Image2.Top-Image1.Top;
Bmp.Canvas.CopyRect(Rect(lx, ly, lx+Image2.Width, ly+Image2.Height),
Bmp2.Canvas,Bmp2.Canvas.ClipRect);
Bmp.SaveToFile(ExtractFilePath(Application.ExeName) + 'Test.Bmp');
Bmp2.Free;
Bmp.Free;
end;
end.