Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.04.30;
Скачать: CL | DM;

Вниз

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

 
Михаил (Киров) ©   (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;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.032 c
2-1144998437
nastyok::
2006-04-14 11:07
2006.04.30
Table1.FindKey


15-1144596067
Варяг
2006-04-09 19:21
2006.04.30
Проблема с сеткой и драйвером.


4-1139470430
Хинт
2006-02-09 10:33
2006.04.30
Список библиотек, загруженных чужим процессом


2-1144901581
Rubey
2006-04-13 08:13
2006.04.30
Очистка таблицы


15-1144262820
Hover
2006-04-05 22:47
2006.04.30
Программы для PDA