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

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

pgp

Unregistered / Unconfirmed
GUEST, unregistred user!
我有一from上有一Image我想在运行时能移动它,并且有一个虚框,请问如何解决,请给出
代码,如解决立即给分
 
把TImage的DragMode属性设为dmAutomatic,DragKind属性设为dkDrag.这样可以拖动了。
如果你要让它在新的位置安家。就得处理TForm的OnDragDrop事件。
代码:
 
试试移动时用canvas……画一个带虚点的框,移动完毕是取消框!
 
1,定义全局变量,dx,dy
2、设image.Dragmode为dmAutomatic
3,.Image的OnStartDrag中初始化 dx,dy (dx:=-1000,dy:=-1000),设form.canvas.pen.Mode :=pmNotXor;
4,在form的OnDragOver中的代码(我没画虚线,画的方型)
form1.Canvas.Rectangle(dx-image1.Width div 2,dy-image1.Height div 2, dx+image1.Width div 2,dy+image1.Height div 2);
dx:=x;
dy:=y;
form1.Canvas.Rectangle(dx-image1.Width div 2,dy-image1.Height div 2, dx+image1.Width div 2,dy+image1.Height div 2);
5,form的Ondragdrop中放置image
image1.Left :=dx-image1.Width div 2;
image1.Top :=dy-image1.height div 2;

6看效果还凑乎,不过方法有点笨

 
移动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.
 
后退
顶部