图形问题，请图形方面的高手进来一下 ( 积分: 50 )

我想在image上画线，就像photoshop的套索那样，划出不规则的一块。然后将其copy到另一个image上，我代码如下：
private
p1:TPoint;
p2:TPoint;
capture:boolean;
movex,movey:integer;

procedure Thair_frm.imageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
hair_frm.DoubleBuffered:=true;
p1.X:=x;
p1.Y:=y;
p2.X:=x;
p2.Y:=y;
capture:=true;

setcapture(handle);

image.Canvas.Pen.Color:=clred;
image.Canvas.Pen.Style:=pssolid;
image.Canvas.Brush.Color:=clred;
image.Canvas.Brush.Style:=bssolid;
image.Canvas.MoveTo(x,y);
end;

procedure Thair_frm.imageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin //连线
if capture then
begin
hair_frm.DoubleBuffered:=true;
image.Canvas.Pen.Mode:=pmNotXor ;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
p2.X:=x;
p2.Y:=y;
movex:=x;
movey:=y;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
end;

procedure Thair_frm.imageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
p2.X:=x;
p2.Y:=y;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
end;

我想在image上画线，就像photoshop的套索那样，划出不规则的一块。然后将其copy到另一个image上，我代码如下：
private
p1:TPoint;
p2:TPoint;
capture:boolean;
movex,movey:integer;

procedure Thair_frm.imageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
hair_frm.DoubleBuffered:=true;
p1.X:=x;
p1.Y:=y;
p2.X:=x;
p2.Y:=y;
capture:=true;

setcapture(handle);

image.Canvas.Pen.Color:=clred;
image.Canvas.Pen.Style:=pssolid;
image.Canvas.Brush.Color:=clred;
image.Canvas.Brush.Style:=bssolid;
image.Canvas.MoveTo(x,y);
end;

procedure Thair_frm.imageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin //连线
if capture then
begin
hair_frm.DoubleBuffered:=true;
image.Canvas.Pen.Mode:=pmNotXor ;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
p2.X:=x;
p2.Y:=y;
movex:=x;
movey:=y;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
end;

procedure Thair_frm.imageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
p2.X:=x;
p2.Y:=y;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
end;

哪位仁兄帮个忙？

参考http://www.delphibbs.com/delphibbs/dispq.asp?LID=571524
最后区域拷贝

procedure TViewImgForm.ImageMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
SaveColor : TColor;
SaveStyle : TPenStyle;
SaveMode : TPenMode;
begin
if IplImage <> nil then
if Button = mbLeft then
begin
FMoving := True;
Screen.Cursor := crHandPoint;
if (CurX <> StartX) or (CurY <> StartY) then
begin
SaveColor := Image.Canvas.Pen.Color;
SaveStyle := Image.Canvas.Pen.Style;
SaveMode := Image.Canvas.Pen.Mode;
Image.Canvas.Pen.Color := clBlack;
Image.Canvas.Pen.Style := psDot;
Image.Canvas.Pen.Mode := pmNotXor;
Image.Canvas.Polyline([Point(StartX,StartY),Point(StartX,CurY),
Point(CurX,CurY),Point(CurX,StartY),Point(StartX,StartY)]);
Image.Canvas.Pen.Color := SaveColor;
Image.Canvas.Pen.Style := SaveStyle;
Image.Canvas.Pen.Mode := SaveMode;
end;
StartX := X;
StartY := Y;
CurX := X;
CurY := Y;
end;
end;

procedure TViewImgForm.ImageMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
A : Integer;
P : PByte;
S : string;
SaveColor : TColor;
SaveStyle : TPenStyle;
SaveMode : TPenMode;
begin
if (ssLeft in Shift) and (FMoving) then
begin
X := MinIntValue([IplImage^.Width-1,X]);
X := MaxIntValue([0,X]);
Y := MinIntValue([IplImage^.Height-1,Y]);
Y := MaxIntValue([0,Y]);
SaveColor := Image.Canvas.Pen.Color;
SaveStyle := Image.Canvas.Pen.Style;
SaveMode := Image.Canvas.Pen.Mode;
Image.Canvas.Pen.Color := clBlack;
Image.Canvas.Pen.Style := psDot;
Image.Canvas.Pen.Mode := pmNotXor;
Image.Canvas.Polyline([Point(StartX,StartY),Point(StartX,CurY),
Point(CurX,CurY),Point(CurX,StartY),Point(StartX,StartY)]);
CurX := X;
CurY := Y;
Image.Canvas.Polyline([Point(StartX,StartY),Point(StartX,Y),
Point(X,Y),Point(X,StartY),Point(StartX,StartY)]);
Image.Canvas.Pen.Color := SaveColor;
Image.Canvas.Pen.Style := SaveStyle;
Image.Canvas.Pen.Mode := SaveMode;
end
end;

