开发者

Delphi - move control in runtime alike on design mode

开发者 https://www.devze.com 2023-03-25 06:12 出处:网络
Hy guys, I try to move my own component on runtime mode w开发者_JAVA技巧ith mouse alike in design mode.

Hy guys,

I try to move my own component on runtime mode w开发者_JAVA技巧ith mouse alike in design mode.

the component isn't moved untill mouse button isn't released and in this time a empty frame is displayed and a hint show lefttop corner possition.

I done a lots of tries but no success untill now.

Any help


Well, I'll post it here. The following code uses undocumented WM_SYSCOMMAND constant $F012 and works with TWinControl descendants.

Note, that it's undocumented and it might not work on future versions of Windows (as anything else from Windows API if they decide to), but it works (tested on several Windows versions) and it's the easiest way how to move the component at runtime.

procedure TForm.YourComponentMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGMOVE = $F012;
begin
  ReleaseCapture;
  YourComponent.Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;

The similar magic exists also for sizing, namely command $F008.

procedure TForm.YourComponentMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGSIZE = $F008;
begin
  ReleaseCapture;
  YourComponent.Perform(WM_SYSCOMMAND, SC_DRAGSIZE, 0);
end;


Here (http://neftali.clubdelphi.com/?p=269) on my web, you can find a component called TSelectOnRuntime. You can view the source code and study it. It's an simple approach to select, resize and move components on runtime.

Delphi - move control in runtime alike on design mode

Download the demo and evaluate, if it's valid for you (include the source of component, demo sources and compiled demos).


If what i think you are trying to do is move controls at runtime, then here is some code you may use (and possibly modify slightly) to your needs:

var
MouseDownPos, LastPosition : TPoint;
DragEnabled,Resizing : Boolean;


procedure TForm1.ControlMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
     MouseDownPos.X := X;
     MouseDownPos.Y := Y;
     DragEnabled := True;
end;

//handle dragging of controls
procedure TForm1.ControlMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
     if DragEnabled then
     begin
          if Sender is TControl then
          begin
                TControl(Sender).Left := TControl(Sender).Left + (X - MouseDownPos.X);
                TControl(Sender).Top := TControl(Sender).Top + (Y - MouseDownPos.Y);
          end;
     end;
end;

For resizing controls you could use something like:

procedure TForm1.ControlMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var cntrl : TControl;
begin
    cntrl := Sender as TControl;
if ((cntrl.Width - X) < 15) and ((cntrl.Height - Y) < 15) then
       cntrl.Cursor := crSizeNWSE
    else cntrl.Cursor := crDefault;
    if Resizing then
    begin
        cntrl.Width := cntrl.Width + (X - LastPosition.X);
        LastPosition.X := X;
        cntrl.Height := cntrl.Height + (Y - LastPosition.Y);
        LastPosition.Y := Y;
    end;
end;

procedure TForm1.ControlMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var cntrl : TControl;
begin
    if ((cntrl.Width - X) < 15) and ((cntrl.Height - Y) < 15) then
    begin
        LastPosition.X := X;
        LastPosition.Y := Y;
        Resizing := True;
    end;
end;

Extensions to this may be snapping to a grid. This code may need to be modified slightly.


There is a component out there named TSizeCtrl which lets you move controls at runtime. You can find source code here or the component for download at Torry's.

It can be used like this:

SizeCtrl1 := TSizeCtrl.Create(MyForm);
SizeCtrl1.GridSize := 20;
SizeCtrl1.Enabled := True;
SizeCtrl1.RegisterControl(MyControl);
SizeCtrl1.AddTarget(MyControl);

This will let you drag MyControl around and resize it. It draws a frame while dragging and provides the handles for resizing.

0

精彩评论

暂无评论...
验证码 换一张
取 消