怎样让image2在image1范围内拖动?(100分)

W

wengmxj

Unregistered / Unconfirmed
GUEST, unregistred user!
下面这段代码,image2不到image1边缘时可以随意拖动,当image2到达image1的边缘后不能
再往相反方向拖动,谁能帮助我修改一下?
procedure TChildF.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if fdrag then
begin
if (image2.Left+image2.Width)<(image1.Left+image1.Width) then
if (image2.Left>image1.Left) then
Timage(sender).Left :=Timage(sender).Left +x-oldx;
if (image2.top+image2.height)<(image1.top+image1.height) then
if (image2.top>image1.top) then
Timage(sender).top :=Timage(sender).top +y-oldy;
end;
end;
 
以下是完整代码:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
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;
fdrag:boolean=false;
oldX,OldY:integer;
implementation

{$R *.DFM}

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
dx,dy,L,T,R,B:integer;
tp:tpoint;

begin
if not fdrag then exit;
tp:=image2.clienttoscreen(point(x,y));
dx:=tp.x-OldX;
dy:=tp.y-OldY;

L:=image1.left-image2.left;
T:=image1.top-image2.top;
R:=image1.left+image1.width-image2.left-image2.width;
B:=image1.top+image1.height-image2.top-image2.height;

if ((dx<0) and (dx>=L)) or ((dx>0) and (dx<=R)) then
begin
image2.left:=image2.left+dx;
OldX:=tp.x;
end;

if ((dy<0) and (dy>=T)) or ((dy>0) and (dy<=B))then
begin
image2.top:=image2.top+dy;
OldY:=tp.y;
end;

end;

procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
t:tpoint;
begin
fdrag:=true;
t:=image2.clienttoscreen(point(x,y));
oldx:=t.x;
oldy:=t.y;
end;

procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
fdrag:=false;
end;

end.
 
顶部