procedure TViewImgForm.ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin

if Button = mbLeft then
begin
if FMoving then
begin
CurX := X;
CurY := Y;
Screen.Cursor := crDefault;
FMoving := False;
Image.Canvas.Polyline([Point(StartX,StartY),Point(StartX,Y),
Point(X,Y),Point(X,StartY),Point(StartX,StartY)]);
end;
end;
end;

to chenybin
你那个是画矩形的，我想要的是不规则的图像。

还是用Polyline，修改一下代码，保存点击的列表，到一个TPoint的数组里面

用双击表示选取完毕就可以了

然后用PolyLine画那个数组里面的东西

Polyline中的point(x,y)是不定的，用户不一定点多少下呢，要是定义个数组应该定多大啊？

到时候设置SetLenth就可以了，动态数组，而且用户会点1000下吗？应该不会这么辛苦吧

那在mousedown中的mouse第一次down时的坐标怎么记录？我需要在第n次down时dbclick中与第一次的相连接。不会做

说个思路吧，一个全局变量，记录当前是否出于选取状态，比如bSelected，bFirst表示是否是第一个点，一个全局的数组Points : array of TPoint;

第一次点击的时候设置bSelected := True;如果Points为空则添加一个点，SetLength(Points, 1);记录第一个点 Points[0]， 否则不添加点

在鼠标移动的时候从Points里面取点，然后MoveTo，LineTo，把线画出来，最后一条线，主要是为了画效果

在鼠标起来的时候判断bSelected为True SetLength(Points, 加1), 把最后的点放进去
双击的时候设置SetLength(Points, 加1)

双击的时候把最后的点加进去，设置bSelected = False，然后循环画线，记得循环的时候最后一点是起始点，如果是多边形，则需要把第一点加回去，形成闭合区域，最后设置SetLength(Points, 1)

这里的bSelected通常是一个枚举状态量，比如选取，比如画线，比如画点等等

思路比较粗糙，懒得写代码了，供参考

to chenybin
根据你的思路我改写了一下我下面的代码，双击后是与第一鼠标点连上了，但移动鼠标时线还是有，没法解决，还有怎样将框内图象考到另一image内啊？
private
p1:TPoint;
p2:TPoint;
firstx,firsty:integer;
capture:boolean;
implementation

{$R *.dfm}

{ TForm1 }
procedure Thair_frm.imageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (p1.X=0) then
begin
firstx:=x;
firsty:=y;
end;

hair_frm.DoubleBuffered:=true;
p1.X:=x;
p1.Y:=y;
p2.X:=x;
p2.Y:=y;
capture:=true;

setcapture(handle);

image.Canvas.Pen.Color:=clred;
image.Canvas.Pen.Style:=pssolid;
image.Canvas.Brush.Color:=clred;
image.Canvas.Brush.Style:=bssolid;
image.Canvas.MoveTo(x,y);
end;

procedure Thair_frm.imageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin //连线
if capture then
begin
hair_frm.DoubleBuffered:=true;
image.Canvas.Pen.Mode:=pmNotXor ;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
p2.X:=x;
p2.Y:=y;
movex:=x;
movey:=y;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
end;

end;

procedure Thair_frm.imageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
p2.X:=x;
p2.Y:=y;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
end;

procedure Thair_frm.imageDblClick(Sender: TObject);
begin
capture:=false;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
p2.X:=firstx;
p2.Y:=firsty;
image.Canvas.MoveTo(p1.X,p1.Y);
image.Canvas.LineTo(p2.X,p2.Y);
capture:=false;
//showmessage(BoolToStr(capture)); //在此加这条语句和不加的画线结果差异很大
end;

如果说要实现类PHOTOSHOW的虚线的话，我记得是２００４年的第二期发表过一篇陈絮的《PHOTOSHOP流动型选取边框》一文的，可找来借鉴一下的，如果找不到，就看另一个人如何用.NET来实现这个功能的，我想原理是一样的.
http://www.cstc.net.cn/docs/docs.php?id=248

