I am having a problem with an effect trigger (shadow effect). I did put the trigger to be ismouseover = true. So, when I put the mouse onto a panel (parent), the shadows activate, and it works fine until I start putting some buttons inside the panel (children).
The shadows effect goes off when the mouse is over the children.
So, is there anyway to keep focus on the parents while being focused on the children?
I did try to change the trigger of the effects (from ismouseover to isfocused), but it didn't give any different results.
As said, your design is wrong, then you can remove the trigger and do it manually :
// show or hide shadow effect
procedure TForm2.ShowShadowEffect(AValue: boolean);
begin
if ShadowEffect1.Enabled <> AValue then
ShadowEffect1.Enabled := AValue;
end;
// show when enter on panel
procedure TForm2.Panel1MouseEnter(Sender: TObject);
begin
ShowShadowEffect(True);
end;
// hide when leave the panel
procedure TForm2.Panel1MouseLeave(Sender: TObject);
begin
ShowShadowEffect(False);
end;
// keep visible when over button
procedure TForm2.Button1MouseEnter(Sender: TObject);
begin
ShowShadowEffect(True);
end;
Related
When use TEdit control on the right side stay small icon 'x'. How after click on icon clear TEdit box.
Tnx all!
Delphi provide TClearEditButton to clear the TEdit content. It can be added by right clicking and selecting AddItem - TClearEditButton from the popup menu. It also has a Click procedure overriden in FMX.Edit unit like:
procedure TClearEditButton.Click;
var
EditTmp: TCustomEdit;
begin
inherited Click;
EditTmp := GetEdit;
if EditTmp <> nil then
begin
if EditTmp.Observers.IsObserving(TObserverMapping.EditLinkID) then
if not TLinkObservers.EditLinkEdit(EditTmp.Observers) then
Exit; // Can't change
EditTmp.Text := string.Empty;
if EditTmp.Observers.IsObserving(TObserverMapping.EditLinkID) then
TLinkObservers.EditLinkModified(EditTmp.Observers);
if EditTmp.Observers.IsObserving(TObserverMapping.ControlValueID) then
TLinkObservers.ControlValueModified(EditTmp.Observers);
end;
end;
Which make you don't need to write OnClick event handler for the TClearEditButton unless you want to do some other job along side with clearing the edit.
If you are using a TEditButton then you should write the OnClick event handler like:
procedure TForm1.EditButton1Click(Sender: TObject);
begin
Edit1.Text:= EmptyStr;
end;
Refer to this prior related question. While the answers there do work, I have further issues when it comes to certain types of controls such as a TDBGrid. If the TDBGrid currently has focus, but the mouse is pointed over another control to scroll, the TDBGrid scrolls anyway, thus resulting in two different controls scrolling at the same time. This happens in every single solution which I've found so far related to scrolling the control underneath the mouse.
How can I prevent this behavior and ensure that only the control under the mouse scrolls, and nothing else?
This code works fine for me.
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
var
Control: TWinControl;
begin
if Msg.message = WM_MOUSEWHEEL then
begin
// Find control at mouse cursor
Control := FindVCLWindow(Msg.pt);
if Assigned(Control) then
begin
// Try to scroll
if Control.Perform(CM_MOUSEWHEEL, Msg.wParam, Msg.lParam) <> 0 then
Handled := True
else
// If no scroll was performed by control,
// then detrmine if message control is at mouse cursor.
// If not, then supress message
if Control.Handle <> Msg.hwnd then
Handled := True;
end;
end;
end;
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.
I have a cylinder
Cylinder1 : TCylinder;
and I want it to change colour when I click on it.
I've added this to the on click event
procedure TfrmFiremonkey.Cylinder1Click(Sender: TObject);
begin
Cylinder1.MaterialSource := GreenMaterial;
end;
The cylinder does not change colour. However it will change colour if I set Cylinder1.MaterialSource before I call the form.Show event
I suspect the reason its not showing is because Cylinder1Click is happening in a different thread.
I have discovered that
procedure TfrmFiremonkey.Cylinder1Click(Sender: TObject);
begin
TColorMaterialSource(Cylinder1.MaterialSource).Color := claBlue;
end;
Works fine