I have a Virtual Treeview (e.g. TVirtualStringTree).
The user can select a row
but it would be nice if they could also do the intuitiave thing of clicking "nowhere" to select no row
Note: Of course multiselect is off; because they can only select zero or one items
MCRE:
procedure TForm6.FormCreate(Sender: TObject);
var
vst: TVirtualStringTree;
begin
vst := VirtualStringTree1;
vst.RootNodeCount := 5;
vst.TreeOptions.SelectionOptions := vst.TreeOptions.SelectionOptions + [toFullRowSelect];
vst.Header.Options := vst.Header.Options + [hoVisible];
vst.Header.Columns.Add;
vst.Header.Columns.Add;
vst.Header.Columns.Add;
vst.Header.Columns.Add;
vst.Header.Columns.Add;
end;
This should work out-of-the-box if toAlwaysSelectNode is not set and toMultiSelect is set in TreeOption.SelectionOptions. Tested wit latest source.
In other cases simply call ClearSelection():
procedure TVisibilityForm.VST2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if TBaseVirtualTree(Sender).GetNodeAt(Point(X, Y)) = nil then
TBaseVirtualTree(Sender).ClearSelection();
end;
This procedure in OnMouseDown should work regardless of the settings, you just need toRightClickSelect in TreeOptions.SelectionsOptions for right click selection, otherwise it doesn't work properly.
procedure VSTMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button in [mbLeft, mbRight] then
VST.FocusedNode := VST.GetNodeAt(X, Y);
if Assigned(VST.FocusedNode) then
VST.TreeOptions.PaintOptions := VST.TreeOptions.PaintOptions - [toAlwaysHideSelection]
else
VST.TreeOptions.PaintOptions := VST.TreeOptions.PaintOptions + [toAlwaysHideSelection];
end;
Related
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;
I have use for the TControlBar component in my current project but I'm having issues with the control drawing extra rows when I'm moving the bands around,
basically what I want is the ControlBar to always only have 1 Row which is of fixed Height, and where the bands can't escape it while being dragged.
How can I achieve this ?
You can do a workaround for this:
procedure TForm1.ControlBar1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var R:TRect;
Pt:TPoint;
begin
Pt:=ControlBar1.ClientToScreen(Point(0,Y));
R.Left:=Pt.X;
R.Top:=Pt.Y;
R.Right:=Pt.X+ControlBar1.Width;
R.Bottom:=Pt.Y;
ClipCursor(#R);
end;
procedure TForm1.ControlBar1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ClipCursor(nil) ;
end;
With that you can restrict the mouse movement to allow only vertical positioning of the Bands.
I solved this months ago by basically deriving my own component from the TPanel class and implementing a drag solution of child panels to mimic the behavior I wanted.
This is the most basic principle I used to implement the desired effect :
var oldPos : TPoint;
procedure TMainForm.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
if Button = mbLeft then
if (Sender is TWinControl) then
begin
inReposition:=True;
SetCapture(TWinControl(Sender).Handle);
GetCursorPos(oldPos);
TWinControl(Sender).BringToFront;
end else
((Sender as TLabel).Parent as TQPanelSub).OnMouseDown((Sender as TLabel).Parent as TQPanelSub,Button,Shift,X,Y)
end;
procedure TMainForm.ControlMouseMove(Sender: TObject; Shift: TShiftState; X: Integer; Y: Integer);
var
newPos: TPoint;
temp : integer;
begin
if (Sender is TWinControl) then begin
if inReposition then
begin
with TWinControl(Sender) do
begin
GetCursorPos(newPos);
Screen.Cursor := crSize;
(* Constrain to the container *)
Top := 0;
temp := Left - oldPos.X + newPos.X;
if (temp >= 0) and (temp <= (Parent.Width - Width))
then Left := temp;
oldPos := newPos;
end;
end;
end else
((Sender as TLabel).Parent as TQPanelSub).OnMouseMove((Sender as TLabel).Parent as TQPanelSub,Shift,X,Y);
end;
procedure TMainForm.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
if inReposition then
begin
Screen.Cursor := crDefault;
ReleaseCapture;
inReposition := False;
end;
end;
This is just the basis that I wanted from the TControlBar which infact is a horribly written component.
Screen width is just not enough to display some text fields. I don't know how to auto-wrap them and I doubt that it can be easily done.
So, I thought that I would do something like
procedure TForm1.FormMouseMove(Sender: TObject;
Shift: TShiftState; X,Y: Integer);
var column, row : Integer;
begin
myDbGrid.MouseToCell(X, Y, column, row);
myDbGrid.Hinst := myDbGrid.Cells(column, row); // <==== ooops
end;
or, maybe do it in OnShowHint and get the mouse coords & translate them to column & row (more efficient)
but, of course, TDbGrid doesn't have Cells. Any idea how I can set the hint for the control as the user moves the mouse over the "cells" of the grid?
Use this code:
type
THackGrid = class(TDBGrid);
procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Cell: TGridCoord;
ActRec: Integer;
begin
Cell := DBGrid1.MouseCoord(X, Y);
if dgIndicator in DBGrid1.Options then
Dec(Cell.X);
if dgTitles in DBGrid1.Options then
Dec(Cell.Y);
if THackGrid(DBGrid1).DataLink.Active and (Cell.X >= 0) and
(Cell.Y >= 0) then
begin
ActRec := THackGrid(DBGrid1).DataLink.ActiveRecord;
try
THackGrid(DBGrid1).DataLink.ActiveRecord := Cell.Y;
Caption := DBGrid1.Columns[Cell.X].Field.AsString;
finally
THackGrid(DBGrid1).DataLink.ActiveRecord := ActRec;
end;
end;
end;
This is code directly taken (albeit simplified) from a program of mine which displays as a hint one of the values of the dataset connected to the grid.
procedure TMainForm.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
MousePos: TGridCoord; // X = Column, Y = Row
begin
MousePos:= DBGrid1.MouseCoord (X, Y);
if mousepos.X = 6 // we are over the 'tops' field
then mainform.hint:= qPeopleTops.asstring; // show for current person
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.