怎样让矩形shape在IMAGE1区域内随鼠标移动，并鼠标双击,截取矩形shape内的图象到image2

Question

怎样让矩形shape在image1区域内随鼠标移动，当鼠标双击,截取矩形shape内的图象到image2上显示???

Answer 1

这个还是非常简单的, 不过如果你不熟悉, 要一步一步地来:
1. 在Image上显示一个shape; //这个对你应该是很简单的了;
2. 获取光标在image上的按下,移动,双击的事件; 特别是在移动事件中更新shape的位置;
   这个也简单, 不过你可能要花点功夫;
3. 下面一个问题就是根据shape的位置来截取部分图片, 这个相对2就简单一些了;
4. 当然, 程序代码中要注意一些问题: 
   例如shape在image上面, shape区域是没有image鼠标事件的;
   还有就是: shape移动和image重新刷新显示的问题;

Answer 2

补充一点 shape 没有公开双击事件，你可以自己写一个，把事件公开出来，也可以通过
GetDoubleClickTime 来判断两次单击的事件是否小于双击时间，如果是则执行操作

Answer 3

你这种方式不好。
其实可以拦截窗体所有消息，过滤一下得到双击消息，然后再判断鼠标是不是在Shape区域.楼主要的功能很好实现，思路上面已经有人讲了，楼主不要等着别人给你写好代码，要自己动手，才能提高。

Answer 4

回家太无聊了，帮你写个，unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,pngimage,
  Dialogs, ExtCtrls;type
  TForm1 = class(TForm)
    shp1: TShape;
    img1: TImage;
    img2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure shp1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure shp1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure shp1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    FDown : Boolean;
    FPoint : TPoint;
    FCopyRect : TRect;
  public
   procedure MyMessage(var Msg: TMsg; var Handled: Boolean); { Public declarations }
   procedure CopyBmpByRect(sDc,dDc : HDC);
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := MyMessage;
  FDown := False;
  DoubleBuffered := True;
end;procedure TForm1.MyMessage(var Msg: TMsg; var Handled: Boolean);
  var FRect :TRect;
begin
  case Msg.message of
    WM_LBUTTONDBLCLK  :
    begin
      FRect := Rect(Left + shp1.Left,top  + shp1.Top,Left + shp1.Left + shp1.Width,top + shp1.Top + shp1.Height);
      if PtInRect(FRect,Msg.pt) then
        CopyBmpByRect(img1.Canvas.Handle,img2.Canvas.Handle);
    end;
  end;
end;procedure TForm1.shp1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if button <> mbleft then exit;
  FDown := true;
  FPoint.x := X;
  FPoint.Y := Y;
end;procedure TForm1.shp1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button <> mbleft then Exit;
  FDown := False;
end;procedure TForm1.shp1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not FDown then Exit;
  TControl(Sender).Left := TControl(Sender).Left + X - FPoint.X;
  TControl(Sender).Top := TControl(Sender).Top + Y - FPoint.Y;
  FCopyRect := Rect(TControl(Sender).Left - img1.Left,TControl(Sender).Top - img1.Top,TControl(Sender).Width,TControl(Sender).Height);
end;procedure TForm1.CopyBmpByRect(sDc, dDc: HDC);
begin
  StretchBlt(dDc,0,0,FCopyRect.Right,FCopyRect.Bottom,sDc,FCopyRect.Left,FCopyRect.Top,FCopyRect.Right,
             FCopyRect.Bottom,SRCCOPY );
  img2.Repaint;
end;end.
你自己再完善一下，在移动时没有控制范围。。

Answer 5

呵呵 不献丑了 我写的比较麻烦 自己画的区域 用timer事件控制的

Answer 6

 
mdejtod （能给点代码的说明吗？我比较不熟）
  按你这个，双击shp1，两个image都白了（shp1是白色）
 还有就是，在哪限制shp1的范围？
（我是想要 拖动不出某个区域
我在
procedure TTntForm1.Shp1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if shp1.Left<img1.Left then shp1.Left:=img1.Left;//1
  if shp1.Left>(img1.Left+img1.Width-shp1.Width) then shp1.Left:=img1.Left+img1.Width-shp1.Width;//2  
  if shp1.top<img1.top then shp1.top:=img1.top;//3
  if shp1.top>(img1.top+img1.Height-shp1.Height) then shp1.top:=img1.top+img1.Height-shp1.Height;//4
  if Button <> mbleft then Exit;
  FDown := False;
end;
我这样限制还是可以拉到img1外面，效果是弹回来
要怎么限制不能拖出img1？？*********************
）

Answer 7

在mousemove时限制范围，就是计算的事
Shp1的brush设置为 bsclear...

Answer 8

为什么要用控件呢，直接画一个更简单,把Canvas.Pen.Mod：=pmXor
MouseMove(......)
begin
  if DownFlag then
  begin
     用Moveto LineTo 画矩形A
     计算矩形B
     用线画移动后的矩形B
    A:=B;
  end;
end;

Answer 9

鼠标拖拽：procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if sender is Timage then
    image1.BeginDrag(True,1);
end;procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if source is Timage then
    Accept:=True;
end;procedure TForm1.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if source is Timage then
  begin
    Timage(source as Timage).Left:=x;
    timage(source as Timage).Top := y;
  end;
end;