TDBCtrlGrid does not react to the mouse wheel at all.
I tried this:
procedure TForm1.FormMouseWheel(Sender: TObject;
Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
begin
if DBCtrlGrid1.ClientRect.Contains(DBCtrlGrid1.ScreenToClient(MousePos)) then
begin
DBCtrlGrid1.ScrollBy(0, WheelDelta);
Handled := True;
end;
end;
The control grid now scrolls, but it does not change the position in the DataSet, but instead moves its content out of the client rect which looks pretty ugly.
How do I enable mouse wheel scrolling on a TDBCtrlGrid?
As a workaround you can scroll the DataSet instead:
procedure TForm1.FormMouseWheel(Sender: TObject;
Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
var
I: Integer;
Grid: TDBCtrlGrid;
DataSet: TDataSet;
begin
Grid := DBCtrlGrid1;
if not Grid.ClientRect.Contains(Grid.ScreenToClient(MousePos)) then
Exit;
if not Assigned(Grid.DataSource) then
Exit;
DataSet := Grid.DataSource.DataSet;
if DataSet = nil then
Exit;
for I := 0 to Abs(WheelDelta div 256) - 1 do
begin
if WheelDelta > 0 then
DataSet.Prior
else
DataSet.Next;
end;
Handled := True;
end;
There is an easier way if you also have a hidden DBGrid on your form, hooked to the same datasource.
In the click event of the DBCtrlGrid:
DBCtrlGrid.setfocus;
The DBGrid seems to receive the mouse wheel events as long as it is focused. The DBCtrlGrid then scrolls nicely as the record changes.
Related
When I right-click a word in a RichEdit control, I want the cursor to be positioned inside that word the way it happens with left mouse button click.
Is it possible to achieve?
I found another solution here on Stackoverflow. The following is a slightly modified code from https://stackoverflow.com/a/6197549/3986609 by RRUZ.
procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
APoint : TPoint;
Index : Integer;
begin
if Button = mbRight then
begin
APoint := Point(X, Y);
Index := SendMessage(TRichEdit(Sender).Handle,EM_CHARFROMPOS, 0, Integer(#APoint));
if Index<0 then Exit;
TRichEdit(Sender).SelStart:=Index;
end;
end;
Just use the ContextPopup event and simulate a left mouse click
type
TForm1 = class(TForm)
edtRich: TRichEdit;
procedure edtRichContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
end;
implementation
procedure TForm1.edtRichContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
begin
mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN,
MousePos.x, MousePos.y, 0, 0);
mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP,
MousePos.x, MousePos.y, 0, 0);
end;
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;
I have a TScrollBar having a code in the OnScroll event.
I want to scroll it using the mouse wheel, but turning the mouse wheel does not scroll the scroll bar and does not trigger the OnScroll event.
Any idea?
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
I: Integer;
begin
Handled := PtInRect(ScrollBox1.ClientRect, ScrollBox1.ScreenToClient(MousePos));
if Handled then
for I := 1 to Mouse.WheelScrollLines do
try
if WheelDelta > 0 then
ScrollBox1.Perform(WM_VSCROLL, SB_LINEUP, 0)
else
ScrollBox1.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
finally
ScrollBox1.Perform(WM_VSCROLL, SB_ENDSCROLL, 0);
end;
end;
The default TScrollBar component indeed seems not to have the OnMouseWheel* events present. But you can simply assign them, as follows:
type
TForm1 = class(TForm)
ScrollBar1: TScrollBar;
procedure FormCreate(Sender: TObject);
procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
private
procedure ScrollBarMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
end;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
ScrollBar1.OnMouseWheel := ScrollBarMouseWheel;
end;
procedure TForm1.ScrollBarMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
NewScrollPos: Integer;
begin
NewScrollPos := ScrollBar1.Position - WheelDelta;
//Trigger the OnScroll event:
ScrollBar1.Scroll(scPosition, NewScrollPos);
//Scroll the bar into the new position:
ScrollBar1.Position := NewScrollPos;
Handled := True;
end;
You are free to implement this some more creative:
if WheelDelta > 0 then
NewScrollPos := ScrollBar1.Position - ScrollBar1.PageSize
else
NewScrollPos := ScrollBar1.Position + ScrollBar1.PageSize;
And you could interpose the TScrollBar class to prevent to assign the event at runtime:
type
TScrollBar = class(StdCtrls.TScrollBar)
protected
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
end;
function TScrollBar.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
var
NewScrollPos: Integer;
begin
NewScrollPos := Position - WheelDelta;
Scroll(scPosition, NewScrollPos);
Position := NewScrollPos;
Result := True;
end;
it's too easy just increase the position Value .
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
self.VertScrollBar.Position := self.VertScrollBar.Position + WheelDelta;
end;
I don't know if this will help much, but here's how to do it with a TMemo. The scrollbar would have to be a similar process, unless there is some other better way that Delphi versions later than mine use.
procedure TForm1.Memo1WindowProc(var msg: TMessage);
var
ticks: ShortInt;
ScrollMsg: TWMVScroll;
begin
if msg.Msg = WM_MOUSEWHEEL then
begin
ScrollMsg.Msg := WM_VSCROLL;
ticks := HiWord(msg.wparam);
if ticks > 0 then
ScrollMsg.ScrollCode := sb_LineUp
else
ScrollMsg.ScrollCode := sb_LineDown;
ScrollMsg.Pos:=0;
Memo1.Dispatch(ScrollMsg) ;
end
else
OldMemo1(msg);
end;
procedure TForm1.FormCreate(Sender: TObject);
// save old window proc, assign mine.
begin
OldMemo1 := Memo1.WindowProc;
Memo1.WindowProc := Memo1WindowProc;
end;
HTH some.
procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position + 20;
end;
procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - 20;
end;
Old post, but I found solution. Simply do
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
inherited;
ScrollBox1.ScrollBy(WheelDelta, 0);
end;
Works for me.
Again this is an old post, and it got me most of the way to what i wanted but a little further tweak to the answer by Stefan, restricting scrolling to when the mouse is over the scrollbar. This detects that the mouse is over the scrollbar (non-client area) of the scroll box before accepting the mousewheel input./ I need this because my scollbox contained comboboxes which users wanted to be able to scrool with the wheel, as well as scrolling the scrollbox (or whatever control is using a scrollbar):
Handled := PtInRect(scrollbox.BoundsRect, scrollbox.ScreenToClient(MousePos))
and not PtInRect(scrollbox.ClientRect, scrollbox.ScreenToClient(MousePos));
if Handled then
for I := 1 to Mouse.WheelScrollLines do
try
if WheelDelta > 0 then
scrollbox.Perform(WM_VSCROLL, SB_LINEUP, 0)
else
scrollbox.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
finally
scrollbox.Perform(WM_VSCROLL, SB_ENDSCROLL, 0);
end;
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;
I have a TTreeView that can have lots of nodes, when a lot of nodes are expanded the tree uses a lot of screen space.
Now suppose I want to drag a node that is near the bottom of the TreeView to the top, I can't physically see the top part of the TreeView because the node I am selecting is at the bottom. When dragging the node to the top of the TreeView I would like the TreeView to automatically scroll with me when dragging, by default this does not seem to happen.
A perfect example of this behaviour is seen in Windows Explorer. If you try to drag a file or folder, when you hover the dragged item (node) it automatically scrolls up or down depending on cursor position.
Hope that makes sense.
PS, I already know how to drag nodes, I want the TreeView to scroll with me when dragging if hovering near the top or bottom of the TreeView.
Thanks.
This is the code I use. It will work for any TWinControl descendent: list box, tree view, list view etc.
type
TAutoScrollTimer = class(TTimer)
private
FControl: TWinControl;
FScrollCount: Integer;
procedure InitialiseTimer;
procedure Timer(Sender: TObject);
public
constructor Create(Control: TWinControl);
end;
{ TAutoScrollTimer }
constructor TAutoScrollTimer.Create(Control: TWinControl);
begin
inherited Create(Control);
FControl := Control;
InitialiseTimer;
end;
procedure TAutoScrollTimer.InitialiseTimer;
begin
FScrollCount := 0;
Interval := 250;
Enabled := True;
OnTimer := Timer;
end;
procedure TAutoScrollTimer.Timer(Sender: TObject);
procedure DoScroll;
var
WindowEdgeTolerance: Integer;
Pos: TPoint;
begin
WindowEdgeTolerance := Min(25, FControl.Height div 4);
GetCursorPos(Pos);
Pos := FControl.ScreenToClient(Pos);
if not InRange(Pos.X, 0, FControl.Width) then begin
exit;
end;
if Pos.Y<WindowEdgeTolerance then begin
SendMessage(FControl.Handle, WM_VSCROLL, SB_LINEUP, 0);
end else if Pos.Y>FControl.Height-WindowEdgeTolerance then begin
SendMessage(FControl.Handle, WM_VSCROLL, SB_LINEDOWN, 0);
end else begin
InitialiseTimer;
exit;
end;
if FScrollCount<50 then begin
inc(FScrollCount);
if FScrollCount mod 5=0 then begin
//speed up the scrolling by reducing the timer interval
Interval := MulDiv(Interval, 3, 4);
end;
end;
if Win32MajorVersion<6 then begin
//in XP we need to clear up transient "fluff"; results in flickering so only do it in XP where it is needed
FControl.Invalidate;
end;
end;
begin
if Mouse.IsDragging then begin
DoScroll;
end else begin
Free;
end;
end;
Then to use it you add an OnStartDrag event handler for the control and implement it like this:
procedure TMyForm.SomeControlStartDrag(Sender: TObject; var DragObject: TDragObject);
begin
TAutoScrollTimer.Create(Sender as TWinControl);
end;
Here's an alternative based on the fact that the selected node always automatically scrolls in view.
type
TForm1 = class(TForm)
TreeView1: TTreeView;
TreeView2: TTreeView;
procedure TreeViewDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure TreeViewEndDrag(Sender, Target: TObject; X, Y: Integer);
procedure TreeViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FDragNode: TTreeNode;
FNodeHeight: Integer;
end;
...
procedure TForm1.TreeViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
with TTreeView(Sender) do
begin
FDragNode := GetNodeAt(X, Y);
if FDragNode <> nil then
begin
Selected := FDragNode;
with FDragNode.DisplayRect(False) do
FNodeHeight := Bottom - Top;
BeginDrag(False, Mouse.DragThreshold);
end;
end;
end;
procedure TForm1.TreeViewDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
Pt: TPoint;
DropNode: TTreeNode;
begin
Accept := Source is TTreeView;
if Accept then
with TTreeView(Source) do
begin
if Sender <> Source then
Pt := ScreenToClient(Mouse.CursorPos)
else
Pt := Point(X, Y);
if Pt.Y < FNodeHeight then
DropNode := Selected.GetPrevVisible
else if Pt.Y > (ClientHeight - FNodeHeight) then
DropNode := Selected.GetNextVisible
else
DropNode := GetNodeAt(Pt.X, Pt.Y);
if DropNode <> nil then
Selected := DropNode;
end;
end;
procedure TForm1.TreeViewEndDrag(Sender, Target: TObject; X, Y: Integer);
var
DropNode: TTreeNode;
begin
with TTreeView(Sender) do
if Target <> nil then
begin
DropNode := Selected;
DropNode := Items.Insert(DropNode, '');
DropNode.Assign(FDragNode);
Selected := DropNode;
Items.Delete(FDragNode);
end
else
Selected := FDragNode;
end;
You may want to link the OnDragOver event handler to the parent of the TreeView too, which results in scrolling ánd dropping when the mouse is outside the TreeView. If you dó want the scrolling, but not the dropping when the mouse is outside the TreeView, then check if Target = Sender in the OnEndDrag event handler.
Just to be complete, workarounds like in the other answers are not required anymore. Later versions have an option for this:
TreeOptions.AutoOptions.toAutoScroll := True