Показать сообщение отдельно
  #1  
Старый 06.05.2013, 17:02
Pilyla Pilyla вне форума
Прохожий
 
Регистрация: 09.04.2013
Сообщения: 23
Версия Delphi: Delphi 7
Репутация: 10
Сообщение Перемещение на форме фигур

Здравствуйте. Есть код для перемещения объектов 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.
Ответить с цитированием