I want to know the position of the cursor on a TCustomControl. How does one go about finding the coordinates?
GetCursorPos can be helpful if you can't handle a mouse event:
function GetCursorPosForControl(AControl: TWinControl): TPoint;
var
P: TPoint;
begin
Windows.GetCursorPos(P);
Windows.ScreenToClient(AControl.Handle, P );
result := P;
end;
You can use MouseMove event:
procedure TCustomControl.MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Label1.Caption := IntToStr(x) + ' ' + IntToStr(y);
end;
If you want the cursor position when they click on the control, then use Mouse.CursorPos to get the mouse position, and Control.ScreenToClient to convert this to the position relative to the Control.
procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pt: TPoint;
begin
pt := Mouse.CursorPos;
pt := Memo1.ScreenToClient(pt);
Memo1.Lines.Add(Format('x=%d, y=%d', [pt.X, pt.y]));
end;
EDIT:
As various people have pointed out, this is pointless on a mouse down event. However as TCustomControl.OnMouseDown is protected, it may not always be readily available on third-party controls - mind you I would probably not use a control with such a flaw.
A better example might be an OnDblClick event, where no co-ordinate information is given:
procedure TForm1.DodgyControl1DblClick(Sender: TObject);
var
pt: TPoint;
begin
pt := Mouse.CursorPos;
pt := DodgyControl1.ScreenToClient(pt);
Memo1.Lines.Add(Format('x=%d, y=%d', [pt.X, pt.y]));
end;
Related
I want to move a TPanel on another TPanel by mouse at runtime with Delphi 10.4.2 and FMX. I tried OnMouseDown, OnMouseMove and OnMouseUp events. But it is not clear what the contents of X and Y values are in the events. The documentation says that they are screen coordinates. Relative to the screen, form, parent control or the control itself? How can I solve the movement of the TPanel?
The documentation says that they are screen coordinates.
No, it doesn't. The FMX.Types.TMouseEvent and FMX.Types.TMouseMoveEvent
documentation both say:
X and Y--the pixel coordinates of the mouse pointer within the client area of the control.
How can I solve the movement of the TPanel?
Like this:
var
LastPt: TPointF;
Dragging: Boolean = False;
procedure TMyForm.PanelToDragMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if Button = TMouseButton.mbLeft then
begin
LastPt := TPointF.Create(X, Y);
Dragging := True;
end;
end;
procedure TMyForm.PanelToDragMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if Button = TMouseButton.mbLeft then
Dragging := False;
end;
procedure TMyForm.PanelToDragMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Single);
var
CurrPt: TPointF;
begin
if Dragging then
begin
CurrPt := TPointF.Create(X, Y);
PanelToDrag.Position.Point := PanelToDrag.Position.Point + (CurrPt - LastPt);
LastPt := CurrPt;
end;
end;
Basically, while the mouse is moving around the Panel, the code is simply calculating the offset the mouse has moved from the last known position to the current position, and then applying that offset to the Panel's current Position within its Parent.
Example without BalloonHint1 works as designed. No issues with the Hint refresh.
procedure TForm1.ControlList1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
ControlList1.ShowHint:=false;
//ControlList1.CustomHint <-------value is not set as it is not required.
ControlList1.Hint := IntToStr(ControlList1.HotItemIndex);
ControlList1.ShowHint:=true;
end;
When I add a TBalloonHint, the BalloonHint does not display properly.
procedure TForm1.ControlList1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
ControlList1.ShowHint:=false;
BalloonHint1.Delay:=0;
BalloonHint1.HideAfter:=-1;
ControlList1.CustomHint:=BalloonHint1;
ControlList1.Hint := IntToStr(ControlList1.HotItemIndex);
ControlList1.ShowHint:=true;
end;
When I move my mouse over the ControlList for the first time. A BalloonHint does not show.
If I move my mouse over again (for the 2nd time) then the HotItemIndex from the previous movement shows the index.
Is there a way to do a BalloonHint1.Refresh?
I have tested some of the following:
Application.CancelHint; ///something that I dont want to do... but i gave it a try
also
ControlList1.ShowHint:=false;
ControlList1.ShowHint:=true;
The following worked.
procedure TForm1.ControlList1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
BalloonHint1.HideHint;
BalloonHint1.Delay:=0;
BalloonHint1.HideAfter:=-1;
ControlList1.CustomHint:=BalloonHint1;
ControlList1.Hint := IntToStr(ControlList1.HotItemIndex);
BalloonHint1.ShowHint(ControlList1);
end;
I then found that the BalloonHint flickered. So I used advice from the following:
Delphi ListView hint flickers
Create a global variable in which I would store reference to last HotItemIndex for which the hint has been shown. Then verify if the current HotItemIndex is the same as the one we stored controlListHotItemIndex.
procedure TForm1.ControlList1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if controlListHotItemIndex<>ControlList1.HotItemIndex then
begin
controlListHotItemIndex:=ControlList1.HotItemIndex;
BalloonHint1.HideHint;
BalloonHint1.Delay:=0;
BalloonHint1.HideAfter:=-1;
ControlList1.CustomHint:=BalloonHint1;
ControlList1.Hint := IntToStr(ControlList1.HotItemIndex);
BalloonHint1.ShowHint(ControlList1);
end;
end;
Program use on touch screen Windows-tablet. Have a grid, where we need to select some cells in a row: target cursor over cell, click left button of mouse, holding it, pull the mouse to the side, and then release left button of mouse (at the same time code in OnDrawCell is drawing cells).
By mouse or by touchpad of notebook works very well. But on tablet's touchscreen doesn't work at all.
I use TDrawGrid and OnMouseDown, OnMouseMove, OnMouseUp events.
In Shift use all options: ssLeft, ssTouch, ssPen. Look at full code:
procedure TfmMain.GridMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ACol, ARow: Integer;
ARect: TRect;
begin
(Sender as TDrawGrid).MouseToCell(X, Y, ACol, ARow);
ARect := (Sender as TDrawGrid).CellRect(ACol, ARow);
pmIsLeft := X<(ARect.Left+((ARect.Right-ARect.Left) div 2));
pmCol := ACol;
pmRow := ARow;
if (ssLeft in Shift) or (ssTouch in Shift) or (ssPen in Shift) then
begin
ChooseDaysInGridRowIndex := ARow;
SetLength(ChooseDays, 0);
end;
end;
procedure TfmMain.GridMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
ACol, ARow: Integer;
begin
if (ssLeft in Shift) or (ssTouch in Shift) or (ssPen in Shift) then
begin
(Sender as TDrawGrid).MouseToCell(X, Y, ACol, ARow);
if (ChooseDaysInGridRowIndex>0) and
(ChooseDaysInGridRowIndex<=(Sender as TDrawGrid).RowCount-1) and
((PagesDays[pagesBuildings.ActivePageIndex][ARow, ACol][0].ReservID<=0) or
((Length(ChooseDays)=0) and ((PagesDays[pagesBuildings.ActivePageIndex][ARow, ACol][1].ReservID<=0)))) then
begin
SetLength(ChooseDays, Length(ChooseDays)+1);
ChooseDays[High(ChooseDays)] := Point(ACol, ChooseDaysInGridRowIndex);
InvalidateRect((Sender as TDrawGrid).Handle,
(Sender as TDrawGrid).CellRect(ACol, ARow),
True);
end;
ChooseDaysInGrid := True;
end;
end;
procedure TfmMain.GridMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ACol, ARow: Integer;
begin
if ChooseDaysInGrid then
begin
(Sender as TDrawGrid).MouseToCell(X, Y, ACol, ARow);
ChooseDaysInGrid := False;
fmGuestArrival.roomID := GridRowTitles[(Sender as TDrawGrid).Tag] [ARow].RoomID;
// Integer((Sender as TDrawGrid).Objects[0, ARow]);
if Length(ChooseDays)>0 then
begin
fmGuestArrival.dateArrival.DateTime :=
IncDay(StartDatePeriod, ChooseDays[0].X-1);
if Length(ChooseDays)>1 then
begin
fmGuestArrival.dateDeparture.DateTime :=
IncDay(StartDatePeriod, ChooseDays[High(ChooseDays)].X - 1);
end
else
begin
fmGuestArrival.dateDeparture.DateTime :=
IncDay(fmGuestArrival.dateArrival.DateTime, 1);
end;
end;
fmGuestArrival.IsEditing := False;
fmGuestArrival.cbStatus.ItemIndex := 0;
fmGuestArrival.ShowModal;
end;
end;
Add Gesturing support by adding a TGestureManager (GestureManager1). Then assign GestureManager1 to the Touch.GestureManager property of the TDrawGrid. Open Touch.Gestures.Standard property of the TDrawGrid and select the gestures you want to be notified of. Create an OnGesture event and add code as needed.
The details are documented by Embarcadero
in VCL we can use this ( To get a ListItem ):
TForm.ListView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
li: TListItem;
lv : TListView;
begin
lv := TListView(Sender);
li := lv.GetItemAt(X, Y); // we get our ListItem
end;
But with the Firemonkey ListView i don't see any GetItemAt function .
So please how can we get a ListItem by using OnMouseDown event of the ListView ( in firemonkey ) .
many thanks .
There's no ready made solution to find the item with OnMouseDown. I suggest you use OnItemClick instead:
procedure TForm1.ListView1ItemClick(const Sender: TObject; const AItem: TListViewItem);
which gives you a reference to the item
As Tom said, there's no ready made solution. But if you can live with FMX source changes you can insert that into FMX.ListView
function TListViewBase.GetItemAt(P: TPointF):TListItem;
var
ItemAt: Integer;
begin
ItemAt := FindItemAbsoluteAt(Round(FScrollViewPos + P.Y - (LocalRect.Top + FSideSpace)));
if (ItemAt >= 0) and (ItemAt < Adapter.Count) then
Result := Adapter[ItemAt]
else
Result := nil
end;
I find the TListViewItem on rigth click by searching if the current position of the mouse is inside the item rect.
I use only Y because all my itmes are only text but you can extend the complexity by using the X value too.
In this example i set the selected item with the rightclick.
procedure TForm2.lwPlayListMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
var
I: Integer;
rct: TRectF;
begin
if ssRight in Shift then
for I := 0 to lwPlayList.Items.Count-1 do
Begin
rct := lwPlayList.GetItemRect(I);
if ( rct.Bottom >= Y) and (Y >= rct.Top ) then
Begin
lwPlayList.ItemIndex := I;
lwPlayList.Selected := lwPlayList.Items[I];
End;
End;
end;
Normally, ListView.ItemIndex property is correct, so you can rely on it. But you can write OnItemClick event, to simply grab AItem.Index in a field and then use it in your double click event.
procedure TForm1.ListView1ItemClick(const Sender: TObject;
const AItem: TListViewItem);
begin
FClickedIndex := AItem.Index;
end;
procedure TForm1.ListView1DblClick(Sender: TObject);
var
Index: Integer;
SelectedItemText: string;
begin
// it is correct as well
//Index := ListView1.ItemIndex;
Index := FClickedIndex;
SelectedItemText := ListView1.Items[Index].Objects.TextObject.Text;
// do something with the index, item or text.
end;
Hy guys,
I try to move my own component on runtime mode with 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
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.
Download the demo and evaluate, if it's valid for you (include the source of component, demo sources and compiled demos).
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;
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.