Перетаскивание обьектов

[Witaliy]

Как создать перемещение объектов и их выделения?

[Манжосов Денис :)]

А каких именно объектов?

[Witaliy]

Компонентов

[N!ckeL]

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    b1: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure b1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure b1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure b1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClick(Sender: TObject);
  private
  dow:boolean;
  ox, oy:integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.b1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
form1.Repaint;
form1.Canvas.Rectangle(b1.Left-2, b1.Top-2, b1.Left+b1.Width+2, b1.Top+b1.Height+2);
dow:=true;
ox:=x;
oy:=y;
end;

procedure TForm1.b1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if dow=true then
 begin
   b1.Top:=b1.Top-(oy-y);
   b1.Left:=b1.Left-(ox-x);
   form1.Repaint;
 end;
end;

procedure TForm1.b1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
dow:=true;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
dow:=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
dow:=false;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
dow:=false;
end;

end.

Доработать надо немного...

[Witaliy]

Спасибо всем.

[BOBAH13]

Лучше сделать, систему. Типа класс-коллекции. Делаеш функции удаления, добавления, получения по имени String. Добавлять получается можно любой контрол, т.е. TControl. Каждый пункт можно устроить с помощью типа описателя и списка TList. Тип можно сделать, чтот на подобии

PItemObject = ^TItemObject; 
TItemObject = packed record
  Control: TControl;
end;

TControlClass = class of TControl;

// потом при добавления 
function Add(Name: String; ClassCtrl: TControlClass): Integer;
var
  p: PItemObject;
begin
  new(p);
  p^.Control := Result;
  p^.Control := ClassCtrl.Create(NIL);
  p^.Control.Parent := {ну вместо NIL ставим нужного родителя}NIL;
  p^.Control.Name := Name;
  TList.Add(p);
end;

остальные действия и так ясны... ну еще организуите типа,
по имени ищем как в TStringList - IndexOf ( короче перебираем все пункты и сравниваем имена )

ищем контрол от позиций парента

function ItemAt(X, Y: Integer): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i:= 0 to TList.Count - 1 do
  if PtInRect(Point(X, Y), PItemObject(TList[i])^.Control.BoundsRect) then
  begin
    Result := i;
    Break;
  end;

Ну думаю идея ясна Так можно не замарачиваться над всей системой перетаскивания для каждого компонента. Ну а само движения описали выше

[Witaliy]

И тебе спасибо