Форум: "Начинающим";
Текущий архив: 2006.04.30;
Скачать: [xml.tar.bz2];

Вниз

Перетаскивания   Найти похожие ветки 

← →
Михаил (Киров) ©   (2006-04-10 17:09) [0]

Мастера, помогите! Как реализовать перетаскивание объекта по форме? Например, как сделать так, чтобы пользователь мог переместить TImage с места на место мышкой. Причём эта картинка не вылезала за заранее определённые определённые рамки. Заранее спасибо.

---

← →
mlm68 ©   (2006-04-12 23:25) [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.

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.04.30;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.016 c