[SOLVED] TForm's MouseMove bugfix

[lagprogramming]

Add a button on an empty form and fill the OnMouseMove events according to the following code:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Button1: TButton;
16.     procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
17.       Y: Integer);
18.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
19.   private
20.  
21.   public
22.  
23.   end;
24.  
25. var
26.   Form1: TForm1;
27.  
28. implementation
29.  
30. {$R *.lfm}
31.  
32. { TForm1 }
33.  
34. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
35.   Y: Integer);
36. begin
37.   //Shows wrong coordinates!!!
38.   form1.Caption:='Form '+inttostr(x)+' '+inttostr(y);
39. end;
40.  
41. procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
42.   Y: Integer);
43. begin
44.   //Shows good coordinates
45.   form1.Caption:='Button '+inttostr(x)+' '+inttostr(y);
46. end;
47.  
48. end.

In linux-customdrawn, the coordinates shown when moving the mouse over the form are wrong, most likely sometimes being negative.
In the context of the function FindControlPositionRelativeToTheForm, forms don't have relative positions to themselves as parent form controls, so inserting "if (ALCLControl is TCustomForm) then Exit(Point(0,0));" as the first line fixes the bug.

The attached patch changes the code to:

Code: Pascal  [Select][+][-]

1. function FindControlPositionRelativeToTheForm(ALCLControl: TWinControl; AConsiderScrolling: Boolean = False): TPoint;
2. var
3.   lParentControl: TWinControl;
4.   lParentHandle: TCDBaseControl;
5.   lScroll, lParentPos: TPoint;
6. begin
7.   // A form doesn't have a relative position to itself as a parent control
8.   if (ALCLControl is TCustomForm) then Exit(Point(0,0));
9.   // Iterate to find the appropriate BaseWindowOrg relative to the parent control
10.   Result := Point(ALCLControl.Left, ALCLControl.Top);
11.   lParentControl := ALCLControl.Parent;
12.   while (lParentControl <> nil) do
13.   begin
14.     if AConsiderScrolling and lParentControl.HandleAllocated then
15.     begin
16.       lParentHandle := TCDBaseControl(lParentControl.Handle);
17.       lScroll := Point(lParentHandle.ScrollX, lParentHandle.ScrollY);
18.     end
19.     else lScroll := Point(0, 0);
20.  
21.     if (lParentControl is TCustomForm) then lParentPos := Point(0, 0)
22.     else lParentPos := Point(lParentControl.Left, lParentControl.Top);
23.  
24.     Result.X := Result.X + lParentPos.X - lScroll.X;
25.     Result.Y := Result.Y + lParentPos.Y - lScroll.Y;
26.     lParentControl := lParentControl.Parent;
27.   end;
28. end;

Here is the patch:

Code: Pascal  [Select][+][-]

1. diff --git a/lcl/interfaces/customdrawn/customdrawnproc.pas b/lcl/interfaces/customdrawn/customdrawnproc.pas
2. index 0e8303af08..b87ee6829a 100644
3. --- a/lcl/interfaces/customdrawn/customdrawnproc.pas
4. +++ b/lcl/interfaces/customdrawn/customdrawnproc.pas
5. @@ -673,6 +673,8 @@ var
6.    lParentHandle: TCDBaseControl;
7.    lScroll, lParentPos: TPoint;
8.  begin
9. +  // A form doesn't have a relative position to itself as a parent control
10. +  if (ALCLControl is TCustomForm) then Exit(Point(0,0));
11.    // Iterate to find the appropriate BaseWindowOrg relative to the parent control
12.    Result := Point(ALCLControl.Left, ALCLControl.Top);
13.    lParentControl := ALCLControl.Parent;

[AlexTP]

Reported to https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/40609

[wp]

What if the form contains another form as child?

[Bart]

What if the form contains another form as child?

Wondered aboyt that as well.
But maybe better reply in the bugtracker (before someone else applies the patch).

Bart

[lagprogramming]

I might not understand your concern.

1/2 Even when a form has a parent form assigned, shouldn't mouse movements over child's form top-left corner return the (0,0) coordinates!? Same as moving the mouse over the top-left corner of the button in the above example, it returns (0,0). Moving the mouse over the button would not trigger the OnMouseMove event of it's parent form, no matter if the button has an OnMouseMove event assigned or not. Shouldn't be the same when moving the mouse over a child form!?
The only concern I've had was related to using TFrames, but those are unusable even in linux-gtk2(using latest development sources). Notice that custom-drawn lacks dialogs implementation(like Open/Save file dialog), so it might take years before implementing TFrames in custom-drawn. When implemented, most likely FindControlPositionRelativeToTheForm will need an additional "if (ALCLControl is TCustomFrame) then ..." line inserted before the proposed "if (ALCLControl is TCustomForm) then Exit(Point(0,0));".

2/2 A different idea is to change the function to

Code: Pascal  [Select][+][-]

1. function FindControlPositionRelativeToTheForm(ALCLControl: TWinControl; AConsiderScrolling: Boolean = False): TPoint;
2. var
3.   lParentControl: TWinControl;
4.   lParentHandle: TCDBaseControl;
5.   lScroll, lParentPos: TPoint;
6. begin
7.   lParentControl := ALCLControl.Parent;
8.   //Return (0,0) if the parent control is nil
9.   if lParentControl = nil then Exit(Point(0, 0));
10.   // Iterate to find the appropriate BaseWindowOrg relative to the parent control
11.   Result := Point(ALCLControl.Left, ALCLControl.Top);
12.   repeat
13.     if AConsiderScrolling and lParentControl.HandleAllocated then
14.     begin
15.       lParentHandle := TCDBaseControl(lParentControl.Handle);
16.       lScroll := Point(lParentHandle.ScrollX, lParentHandle.ScrollY);
17.     end
18.     else lScroll := Point(0, 0);
19.  
20.     if (lParentControl is TCustomForm) then lParentPos := Point(0, 0)
21.     else lParentPos := Point(lParentControl.Left, lParentControl.Top);
22.  
23.     Result.X := Result.X + lParentPos.X - lScroll.X;
24.     Result.Y := Result.Y + lParentPos.Y - lScroll.Y;
25.     lParentControl := lParentControl.Parent;
26.   until lParentControl = nil;
27. end;

The above code returns (0,0) when the LCL control has no parent. This solution works for me, too.