Forum > CustomDrawn
[SOLVED] TForm's MouseMove bugfix
(1/1)
lagprogramming:
Add a button on an empty form and fill the OnMouseMove events according to the following code:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls; type { TForm1 } TForm1 = class(TForm) Button1: TButton; procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); private public end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);begin //Shows wrong coordinates!!! form1.Caption:='Form '+inttostr(x)+' '+inttostr(y);end; procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);begin //Shows good coordinates form1.Caption:='Button '+inttostr(x)+' '+inttostr(y);end; 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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function FindControlPositionRelativeToTheForm(ALCLControl: TWinControl; AConsiderScrolling: Boolean = False): TPoint;var lParentControl: TWinControl; lParentHandle: TCDBaseControl; lScroll, lParentPos: TPoint;begin // A form doesn't have a relative position to itself as a parent control if (ALCLControl is TCustomForm) then Exit(Point(0,0)); // Iterate to find the appropriate BaseWindowOrg relative to the parent control Result := Point(ALCLControl.Left, ALCLControl.Top); lParentControl := ALCLControl.Parent; while (lParentControl <> nil) do begin if AConsiderScrolling and lParentControl.HandleAllocated then begin lParentHandle := TCDBaseControl(lParentControl.Handle); lScroll := Point(lParentHandle.ScrollX, lParentHandle.ScrollY); end else lScroll := Point(0, 0); if (lParentControl is TCustomForm) then lParentPos := Point(0, 0) else lParentPos := Point(lParentControl.Left, lParentControl.Top); Result.X := Result.X + lParentPos.X - lScroll.X; Result.Y := Result.Y + lParentPos.Y - lScroll.Y; lParentControl := lParentControl.Parent; end;end;
Here is the patch:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---diff --git a/lcl/interfaces/customdrawn/customdrawnproc.pas b/lcl/interfaces/customdrawn/customdrawnproc.pasindex 0e8303af08..b87ee6829a 100644--- a/lcl/interfaces/customdrawn/customdrawnproc.pas+++ b/lcl/interfaces/customdrawn/customdrawnproc.pas@@ -673,6 +673,8 @@ var lParentHandle: TCDBaseControl; lScroll, lParentPos: TPoint; begin+ // A form doesn't have a relative position to itself as a parent control+ if (ALCLControl is TCustomForm) then Exit(Point(0,0)); // Iterate to find the appropriate BaseWindowOrg relative to the parent control Result := Point(ALCLControl.Left, ALCLControl.Top); 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:
--- Quote from: wp on November 19, 2023, 11:30:15 am ---What if the form contains another form as child?
--- End quote ---
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function FindControlPositionRelativeToTheForm(ALCLControl: TWinControl; AConsiderScrolling: Boolean = False): TPoint;var lParentControl: TWinControl; lParentHandle: TCDBaseControl; lScroll, lParentPos: TPoint;begin lParentControl := ALCLControl.Parent; //Return (0,0) if the parent control is nil if lParentControl = nil then Exit(Point(0, 0)); // Iterate to find the appropriate BaseWindowOrg relative to the parent control Result := Point(ALCLControl.Left, ALCLControl.Top); repeat if AConsiderScrolling and lParentControl.HandleAllocated then begin lParentHandle := TCDBaseControl(lParentControl.Handle); lScroll := Point(lParentHandle.ScrollX, lParentHandle.ScrollY); end else lScroll := Point(0, 0); if (lParentControl is TCustomForm) then lParentPos := Point(0, 0) else lParentPos := Point(lParentControl.Left, lParentControl.Top); Result.X := Result.X + lParentPos.X - lScroll.X; Result.Y := Result.Y + lParentPos.Y - lScroll.Y; lParentControl := lParentControl.Parent; until lParentControl = nil;end;The above code returns (0,0) when the LCL control has no parent. This solution works for me, too. ;D
Navigation
[0] Message Index