I am creating a Delphi XE6 Firemonkey mobile application and want to highlight a listbox item but only while it is being pressed. For an example of the effect I am after, create a new Firemonkey desktop application, add a TListBox and add the following event handlers and code:-
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
//populate the listbox
for i := 0 to 19 do
ListBox1.Items.Add(IntToStr(i));
end;
procedure TForm1.ListBox1ItemClick(const Sender: TCustomListBox;
const Item: TListBoxItem);
begin
ListBox1.ItemIndex:=-1;
end;
Now click an item in the listbox and the highlight should disappear on release of the mouse button. Repeating the exercise for mobile sees only a long press producing the desired result and a short press causes the highlight to remain. So I dropped a timer on the form, setting enabled to FALSE, an interval of 200 and creating an OnTimer event:-
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
//populate the listbox
for i := 0 to 19 do
ListBox1.Items.Add(IntToStr(i));
end;
procedure TForm1.ListBox1ItemClick(const Sender: TCustomListBox;
const Item: TListBoxItem);
begin
Timer1.Enabled:=TRUE;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ListBox1.ItemIndex:=-1;
Timer1.Enabled:=FALSE;
end;
Progress is made but by rapid pressing of the listbox it is easily possible for the listbox to remain highlighted. I tried the timer option on a TListView and it appears to work as hoped but I'm eager to find a solution for TListBox.
Next brainwave was to add a button to the listboxitem:-
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
BoxItem: TListBoxItem;
ListBoxSpeedButton: TSpeedButton;
begin
for i := 0 to 99 do
begin
ListBox1.Items.Add(IntToStr(i));
BoxItem := ListBox1.ListItems[ListBox1.Items.Count-1];
ListBoxSpeedButton:=TSpeedButton.Create(nil);
ListBoxSpeedButton.Parent:=BoxItem;
ListBoxSpeedButton.CanFocus:=FALSE;
ListBoxSpeedButton.Align:=TAlignLayout.Client;
end;
end;
However, when scrolling the listbox, the button gets activated and when using a custom Speedbutton, the scrolling is jerky and unresponsive and I can't help feeling I'm using controls when there is no need.
Is there a simple solution here?
Uhm... I will start off by saying DONT USE listboxes when scrolling.... FMX Listboxes are meant to be stagnant and performance when scrolling is horrendous. Use a TListView and TListViewItems. There are tons of examples on SO and in the packaged Delphi XE6 examples on how to implement a list via TListView. That being said, there is no need for timers.. Make use of events already available to use for such things, such as OnMouseDown and onMouseUp which are events assigned to basically every FMX control ( ListBox ListBoxItem or ListView, etc.).... Tons of ways to go about implementing this...
Try this - setting onMouseDown and MouseUp events for every listboxItem to what you see below:
procedure TForm1.ListBoxItem5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
if sender is TListboxItem then
ListBox.ItemIndex:=TListBoxItem(sender).index
end;
procedure TForm1.ListBoxItem5MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
ListBox.ItemIndex:=-1;
end;
Related
Event form 1:
procedure TForm1.Panel1DblClick(Sender: TObject);
begin
TForm2.Create(Self).ShowModal;
end;
Event form 2:
procedure TForm2.DBGrid1CellClick(Column: TColumn);
begin
ShowMessage('Test');
end;
What should I do to avoid fom2's onCellClick event?
The OS posts a WM_LBUTTONDBLCLK on the second down of the left mouse button. When you execute a ShowModal call here, the application does not get the chance to process the, yet to be posted, WM_LBUTTONUP message until after your dialog is shown. Since TDBGrid fires the OnCellClick event while the control is handling a WM_LBUTTONUP message and the message happens to be posted to the grid since the modal form is the active window now, you encounter the problem.
The behavior of the grid is kind of documented;
Occurs when the user releases the mouse in one of the cells of the
grid.
although it could be argued that it should've mention that you don't even have to press the mouse button...
This is an unfortunate design decision, this is not how a click works. Think of pressing the button on one cell and releasing on another. No OnCellClick should be fired. Current behavior is rather confusing, the event fires for the cell you pressed the button on - provided you release the button on a valid cell and not on empty space.
As you have found out, you can even fire the event by pressing the button on a different form and releasing it on a cell of the grid on this form. In this case the event fires for the currently selected cell and mouse position does not play any role in it at all. My opinion is that OnCellClick is a total mess.
You can use kobik's answer for a solution. Below solution fails if for some reason mouse button is held down on the second press for any time period.
Posting a self received message to delay the showing of the dialog, as suggested in the comments to the question, does not work because posted messages have higher priority then input messages. See documentation for GetMessage for more detail.
If you follow the link, you'll notice the timer approach, also as suggested in the comments to the question, will work. Unlike the comment suggests the timing interval does not matter since the WM_TIMER message have the lowest priority. And this is a good thing which makes it a fail-safe approach.
I wanted to put the timer on the modal dialog as it owns the problem control.
procedure TForm2.FormCreate(Sender: TObject);
begin
DBGrid1.Enabled := False;
Timer1.Interval := 1;
Timer1.Enabled := True;
end;
procedure TForm2.Timer1Timer(Sender: TObject);
begin
DBGrid1.Enabled := True;
Timer1.Enabled := False;
end;
#Sertac gave a great explanation of the behaviour.
I will try to give another fix by creating an interposer class for TDBGrid e.g.:
type
TDBGrid = class(DBGrids.TDBGrid)
protected
FDown: Boolean;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
end;
TForm2 = class(TForm)
...
DBGrid1: TDBGrid;
...
end;
implementation
procedure TDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FDown := True;
try
inherited;
except
FDown := False;
raise;
end;
end;
procedure TDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FDown then
try
inherited;
finally
FDown := False;
end;
end;
The FDown flag simply indicates that a MouseUp must be followed only after a MouseDown message.
From my quick test I did not noticed any implications. but there might be.
Have you tried doing an Application.ProcessMessages() in the DblClick handler?
procedure TForm1.Panel1DblClick(Sender: TObject);
begin
Application.ProcessMessages;
TForm2.Create(Self).ShowModal;
end;
I have a project with CoolTrayIcon and PopupMenu with disabled AutoPopup property.
I would like to position the PopupMenu and show it for the user.
The position is OK but menu doesn't close if the user clicks away or press ESC button.
I have not found any property like Active which could help if the menu is used or not.
Here I position the menu:
procedure TForm1.CoolTrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pnt: TPoint; yy:integer;
begin
GetCursorPos(pnt);
yy:=pnt.y; yy:=yy-500;
if (Button=mbRight) then begin
PopupMenu1.Popup(pnt.X, yy);
end;
end;
How could I manage to close menu if it is needed?
This is a known issue that is discussed here:
PRB: Menus for Notification Icons Do Not Work Correctly
You need to wrap the call to Popup() as follows:
SetForegroundWindow(Handle);
PopupMenu1.Popup(pnt.X, yy);
PostMessage(Handle, WM_NULL, 0, 0);
In this code, Handle is the window handle of the form associated with the notification icon.
I have a component derived from TMemo. Do you know what Windows message I should intercept to react on text cursor position changes? I mean text cursor, which change position by pressing arrow keys or by left mouse button click. I am on Delphi 7. OnMouseDown or OrKeyPress events work for arrow keys but not for LMB.
You can store CaretPos property value and compare it in OnKeyPress and OnClick events. Calling some procedure if it has changed.
I sorted it out. Not working mouse events was my mistake. To respond to caret position changes in TMemo you can make combination of two events: OnKeyUp (for arrow keys) and OnMouseDown:
procedure TSomeMemo.OnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT] then
OnMouseDown(Sender, mbLeft, Shift, 0, 0);
end;
procedure TSomeMemo.OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
row,col: integer;
begin
if Button = mbLeft then
begin
row := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0);
col := SelStart - SendMessage(Handle, EM_LINEINDEX, row, 0);
...
end;
end;
Do you know what Windows message I should intercept to react on text cursor position changes?
There is no notification event for change in caret position in a Win32 edit control.
You could perhaps detect such a change by polling, in response to the application's OnIdle event.
If that's the only speciality you want, there are already some answers. If you want to extend on TMemo's functionality more than that you will sooner or later find, that you're better off to use something like SynEdit, which incidentally also supports reacting to cursor position changes.
This one has been puzzling me for some time now and maybe the answer is an easy one, or perhaps it involves much more VCL hacking or magic to accomplish what I am looking for but either way I am at a loss as to how to solve my problem.
If you look at the Delphi Form Designer you will see that none of the controls animate when the mouse moves over them, they also cannot receive focus or input (eg you cannot type into a TEdit, click a TCheckBox or move a TScrollBar etc), only at runtime do the controls behave normally and respond to user interaction.
I want to know how can I implement this type of behavior to any control at runtime, eg set controls into like a Designer State Mode? However, controls should also still respond to Mouse Events such as OnMouseDown, OnMouseMove, OnMouseUp etc so they can be moved and sized if needed for example.
This is the closest that I managed:
procedure SetControlState(Control: TWinControl; Active: Boolean);
begin
SendMessage(Control.Handle, WM_SETREDRAW, Ord(Active), 0);
InvalidateRect(Control.Handle, nil, True);
end;
Which could be called simply like so:
procedure TForm1.chkActiveClick(Sender: TObject);
begin
SetControlState(Button1, chkActive.Checked);
SetControlState(Button2, chkActive.Checked);
SetControlState(Edit1, chkActive.Checked);
end;
Or for example, all controls on the form:
procedure TForm1.chkActiveClick(Sender: TObject);
var
I: Integer;
Ctrl: TWinControl;
begin
for I := 0 to Form1.ControlCount -1 do
begin
if Form1.Controls[I] is TWinControl then
begin
Ctrl := TWinControl(Form1.Controls[I]);
if (Ctrl <> nil) and not (Ctrl = chkActive) then
begin
SetControlState(Ctrl, chkActive.Checked);
end;
end;
end;
end;
Two problems I have noticed with the above is that whilst the controls do appear to become Design State like, some controls such as TButton still have the animation effect painted on them. The other issue is when pressing the left Alt key when the controls are Design State like causes them to disappear.
So my question is, how do I put controls into a Design State mode at runtime just like the Delphi Form Designer does, where those controls do not animate (based on Windows Theme) and cannot receive focus or input?
To make that bit clearer, look at this sample image based off the above code sample where the controls are no longer active, but the TButton's animation paint is still active:
But should actually be:
From the two images above, only the TCheckBox control can be interacted with.
Is there a procedure hidden away somewhere that can change the state of a control? Or perhaps a more suitable approach to achieving this? The code I managed to get so far just presents more problems.
Setting the controls to Enabled := False is not an answer I am looking for either, yes the behavior is kind of the same but of course the controls paint differently to show they are disabled which is not what I am looking for.
What you are looking for is not a feature of the controls themselves, but rather is an implementation of the Form Designer itself. At design-time, user input is intercepted before it can be processed by any given control. The VCL defines a CM_DESIGNHITTEST message to allow each control to specify whether it wants to receive user input at design-time (for example to allow visual resizing of list/grid column headers). It is an opt-in feature.
What you can do, though, is put the desired controls onto a borderless TPanel, and then simply enable/disable the TPanel itself as needed. That will effectively enable/disable all user input and animations for its child controls. Also, when the TPanel is disabled, the child controls will not render themselves as looking disabled.
Remy Lebeau's answer on putting controls into a container such as a TPanel, and then setting the panel to Enabled := False does put the controls into the state I was looking for. I also discovered that overriding the controls WM_HITTEST put the controls into the same state, eg they don't receive focus and cannot be interacted with. The problem with those two is that the controls still need to be able to respond to MouseDown, MouseMove and MouseUp events etc but they no longer cannot.
Remy also suggested writing a class and implement Vcl.Forms.IDesignerHook, something I have not attempted yet as maybe it requires too much work for what I need.
Anyway, after lots of playing around I found another alternative way, it involves the use of PaintTo to draw the control onto a canvas. The steps I did are as follows:
Create a custom TPanel with an exposed Canvas
At FormCreate create and align the custom panel to client
Add controls to the form at runtime (bringing the custom panel to the front)
Call the controls PaintTo method onto the custom panels Canvas
What this is essentially doing is creating the components and using the Form as the parent with our custom panel sitting on top. The controls are then painted onto the panels canvas which makes it appear as if the control is on the panel, when actually it sits underneath on the form undisturbed.
Because the controls are underneath the panel, in order for them to respond to events such as MouseDown, MouseMove and MouseUp etc I overrided the WM_NCHitTest in the panel and set the result to HTTRANSPARENT.
In code it would look something like this:
Custom panel:
type
TMyPanel = class(TPanel)
protected
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHitTest;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;
end;
{ TMyPanel }
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Align := alClient;
BorderStyle := bsNone;
Caption := '';
end;
destructor TMyPanel.Destroy;
begin
inherited Destroy;
end;
procedure TMyPanel.WMNCHitTest(var Message: TWMNCHitTest);
begin
Message.Result := HTTRANSPARENT;
end;
Form:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FMyPanel: TMyPanel;
procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyPanel := TMyPanel.Create(nil);
FMyPanel.Parent := Form1;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FMyPanel.Free;
end;
procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Sender is TWinControl then
begin
ShowMessage('You clicked: ' + TWinControl(Sender).Name);
end;
end;
Example of adding a TButton to the form:
procedure TForm1.Button1Click(Sender: TObject);
var
Button: TButton;
begin
Button := TButton.Create(Form1);
Button.Parent := Form1;
FMyPanel.BringToFront;
with Button do
begin
Caption := 'Button';
Left := 25;
Name := 'Button';
Top := 15;
OnMouseDown := ControlMouseDown;
PaintTo(FMyPanel.Canvas, Left, Top);
Invalidate;
end;
end;
If you try running the above, you will see that the TButton we created does not animate or receive focus, but it can respond to MouseDown events we attached in the code above, that is because we are not actually looking at the control, instead we are viewing a graphical copy of the control.
I'm not sure if this is what you're after or not, but Greatis has a Form Designer component. See: http://www.greatis.com/delphicb/formdes/
Continue of this topic:
Drop down menu for TButton
I have wrote a generic code for DropDown memu with any TControl, but for some reason it dose not work as expected with TPanel:
var
TickCountMenuClosed: Cardinal = 0;
LastPopupControl: TControl;
type
TDropDownMenuHandler = class
public
class procedure MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
end;
TControlAccess = class(TControl);
class procedure TDropDownMenuHandler.MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if LastPopupControl <> Sender then Exit;
if (Button = mbLeft) and not ((TickCountMenuClosed + 100) < GetTickCount) then
begin
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
ReleaseCapture;
// SetCapture(0);
if Sender is TGraphicControl then Abort;
end;
end;
procedure RegisterControlDropMenu(Control: TControl; PopupMenu: TPopupMenu);
begin
TControlAccess(Control).OnMouseDown := TDropDownMenuHandler.MouseDown;
end;
procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu);
var
APoint: TPoint;
begin
LastPopupControl := Control;
RegisterControlDropMenu(Control, PopupMenu);
APoint := Control.ClientToScreen(Point(0, Control.ClientHeight));
PopupMenu.PopupComponent := Control;
PopupMenu.Popup(APoint.X, APoint.Y);
TickCountMenuClosed := GetTickCount;
end;
This works well with TButton and with TSpeedButton and with any TGraphicControl (like TImage or TSpeedButton etc) as far as I can tell.
BUT does not work as expected with TPanel
procedure TForm1.Button1Click(Sender: TObject);
begin
DropMenuDown(Sender as TControl, PopupMenu1);
end;
procedure TForm1.Panel1Click(Sender: TObject);
begin
DropMenuDown(Sender as TControl, PopupMenu1); // Does not work!
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
DropMenuDown(Sender as TControl, PopupMenu1);
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
DropMenuDown(Sender as TControl, PopupMenu1);
end;
Seems like TPanel is not respecting ReleaseCapture; and not even Abort in the event TDropDownMenuHandler.MouseDown. What can I do to make this work with TPanel and other controls? What am I missing?
It's not that TPanel is not respecting ReleaseCapture, it is that the capture is not relevant at all. This is what happens after the popup menu is launched and active, and the control is clicked once again:
The click cancels the modal menu loop, the menu is closed and a mouse down message is posted.
VCL sets a flag within the mouse down message handling [csClicked].
Mouse down event handler is fired, you release the capture.
After the mouse down message returns, posted mouse up message is processed, VCL checks for the flag and clicks the control if it is set.
The click handler pops the menu.
Granted I didn't trace a working example so I can't tell when and how ReleaseCapture is helpful. In any case, it can't help here.
The solution I'd propose is a little different than the current design.
What we want is a second click to not to cause a click. See this part of the code:
procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu);
var
APoint: TPoint;
begin
...
PopupMenu.PopupComponent := Control;
PopupMenu.Popup(APoint.X, APoint.Y);
TickCountMenuClosed := GetTickCount;
end;
The second click is in fact what closes the menu, before launching it again through the same handler. It is what causes the PopupMenu.Popup call to return. So what we can tell here is that the mouse button is clicked (either a left button or a double click), but not yet processed by the VCL. That means the message is yet in the queue.
Remove the registration mechanism (mouse down handler hacking) with this approach, it is not needed, and the class itself as a result, and the globals.
procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu);
var
APoint: TPoint;
Msg: TMsg;
Wnd: HWND;
ARect: TRect;
begin
APoint := Control.ClientToScreen(Point(0, Control.ClientHeight));
PopupMenu.PopupComponent := Control;
PopupMenu.Popup(APoint.X, APoint.Y);
if (Control is TWinControl) then
Wnd := TWinControl(Control).Handle
else
Wnd := Control.Parent.Handle;
if PeekMessage(Msg, Wnd, WM_LBUTTONDOWN, WM_LBUTTONDBLCLK, PM_NOREMOVE) then begin
ARect.TopLeft := Control.ClientOrigin;
ARect.Right := ARect.Left + Control.Width;
ARect.Bottom := ARect.Top + Control.Height;
if PtInRect(ARect, Msg.pt) then
PeekMessage(Msg, Wnd, WM_LBUTTONDOWN, WM_LBUTTONDBLCLK, PM_REMOVE);
end;
end;
Additionally this doesn't depend on processing timing.
Requirements
If I understand you correctly, then the requirements are:
At the first left mouse button click on a Control, a PopupMenu should be shown beneath the Control.
At the second left mouse button click an that same Control, the shown PopupMenu should be closed.
Realize that, disregarding the implementation of requirement 1 for the moment, requirement 2 happens automatically: when you click outside a PopupMenu, the PopupMenu will close. This concludes to that the implementation of the first should not interfere with the second.
Possible solutions:
Count the clicks on the Control: at the first click, show the PopupMenu and at the second click, do nothing. But this will not work, because the PopupMenu may be closed already by clicks elsewhere and then a second click should actually be the first click.
At the first click, show the PopupMenu. At the second click, determine whether the PopupMenu is still shown. If so, then do nothing. Otherwise, assume a first click. This also will not work, because when a second click is processed, the PopupMenu will be already closed.
At the first click, show the PopupMenu. At the second click, determine whether the PopupMenu is closed sometime during the last couple of milliseconds. If so, then the disappearance is due to this very second click and do nothing. This is the solution you are currently using by utilizing the fact that TPopupMenu.Popup will not return until the PopupMenu is closed.
The current implementation
During the OnClick event of a Control:
The OnMouseDown event of the control is assigned to a custom handler,
The PopupMenu is Shown.
On the second click on the Control:
The time when then PopupMenu was closed is saved (this is still during execution of the previous OnClick event),
The custom OnMouseDown event handler is called,
If the saved time was within the last 100 milliseconds, the mouse capture is released and all execution is aborted.
Note: a possibly already OnMouseDown event setting is not saved and gone!
Why this works for a Button
A TCustomButton handles click events by responding to a by Windows send CN_COMMAND message. That is a specific Windows BUTTON sytem class control characteristic. By canceling the mouse capture mode, this message is not send. Thus the Control's OnClick event is not fired on the second click.
Why this doesn't work for a Panel
A TPanel handles click events by adding the csClickEvents style to its ControlStyle property. This is a specific VCL characteristic. By aborting execution, subsequent code due to the WM_LBUTTONDOWN message is stopped. However, the OnClick event of a TPanel is fired somewhere down its WM_LBUTTONUP message handler, thus the OnClick event is still fired.
Solution for both
Use davea's answer on your other question wherein he simply does nothing if the saved time of the PopupMenu's closing was within the last 100 milliseconds.