Главная страница
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.047 c
15-1144533375
Yanis
2006-04-09 01:56
2006.04.30
Подскажите программу


1-1143183057
Iton
2006-03-24 09:50
2006.04.30
Текст в HTML


2-1145002346
KyRo
2006-04-14 12:12
2006.04.30
Проблемы с реестром


2-1144660370
Sania
2006-04-10 13:12
2006.04.30
Как снять Explorer с автозапуска


4-1139414502
AllDer
2006-02-08 19:01
2006.04.30
много форм несделать