关于Image的问题,高手进来,在线等待立即给分(80分)

  • 主题发起人 主题发起人 pgp
  • 开始时间 开始时间
P

pgp

Unregistered / Unconfirmed
GUEST, unregistred user!
我有一from上有一Image我想在运行时能移动它,并且有一个虚框,请问如何解决,请给出
代码,如解决立即给分
 
移动TImage,并显示虚线:
在Form 中放置一 TImage,并装入图片。
同时在Form 单元中声明以下变量:
OP,ImgP:TPoint;
IsMoving:Boolean=false;
定义TImage 的三个事件处理过程:
OnMouseDown,OnMouseMove,OnMouseUp

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
OP,ImgP:TPoint;
IsMoving:Boolean=false;

implementation

{$R *.DFM}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ImgP:=Point(Image1.Left,Image1.top);
OP:=point(IMgP.x+x,ImgP.y+y);
IsMoving:=true;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not(IsMoving) then exit;
Image1.left:=ImgP.x+x-OP.x+Image1.left;
Image1.top :=ImgP.y+y-OP.y+Image1.top;
refresh;
canvas.Pen.Color:=clBlack;
canvas.Pen.style:=psDash;
canvas.Brush.style:=bsClear ;
canvas.Rectangle(Image1.left-2,Image1.top-2,
Image1.left+image1.width+2,Image1.top+Image1.Height+2);
end;

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

end.
 
var //全局变量
can :bool ;
oldx,oldy :integer ;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
can :=true ;
oldx :=x;
oldy :=y;
end;



procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if can then
if (oldx<>x) or (oldy<>y) then
begin
image1.Top :=image1.Top-oldy+y ;
image1.Left :=image1.Left-oldx+x ;
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
can :=false ;
end;
这就可以移动了,虚框的实现比较容易,在MouseMove事件中
画IMAGE大小的虚线框就行了。
 
gzdsfssfdadsf
 
后退
顶部