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

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

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

Сообщение murads60 » 21.01.2012 23:21:13

В 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.
murads60
новенький
 
Сообщения: 12
Зарегистрирован: 21.01.2012 23:12:01

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

Сообщение B4rr4cuda » 21.01.2012 23:35:32

Как раз на этой неделе решал подобную задачу, наваял для этого дела небольшой класс:
Код: Выделить всё
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;
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

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

Сообщение murads60 » 22.01.2012 11:22:24

благодарю все работает правда движение рывками :)
murads60
новенький
 
Сообщения: 12
Зарегистрирован: 21.01.2012 23:12:01

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

Сообщение B4rr4cuda » 23.01.2012 20:35:31

Можно интервал таймера в TMoveManager.Create уменьшить до 20 где-то.. будет плавнее.
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

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

Сообщение murads60 » 25.01.2012 15:06:48

ех хотелось бы описание подробное как все это добро работает :roll:
murads60
новенький
 
Сообщения: 12
Зарегистрирован: 21.01.2012 23:12:01

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

Сообщение B4rr4cuda » 26.01.2012 20:03:29

Может еще и диплом за вас сделать? :)
Имхо, там все более чем элементарно..
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

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

Сообщение BIT » 17.01.2018 00:20:17

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

Все работает тоже понравилось сохранил у себя спасибо!)
Аватара пользователя
BIT
новенький
 
Сообщения: 25
Зарегистрирован: 29.12.2017 15:44:58


Вернуться в Lazarus

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

Сейчас этот форум просматривают: Pavlosjif и гости: 2

Рейтинг@Mail.ru