to app2001:
我看了那篇<C#实现PHOTOSHOP流动型选取边框>的文章,不过它好象说的是选取的矩形,而我所要的是不规则图象.

好好再网上用“antline”为关键词找吧，任意形状都有！

还有些问题，不过实在不想写了，看看有没有参考价值

unit Main;

interface

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

type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Button1: TButton;
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PaintBox1DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
bSelected: Boolean;
SelectedPoints: array of TPoint;
nPointCount: Integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if bSelected then begin
// 就第一次用一下，以后都可以不用
if nPointCount = 0 then begin
Inc(nPointCount);
SetLength(SelectedPoints, nPointCount);
SelectedPoints[nPointCount - 1] := Point(X, Y);
end;
end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
startP, EndP: TPoint;
begin
// 在鼠标移动的时候从Points里面取点，然后MoveTo，LineTo，把线画出来
if bSelected then begin
if nPointCount < 2 then exit;
startP := TPoint(SelectedPoints[nPointCount - 2]);
EndP := TPoint(SelectedPoints[nPointCount - 1]);
with PaintBox1.Canvas do begin
MoveTo(startP.X, startP.Y);
LineTo(EndP.X, EndP.Y);
end;
end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// 鼠标起来的时候添加点
if bSelected then begin
Inc(nPointCount);
SetLength(SelectedPoints, nPointCount);
SelectedPoints[nPointCount - 1] := Point(X, Y);
end;
end;

procedure TForm1.PaintBox1DblClick(Sender: TObject);
var
I: Integer;
P: TPoint;
begin

// 首尾相连
Inc(nPointCount);
SetLength(SelectedPoints, nPointCount);
SelectedPoints[nPointCount - 1] := SelectedPoints[0];

// 画多边形
PaintBox1.Canvas.Polyline(SelectedPoints);

for I := 0 to nPointCount - 1 do begin
with PaintBox1.Canvas do begin
P := SelectedPoints;
TextOut(P.X, P.Y, IntToStr(I + 1));
end;
end;

// 初识设置
SetLength(SelectedPoints, 0);
nPointCount := 0;
bSelected := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
bSelected := True;
end;

end.


object Form1: TForm1
Left = 190
Top = 107
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object PaintBox1: TPaintBox
Left = 92
Top = 32
Width = 393
Height = 325
OnDblClick = PaintBox1DblClick
OnMouseDown = PaintBox1MouseDown
OnMouseMove = PaintBox1MouseMove
OnMouseUp = PaintBox1MouseUp
end
object Button1: TButton
Left = 272
Top = 400
Width = 75
Height = 25
Caption = '开始选择'
TabOrder = 0
OnClick = Button1Click
end
end

但怎么将其中的图像Copy到别一个Image或Paintbox中呢？

用CreatePolygonRgn建立区域，然后把它画出来，这分真难挣[]

然后参考
http://www.delphibbs.com/delphibbs/dispq.asp?lid=639148
－－－－－－－－－－－－－－－－－－－－－－－－转自网络
procedure TForm1.Button2Click(Sender: TObject);
var
Bmp :TBitmap;
FRgn :HRGN;
begin
Bmp :=TBitmap.Create;
Bmp.PixelFormat :=Image1.Picture.Bitmap.PixelFormat;
Bmp.Width :=100;
Bmp.Height :=100;
BitBlt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,Image1.Canvas.Handle,80,80,SRCCOPY); //要拷贝的位图
FRgn :=CreateEllipticRgn(0,0,100,100);
SelectClipRgn(Image1.Canvas.Handle,FRgn);
Image1.Canvas.Draw(0,0,Bmp);
Bmp.Free;
DeleteObject(FRgn);
end;

to chenybin
呵呵 ，不会啊，以前没学过图形方面的，请勿见怪
你上面关于调用GDI32的函数BITBLT我看了，是画矩形的。也把其它关于GDI的函数看了一下，但没有发现怎样拷不规则图形。还望你能再指点一二，万分感谢

[blue]用CreatePolygonRgn建立区域，然后把它画出来，这分真难挣[/blue]
多边形

然后把下面的替换了
[blue]FRgn :=CreateEllipticRgn(0,0,100,100);
SelectClipRgn(Image1.Canvas.Handle,FRgn);
Image1.Canvas.Draw(0,0,Bmp); [/blue]

但这句还是画的的是矩形的啊
BitBlt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,Image1.Canvas.Handle,80,80,SRCCOPY); //要拷贝的位图
依然如此!