paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 20:38:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

Closer to moving controls correctly.

Browse Source 
Shane

git-svn-id: trunk@103 -
This commit is contained in:
lazarus 2001-01-08 02:06:34 +00:00
parent 7a0acebcb0
commit 75573811af
2 changed files with 27 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
designer/controlselection.pp
View File

@ -77,13 +77,13 @@ type
procedure ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure DoChange;
procedure SetGrabbers;
procedure MoveContent(dx, dy: Integer);
procedure SizeContent;
procedure SetVisible(const Value: Boolean);
procedure GrabberMove(Sender: TObject; dx, dy: Integer);
procedure GrabberMoved(Sender: TObject; dx, dy: Integer);
protected
public
procedure MoveContent(dx, dy: Integer);
procedure Add(AControl: TControl);
procedure Clear;
constructor Create(AOwner: TWinControl); virtual;
@ -127,6 +127,9 @@ var
procedure SetCaptureGrabber(AGrabber:TGrabber);
begin
Writeln('SETCAPTUREGRABBER to....');
if AGrabber <> nil then Writeln('something') else writeln('nil');
CaptureGrabber:=AGrabber;
end;
@ -254,10 +257,11 @@ end;
procedure TControlSelection.MoveSelection(dx, dy: integer);
begin
Writeln('Move Selection');
if (dx<>0) or (dy<>0) then begin
Inc(FLeft,dx);
Inc(FTop,dy);
MoveContent(dx,dy);
//MoveContent(dx,dy);
SetGrabbers;
end;
end;
@ -372,12 +376,15 @@ end;
procedure TControlSelection.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
Writeln('ControlMOuseMove in TCOntrolSelection');
if FDragging
then begin
Inc(FLeft, X - FStart.X);
Inc(FTop, Y - FStart.Y);
SetGrabbers;
MoveContent(X - FStart.X, Y - FStart.Y);
Writeln(format('X-FStart.x = %d-%d=%d',[X,FStart.x,X-FStart.x]));
Writeln(format('Y-FStart.Y = %d-%d=%d',[Y,FStart.y,Y-FStart.y]));
// MoveContent(X - FStart.x, Y - FStart.Y);
end;
end;
@ -386,6 +393,8 @@ begin
if (Button = mbLeft) and FDragging
then begin
FDragging := False;
Writeln(format('X-FStart.x = %d-%d=%d',[X,FStart.x,X-FStart.x]));
Writeln(format('Y-FStart.Y = %d-%d=%d',[Y,FStart.y,Y-FStart.y]));
MoveContent(X - FStart.X, Y - FStart.Y);
end;
end;

17
designer/designer.pp
View File

@ -231,6 +231,8 @@ Begin
inc(MouseDownPos.X,TControl(Sender).Left);
inc(MouseDownPos.Y,TControl(Sender).Top);
end;
Writeln('Setting mousedowncontrol to'+TCOntrol(sender).name);
MouseDownControl:=Sender;
LastMouseMovePos:=MouseDownPos;
Writeln(TComponent(Sender).Name+'.OnMouseDown at '+inttostr(MouseDownPos.x)
@ -258,6 +260,7 @@ var
CaptureGrabber:TGrabber;
Button : TMouseButton;
Shift : TShiftState;
X,Y : Integer;
Begin
Writeln('In UpOnControl');
if (TLMMouse(Message).keys and MK_LButton) = MK_LButton then
@ -274,12 +277,22 @@ Begin
shift := shift +[ssCTRL];
X := TLMMOuse(Message).pos.X;
Y := TLMMOuse(Message).pos.Y;
CaptureGrabber:=GetCaptureGrabber;
if CaptureGrabber<>nil then begin
Writeln('CaptureGrabber <> nil');
CaptureGrabber.CaptureMouseUp(TControl(Sender),Button,Shift,TLMMouse(Message).pos.X,TLMMouse(Message).pos.Y);
exit;
end;
if MOuseDownControl = Sender then
Begin
ControlSelection.MoveSelection(X-LastMouseMovePos.X, Y-LastMouseMovePos.Y);
//do somerthing like ControlSelection.Sizecontent but move x and y from where
// the grabber started to where it finished.
end;
MouseUpPos.X := TLMMouse(Message).pos.X;
MouseUpPos.Y := TLMMouse(Message).pos.Y;
if not (Sender is TCustomForm) then begin
@ -410,10 +423,10 @@ if Message.msg = LM_MOUSEMOVE then
MouseMoveonCOntrol(Sender, Message);
if Result then Writeln('It IS a design message')
{if Result then Writeln('It IS a design message')
else
Writeln('It IS NOT a design message');
}
end;
procedure TDesigner.LoadFile(FileName: string);