Перетаскивания [D7, WinXP]
Михаил (Киров) © (2006-04-10 17:09:00)
Мастера, помогите! Как реализовать перетаскивание объекта по
форме? Например, как сделать так, чтобы пользователь мог
переместить TImage с места на место мышкой. Причём эта картинка не
вылезала за заранее определённые определённые рамки. Заранее
спасибо.
mlm68 (2006-04-12 23:25:00) [1]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,
jpeg, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
procedure Image1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject;
Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Push: boolean;
x1,y1,l1,t1,l2,t2:integer;
implementation
{$R *.DFM}
procedure TForm1.Image1MouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Push:=true;
x1:=mouse.CursorPos.x;
y1:=mouse.CursorPos.y;
l1:=image1.Left;
t1:=image1.Top;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Push:=false;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift:
TShiftState; X,
Y: Integer);
begin
if Push then begin
l2:=l1+mouse.CursorPos.x-x1;
t2:=t1+mouse.CursorPos.y-y1;
if l2<0 then l2:=0;
if t2<0 then t2:=0;
if l2+image1.Width>form1.ClientWidth then
l2:=form1.ClientWidth-Image1.Width;
if t2+image1.Height>form1.ClientHeight then
t2:=form1.ClientHeight-Image1.Height;
image1.Left:=l2;
image1.Top:=t2
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.DoubleBuffered:=true;
end;
end.
Наверх 
ЧАТ |
Орешник |
|
