2014 dxdy logo

Научный форум dxdy

Математика, Физика, Computer Science, Machine Learning, LaTeX, Механика и Техника, Химия,
Биология и Медицина, Экономика и Финансовая Математика, Гуманитарные науки




Начать новую тему Ответить на тему
 
 Перемещение на форме фигур
Сообщение06.05.2013, 16:02 


09/04/13
20
Здравствуйте. Есть код для перемещения объектов TShape на форме. Как сделать,чтобы вмечто фигур можно было перемещать картинки в Image? Помогите, пожалуйста, разобраться.
Код:
unit Main;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Buttons;

type
  TMainForm = class(TForm)
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    BitBtn1: TBitBtn;
    procedure ShapeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
    procedure ShapeMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    procedure ShapeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    Dragging: Boolean;          { Drag operation in progress flag }
    XOffset, YOffset: Integer;  { Offsets from shape upper left }
    FocusRect: TRect;           { Dotted outline while dragging }
    PS: TShape;                 { Reference to shape dragging }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.ShapeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
  Dragging := True;        { Set dragging flag true }
  XOffset := X;            { Keep offsets from shape upper left }
  YOffset := Y;
  PS := Sender as TShape;  { Assign reference to shape }
  with PS do               { Create outline rectangle }
    FocusRect := Rect(Left, Top, Left + Width, Top + Height);
  Canvas.DrawFocusRect(FocusRect);  { Draw outline }
end;

procedure TMainForm.ShapeMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
  if Dragging then  { Move outline only if dragging }
  begin
    Canvas.DrawFocusRect(FocusRect);  { Erase outline }
    with FocusRect do
    begin  { Move outline rectangle }
      Left := (PS.Left + X) - XOffset;
      Top := (PS.Top + Y) - YOffset;
      Right := PS.Width + Left;
      Bottom := PS.Height + Top;
    end;
    Canvas.DrawFocusRect(FocusRect);  { Draw outline }
  end;
end;

procedure TMainForm.ShapeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
  if Dragging then  { Move shape only if dragging }
  begin
    Canvas.DrawFocusRect(FocusRect);  { Erase outline }
    Dragging := False;                { Reset flag }
    with Sender as TShape do
    begin  { Move shape to new location }
      Left := (Left + X) - XOffset;
      Top := (Top + Y) - YOffset;
    end;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin Dragging:=False end;

end.

 Профиль  
                  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ 1 сообщение ] 

Модераторы: Karan, Toucan, PAV, maxal, Супермодераторы



Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group