Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2007.11.04;
Скачать: [xml.tar.bz2];

Вниз

Переместить объект на форме   Найти похожие ветки 

 
snake-as   (2007-10-11 15:17) [0]

Здравствуйте, эксперты.
Подскажите, пожалуйста, как во время выполнения программы перетащить некоторый объект, например Shape и узнать его начальные и конечные координаты.
Буду очень благодарен.                                    Сергей.


 
AIK ©   (2007-10-11 15:36) [1]

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls;

type
 TForm1 = class(TForm)
   Shape1: TShape;
   procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
   procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);

 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

var x0,y0:integer;
move:boolean;
rec: TRect;

{$R *.dfm}

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
  if button<>mbLeft then move:=false
  else begin
     move:=true;
     x0:=x;
     y0:=y;
end;
end;
procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
  if move then
     with rec do begin
        left:=Left+x-x0;
        top:=Top+y-y0;
        right:=right+x-x0;
        bottom:=bottom+y-y0;
        x0:=x;
        y0:=y;
 end;
end;

procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin

  with Shape1 do begin
     setbounds(rec.left+x-x0,rec.top+y-y0,width,height);
     move:=false;
  end;
end;
end.


Скопнул в одном сайте непомню в каком


 
Ping   (2007-10-11 15:43) [2]

var x0,y0:integer;
move:boolean;
rec: TRect;


кул...

if move then

кул!...

Скопнул в одном сайте непомню в каком

Это хорошо, что ты забыл. Не ходи туда больше.


 
AIK ©   (2007-10-11 15:51) [3]

Непонял что тебя неустраивает?


 
@!!ex ©   (2007-10-11 15:55) [4]

> [2] Ping   (11.10.07 15:43)

Нормальное решение, не идеальное и с багами, вы можете предложить лучше или просто так наезжаете?


 
Leonid Troyanovsky ©   (2007-10-11 16:08) [5]


> AIK ©   (11.10.07 15:51) [3]

> @!!ex ©   (11.10.07 15:55) [4]

http://groups.google.com/group/borland.public.delphi.vcl.components.using/msg/f381a3a399b93b01
http://groups.google.com/group/borland.public.delphi.language.delphi.win32/msg/3fde0567b807cac8

--
Regards, LVT.


 
tytus   (2007-10-11 16:09) [6]

procedure TForm1.ListViewMouseDown(Sender: TObject;
 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
LVSector.Perform(WM_SYSCOMMAND,$F012,0);
end;

как видно тут не Shape, но какая разница!
а определить координаты  - по MouseUp - конечные, ... блин... а как же определить начальные -))?


 
tytus   (2007-10-11 16:13) [7]

сорри
procedure TForm1.LVSectorMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

LVSector- TListView!


 
@!!ex ©   (2007-10-11 16:14) [8]

> [5] Leonid Troyanovsky ©   (11.10.07 16:08)

Да это понятно.
просто я против наездов без контрпримера.
Если наезжаешь, так докажи, приведи свой код.


 
Leonid Troyanovsky ©   (2007-10-11 16:22) [9]


> @!!ex ©   (11.10.07 16:14) [8]

> просто я против наездов без контрпримера.

Глобальные переменные - MD.
Некузяво мешать свои идентификаторы с дельфийскими.

--
Regards, LVT.


 
Ping   (2007-10-11 16:22) [10]

не идеальное и с багами

Он так и сделает. И впредь будет делать.

Если наезжаешь, так докажи, приведи свой код.

Все знают, что детские рисунки - это не больше, чем просто детские рисунки. Для этого не надо ходить в картинную галерею.

И заметь - я нигде не наезжал. Я акцентировал внимание на потенциально "нехороших" местах. Наехал, в данном случае - ты.


 
AIK ©   (2007-10-11 16:27) [11]


> а определить координаты  - по MouseUp - конечные, ... блин.
> .. а как же определить начальные -))?


procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
  if button<>mbLeft then move:=false
  else begin
     move:=true;
     x0:=x;
     y0:=y;
     rec:=Shape1.BoundsRect;
end;
end;



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

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

Наверх




Память: 0.47 MB
Время: 0.041 c
11-1175550542
nsvi
2007-04-03 01:49
2007.11.04
Не могу найти пакет KOLNTprivileges, про который пишет в своей кн


2-1192368884
Blind Guardian
2007-10-14 17:34
2007.11.04
Странная штука с записью и чтением в и из файла


15-1191601109
редкий гость
2007-10-05 20:18
2007.11.04
проблемка с php


2-1192236766
Andrey_rus
2007-10-13 04:52
2007.11.04
MoveRect?


5-1162640276
ratas
2006-11-04 14:37
2007.11.04
Новый компонент на основе TTrackBar





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский