窗体代码:GraphWin.dfm
object Form1: TForm1
Left = 51
Top = 159
Width = 575
Height = 334
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
Position = poDefault
OnCreate = FormCreate
OnMouseDown = FormMouseDown
OnMouseMove = FormMouseMove
OnMouseUp = FormMouseUp
PixelsPerInch = 96
TextHeight = 13
object StatusBar1: TStatusBar
Left = 0
Top = 289
Width = 567
Height = 18
Panels = <
item
Width = 150
end
item
Width = 50
end>
end
object ScrollBox1: TScrollBox
Left = 0
Top = 0
Width = 567
Height = 289
Align = alClient
TabOrder = 1
object Source_Image: TImage
Left = 0
Top = 0
Width = 297
Height = 285
Align = alLeft
AutoSize = True
OnMouseDown = FormMouseDown
OnMouseMove = FormMouseMove
OnMouseUp = FormMouseUp
end
object Dest_Image: TImage
Left = 297
Top = 0
Width = 264
Height = 285
Align = alLeft
end
end
end
单元代码:GraphWin.pas
unit GraphWin;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, ExtCtrls, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
ScrollBox1: TScrollBox;
Source_Image: TImage;
Dest_Image: TImage;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Drawing: Boolean;
StarPoint, MovePt: TPoint;
procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
end;
var
Form1: TForm1;
implementation
uses Clipbrd;
{$R *.dfm}
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drawing := True;
Source_Image.Canvas.MoveTo(X, Y);
StarPoint := Point(X, Y);
MovePt := StarPoint;
StatusBar1.Panels[0].Text := Format('起点坐标: (%d, %d)', [X, Y]);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Width,Height : Integer;
NewBitmap : TBitmap;
begin
if Drawing then
begin
DrawShape(StarPoint, Point(X, Y), pmCopy);
Drawing := False;
Dest_Image.Canvas.Rectangle(X,Y,StarPoint.X,StarPoint.Y);
Width := abs(StarPoint.X-X);
Height := abs(StarPoint.Y-Y);
Dest_Image.Width := Width;
Dest_Image.Height := Height;
NewBitmap:=Tbitmap.create;
NewBitmap.Width := Width; //设置NewBitmap的长宽
NewBitmap.Height := Height;
NewBitmap.Canvas.CopyRect
(Rect(0,0,Width,Height),Source_Image.Canvas,
Rect(StarPoint.X,StarPoint.Y,X,Y));//拷贝Source_Image中的矩形区域
Dest_Image.Picture.Bitmap := NewBitmap;//放到的Dest_Image上
Clipboard.Assign(Dest_Image.Picture);//把Dest_Image中的图象复制到剪贴板
//把图片从剪贴板粘贴到Dest_Image
//Dest_Image.Picture.LoadFromClipBoardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);
NewBitmap.Free; //释放Bitmap
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Source_Image.Canvas.Brush.Style :=bsClear;
if Drawing then
begin
DrawShape(StarPoint, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(StarPoint, MovePt, pmNotXor);
end;
StatusBar1.Panels[1].Text := Format('目前坐标: (%d, %d)', [X, Y]);
end;
procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
Source_Image.Canvas.Pen.Mode := AMode;
Source_Image.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Source_Image.Canvas.Brush.Style :=bsClear;
Source_Image.Picture.LoadFromFile('C:/xx.bmp');
end;
end.