Передвижение компонентов по форме

[murads60]

В delphi перемещение кнопки или любого другого компонента производиться с помощью
Panel1.Perform(WM_SysCommand, $F012, 0);
пытаюсь повторить тоже самое в lazarus но элементы стоят как вкопанные при компиляции все норм. что не так ?
ниже приведен код на delphi все работает на lazarus нет
OS:Windows 7 x86; lazaruz 0.9.30.2 (fpc 2.4.4)

Код: Выделить всё

unit Unit1; 

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)

    Panel1: TPanel;
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
const
  SC_DragMove = $F012;
begin
 ReleaseCapture;
 Panel1.Perform(WM_SysCommand, SC_DragMove, 0);
end;                       
end.

[B4rr4cuda]

Как раз на этой неделе решал подобную задачу, наваял для этого дела небольшой класс:

Код: Выделить всё

unit umovemanager;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Controls, ExtCtrls;

type
 TMouseProc = procedure (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;

 TMoveControl=class(TControl)
 published
   property OnMouseDown;
   property OnMouseUp;
 end;

 TMoveObj = class
   MoveObject:TControl;
   MouseDown:TMouseProc;
   MouseUp:TMouseProc;
 end;

 { TMoveManager }

 TMoveManager = class(TList)
 private
    FOwner: TComponent;
    FCurControl:TControl;
    Ftimer:TTimer;
    lcoor, tcoor : integer;
    MyMouse: TMouse;
    function GetItem(Index: Integer): TMoveObj;
    Procedure SetItem(Index: Integer; AObject: TMoveObj);
    procedure MoveManagerMouseDown(Sender: TObject; Button: TMouseButton;
                                   Shift: TShiftState; X, Y: Integer);
    procedure MoveManagerMouseUp(Sender: TObject; Button: TMouseButton;
                                   Shift: TShiftState; X, Y: Integer);
    procedure TimerProc(Sender: TObject);
 public
   constructor Create(AOwner:TComponent);
   destructor Destroy; override;
   function Add(AObject: TControl): Integer;
   function IndexOf(AObject: TObject): Integer;
   property Items[Index: Integer]: TMoveObj read GetItem write SetItem; default;
 end;

implementation

function TMoveManager.GetItem(Index: Integer): TMoveObj;
begin
  Result:=TMoveObj(inherited Get(Index));
end;

procedure TMoveManager.SetItem(Index: Integer; AObject: TMoveObj);
begin
 inherited put(Index,AObject);
end;

procedure TMoveManager.MoveManagerMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var mvObj:TMoveObj;
    Ind:integer;
begin
  ind:=Self.IndexOf(Sender);
  if ind>-1 then begin
    mvObj:=Items[ind];
    if Assigned(mvObj.MouseDown) then
      mvObj.MouseDown(Sender,Button,Shift,x,y);

    FCurControl:=mvObj.MoveObject;
    lcoor := MyMouse.CursorPos.x - FCurControl.left;
    tcoor := MyMouse.CursorPos.y - FCurControl.top;
    Ftimer.Enabled:= true;
  end;
end;

procedure TMoveManager.MoveManagerMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var mvObj:TMoveObj;
    Ind:integer;
begin
  ind:=Self.IndexOf(Sender);
  if ind>-1 then begin
    mvObj:=Items[ind];
    if Assigned(mvObj.MouseUp) then
      mvObj.MouseUp(Sender,Button,Shift,x,y);
    Ftimer.Enabled:= false;
    FCurControl:=nil;
  end;
end;

procedure TMoveManager.TimerProc(Sender: TObject);
var tp:TPoint;
begin
  tp.x:=MyMouse.CursorPos.x - lcoor;
  tp.y:=MyMouse.CursorPos.y - tcoor;

  if Assigned(FCurControl) then begin
    FCurControl.Left:=tp.x;
    FCurControl.Top:=tp.y;
  end;
end;

constructor TMoveManager.Create(AOwner: TComponent);
begin
 FCurControl:=nil;
 FOwner:=AOwner;
 Ftimer:=TTimer.Create(FOwner);
 Ftimer.Enabled:=false;
 Ftimer.Interval:=40;
 Ftimer.OnTimer:=@TimerProc;

 inherited Create;
end;

destructor TMoveManager.Destroy;
begin
  FreeAndNil(Ftimer);
  inherited Destroy;
end;

function TMoveManager.Add(AObject: TControl): Integer;
var MvObj:TMoveObj;
begin
  //кроме забивки своих обработчиков надо сохранить оригинальные
  MvObj:=TMoveObj.Create;

  MvObj.MoveObject:=AObject;
  MvObj.MouseDown:=TMoveControl(AObject).OnMouseDown;
  MvObj.MouseUp:=TMoveControl(AObject).OnMouseUp;
  TMoveControl(AObject).OnMouseDown:=@MoveManagerMouseDown;
  TMoveControl(AObject).OnMouseUp:=@MoveManagerMouseUp;
  result:=inherited Add(MvObj);
end;

function TMoveManager.IndexOf(AObject: TObject): Integer;
var i:integer;
begin
   for i:=0 to Self.Count-1 do
     if Assigned(items[i]) then begin

       if items[i].MoveObject = AObject then
         begin
           Result:=i;
           Exit;
         end;
     end;
   Result:=-1;
end;
end.

Пользоваться проще некуда:

Код: Выделить всё

procedure TForm1.FormCreate(Sender: TObject);
begin
  MoveManager:=TMoveManager.Create(Form1);
  MoveManager.Add(Label1);
  MoveManager.Add(Panel1);
  MoveManager.Add(Button1);
end;

[murads60]

благодарю все работает правда движение рывками

[B4rr4cuda]

Можно интервал таймера в TMoveManager.Create уменьшить до 20 где-то.. будет плавнее.

[murads60]

ех хотелось бы описание подробное как все это добро работает

[B4rr4cuda]

Может еще и диплом за вас сделать?
Имхо, там все более чем элементарно..

[BIT]

Как раз на этой неделе решал подобную задачу, наваял для этого дела небольшой класс:

Все работает тоже понравилось сохранил у себя спасибо!)