I've got a TBitBtn on a TFrame with a click event that causes the button's own frame to get unparented from its container (effectively removing it) and stored for later restoration:
implementation
var
StoredFrames: TStack<TFrame>;
procedure TCustomFrame.BitBtnClick(Sender: TObject);
begin
// Some business logic
Self.ActiveControl := nil;
Self.Parent := nil;
StoredFrames.Push(Self);
end;
Later, the frame is reparented into its container and thus redisplayed. However, the blue highlighting the button got from the mouse when it was clicked, before getting stored, remains on the button:
After restoration, other controls can receive the same highlighting at the same time, but the button does not lose its highlighting until the frame is destroyed. How can I manually reset or remove this button highlighting?
Things I've tried:
Application.ProcessMessages in the click handler
Disabling the button on store, enabling on restore
Various kinds of repainting/layout invalidation
This might not be the most elegant solution, but it gets work done
private
{ Private declarations }
FRepaintTimer: TTimer;
procedure OnRepaintTimer(Sender: TObject);
public
{ Public declarations }
end;
implementation
{$R *.dfm}
procedure TFrame5.BitBtn1Click(Sender: TObject);
begin
if not Assigned(FRepaintTimer) then
begin
FRepaintTimer := TTimer.Create(Self);
FRepaintTimer.Interval := 50;
FRepaintTimer.OnTimer := OnRepaintTimer;
end;
BitBtn1.Enabled := False;
FRepaintTimer.Enabled := True;
end;
procedure TFrame5.OnRepaintTimer(Sender: TObject);
begin
//Self.ActiveControl := nil;
Self.Parent := nil;
BitBtn1.Enabled := True;
FRepaintTimer.Enabled := False;
end;
Since timers are limited resource, maybe you could Hide/Show frames instead of making use of Parent and use OnHide/OnShow events from TFrame and Enable/Disable your buttons there.
Per solution provided by #BlurrySterk in comments,
BitBtn.Perform(WM_MOUSELEAVE, 0, 0);
before unparenting the button's frame resets the button highlighting.
Related
Using Delphi Tokyo and FireMonkey:
I have a lot of different frames on a form and would like to set some form-level variables as the focus on the form changes in and out of the different frames.
Ex. I have a Insert button on the form and want to enable it if the frame the user is in allows inserts and then again disable it upon leaving the frame's focus.
There are OnEnter and OnExit events on the frame, but they never execute.
Obviously there are edits etc. on the frames.
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormFocusChanged(Sender: TObject);
private
FFocusedFrame: TFrame;
public
{ Public declarations }
end;
...
procedure TForm1.FormFocusChanged(Sender: TObject);
var
LParent: TFmxObject;
begin
if Focused <> nil then
begin
LParent := Focused.GetObject.Parent;
while (LParent <> nil) and not (LParent is TFrame) do
LParent := LParent.Parent;
if (LParent <> nil) and (FFocusedFrame <> LParent) then
begin
FFocusedFrame := TFrame(LParent);
Label1.Text := FFocusedFrame.Name;
end;
end;
end;
end.
No need to hook up OnEnter and OnExit for every control
The frames can not receive focus, and therefore they do not fire OnEnter() or OnExit() events.
After you have placed a frame on the form, you can create two common event handlers for all edit controls (or other input controls on the frame)
procedure TForm14.Frame112EditExit(Sender: TObject);
begin
Button1.Enabled := False;
end;
procedure TForm14.Frame112EditEnter(Sender: TObject);
begin
Button1.Enabled := True;
end;
and link the OnEnter() and OnExit() events of all those edit controls to these two event handlers.
I was unsure whether the events are fired in correct order when moving from one edit control to anotherone, but a short test (on Windows) shows that OnExit() of the control we leave is fired before OnEnter() of the control we enter, as expected.
In my Delphi XE2 Project, I am having Form1, Label1 and CheckBox1.
My requirement is to set the CheckBox1.Font.Color := clGreen;.
Thought I have written
procedure TForm1.FormCreate(Sender: TObject);
begin
CheckBox1.Font.Color := clGreen;
end;
yet the Font Color is default Black. So I have defined it in other way as follows:
I have removed the Caption from the CheckBox1 and changed the Width to 17.
Then I have placed Label1 next to CheckBox1 like CleckBox1 Caption.
After that I have written:
procedure TForm1.Label1Click(Sender: TObject);
begin
CheckBox1.Click;
end;
to Toggle the state of CheckBox1.
But I am getting [DCC Error] Unit1.pas(37): E2362 Cannot access protected symbol TCustomCheckBox.Click.
And another question is that whether the OnMouseDown Event of CheckBox1 can be triggered as the following image:
The Click() method merely triggers the contro's OnClick event, nothing else. It does not actually cause the control to perform click-related logic, like updating its internal state.
You can toggle the CheckBox's state like this:
CheckBox1.Checked := not CheckBox1.Checked;
Alternatively, use an accessor class to reach protected members:
type
TCheckBoxAccess = class(TCheckBox)
end;
TCheckBoxAccess(CheckBox1).Toggle;
You can use it like :
procedure TForm1.Label1Click(Sender: TObject);
begin
//either
CheckBox1.Checked := not CheckBox1.Checked; // this trigger onClick event!!
// or
// if you absolutely need it..
CheckBox1Click(Sender); // NOTE this will not check or uncheck CheckBox1
end;
But note you use here a TLabel Object (Sender). If you do not use Sender you can do it Without further attention.
But it's better to put the code for enable and disable other control out of the event. only one line for example doenable() .
procedure TForm1.doEnable(enable: Boolean);
begin
Edit1.Enabled := enable;
Edit2.Enabled := enable;
Edit3.Enabled := NOT enable;
if enable then Label1.Font.Color := clGreen else Label1.Font.Color := clWindowText;
...
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
// NOTE This trigger also CheckBox1 Click event.
CheckBox1.Checked := not CheckBox1.Checked;
// NOT needed.
//if CheckBox1.Checked then doEnable(true) else doEnable(false);
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then doEnable(true) else doEnable(false);
end;
Background
I've created a GUI using some FireMonkey controls.
Some controls are animated and their appearance updates automatically.
Some controls only update in response to user interaction (sliders etc).
Problem
Interaction with the user controls prevents updates to the animated controls, resulting in jerky discontinuous animation.
Video of glitchy animation
The animated control in the video above is driven by a TTimer component. The problem persists when using FireMonkey's animation components.
Investigation
The slider controls call Repaint() when adjusted. Smoothly adjusting a slider will generate a dense stream of Repaint() calls which block other controls from being updated.
What To Do?
Freezing animations while one control is continuously updated is not appropriate for my application. My first thought is to swap the Repaint() calls for something similar to the VCL Invalidate() method, but FireMonkey doesn't have anything comparable AFAIK.
Is there a good workaround for this problem?
I've created a timer based repaint method as Arnaud Bouchez suggested in the comments above. So far it seems to work.
Code
unit FmxInvalidateHack;
interface
uses
Fmx.Types;
procedure InvalidateControl(aControl : TControl);
implementation
uses
Contnrs;
type
TInvalidator = class
private
protected
Timer : TTimer;
List : TObjectList;
procedure Step(Sender : TObject);
public
constructor Create;
destructor Destroy; override;
procedure AddToQueue(aControl : TControl);
end;
var
GlobalInvalidator : TInvalidator;
procedure InvalidateControl(aControl : TControl);
begin
if not assigned(GlobalInvalidator) then
begin
GlobalInvalidator := TInvalidator.Create;
end;
GlobalInvalidator.AddToQueue(aControl);
end;
{ TInvalidator }
constructor TInvalidator.Create;
const
FrameRate = 30;
begin
List := TObjectList.Create;
List.OwnsObjects := false;
Timer := TTimer.Create(nil);
Timer.OnTimer := Step;
Timer.Interval := round(1000 / FrameRate);
Timer.Enabled := true;
end;
destructor TInvalidator.Destroy;
begin
Timer.Free;
List.Free;
inherited;
end;
procedure TInvalidator.AddToQueue(aControl: TControl);
begin
if List.IndexOf(aControl) = -1 then
begin
List.Add(aControl);
end;
end;
procedure TInvalidator.Step(Sender: TObject);
var
c1: Integer;
begin
for c1 := 0 to List.Count-1 do
begin
(List[c1] as TControl).Repaint;
end;
List.Clear;
end;
initialization
finalization
if assigned(GlobalInvalidator) then GlobalInvalidator.Free;
end.
==
Usage
A control can be repainted by calling:
InvalidateControl(MyControl);
The InvalidateControl() procedure doesn't repaint the control immediately. Instead it adds the control to a list. A global timer later checks the list, calls Repaint() and removes the control from the list. Using this method, a control can be invalidated as needed but will not block other controls from being updated, as rapid Repaint() calls do.
When the user clicks 'x' on a Pinned Form OnClose is called.
When the user clicks 'x' on an Unpinned Form OnHide is called
When the user clicks 'UnPin' on a Pinned Form OnHide is called.
I'm trying to synchronise the visible forms with a menu system but I don't know how to determine the difference in the OnHide event between when the user clicks 'x' and when the user clicks 'UnPin'. I want to intercept the 'x' and call Close instead.
Each child is a descendant of TManagerPanel which in turn is a descendant of TForm with the border style set to bsSizeToolWin, Drag Kind set to dkDock and Drag Mode is dmAutomatic.
type
TPanelManager = class(TForm)
...
private
...
Panels: TManagerPanelList;
Settings: TSettings; //User Settings
...
end;
...
function TPanelManager.InitChild(ChildClass: TManagerPanelClass): TManagerPanel;
var
Child: TManagerPanel;
begin
Child := ChildClass.Create(Self);
Child.Connection := MSConnection1;
Child.Settings := Settings;
Child.Styles := Styles;
...
Child.OnPanelClosed := PanelClosed;
Child.OnPercentChanged := PercentChanged;
...
Child.OnPanelHide := PanelHide;
Child.Font := Font;
Child.Initialise;
Child.ManualDock(DockTarget);
Panels.AddPanel(Child);
Result := Child;
end;
procedure TPanelManager.PanelClosed(Sender: TObject; var Action: TCloseAction);
var
MenuItem: TMenuItem;
Child: TManagerPanel;
begin
if Sender is TManagerPanel then
begin
Child := TManagerPanel(Sender);
Action := caFree;
MenuItem := MenuItemFromChild(Child);
MenuItem.Checked := False;
Settings[RemoveAmpersand(MenuItem.Caption)] := MenuItem.Checked;
Panels.Remove(Child);
end;
end;
EDIT:
What I mean by a "Pinned" Form: A docked form with the pin set such that it always visible.
What I mean by a "UnPinned" Form: A docked form with the pin released such that a tab appears in a dock tab set and the form appears when the tab is selected.
Delphi Version is 2007
it seems that pinning and unpinning a docked form changes it's parent between a TTabDockPanel and the TPanel I'm docking it to.
Adding an OnHide method to the Demo Dock Form...
procedure TfrmDock.FormHide(Sender: TObject);
begin
if Assigned(Self.Parent) then
ShowMessage(Self.Parent.ClassName)
else
ShowMessage('No Parent');
end;
I can now distinguish between "Floating", "Docked,Pinned" and "Docked, Unpinned" when the form gets hidden.
EDIT
I've found a better way of doing this
procedure TfrmDock.FormHide(Sender: TObject);
begin
if Assigned(Parent) then
begin
if Not (csDocking in ControlState) then //This was the original test above
begin
if Parent is TTabDockPanel then // This is now a safety check
begin
if TTabDockPanel(Parent).AnimateSpeed = 1 then //Additional Test
//form is closing
else
//form is hiding (Unpinned focused changed)
end;
end
else
//form is being unpinned.
end;
end;
In DockCaptionMouseUp the Animation Speed is set to 1 so that the panel appears to close (Hides really fast). The same happens for "Unpinning" but control state changes.
How do you prevent a new event handling to start when an event handling is already running?
I press a button1 and event handler start e.g. slow printing job.
There are several controls in form buttons, edits, combos and I want that a new event allowed only after running handler is finnished.
I have used fRunning variable to lock handler in shared event handler. Is there more clever way to handle this?
procedure TFormFoo.Button_Click(Sender: TObject);
begin
if not fRunning then
try
fRunning := true;
if (Sender = Button1) then // Call something slow ...
if (Sender = Button2) then // Call something ...
if (Sender = Button3) then // Call something ...
finally
fRunning := false;
end;
end;
Another option (that does not require a flag field) would be to temporarily assign NIL to the event:
procedure TForm1.Button1Click(Sender: TObject);
var
OldHandler: TNotifyEvent;
begin
OldHandler := (Sender as TButton).OnClick;
(Sender as TButton).OnClick := nil;
try
...
finally
(Sender as TButton).OnClick := OldHandler;
end;
end;
For convenience sake this could be wrapped into an interface:
interface
function TempUnassignOnClick(_Btn: TButton): IInterface;
implementation
type
TTempUnassignOnClick = class(TInterfacedObject, IInterface)
private
FOldEvent: TNotifyEvent;
FBtn: TButton;
public
constructor Create(_Btn: TButton);
destructor Destroy; override;
end;
constructor TTempUnassignOnClick.Create(_Btn: TButton);
begin
Assert(Assigned(_Btn), 'Btn must be assigned');
inherited Create;
FBtn := _Btn;
FOldEvent := FBtn.OnClick;
FBtn.OnClick := NIL;
end;
destructor TTempUnassignOnClick.Destroy;
begin
FBtn.OnClick := FOldEvent;
inherited;
end;
function TempUnassignOnClick(_Btn: TButton): IInterface;
begin
Result := TTempUnassignOnClick(_Btn);
end;
to be used like this:
procedure TForm1.Button1Click(Sender: TObject);
begin
TempUnassignOnClick(Sender as TButton);
...
end;
Your solution is OK. You can also link button clicks to actions and enable/disable actions in TAction.OnUpdate event handler, but you still need fRunning flag to do it. The "if no fRunning" line may be not nessesary here, but I don't removed it because it is more safe:
// Button1.Action = acButton1, Button2.Action = acButton2, etc
procedure TForm1.acButtonExecute(Sender: TObject);
begin
if not fRunning then
try
fRunning:= True;
if (Sender = acButton1) then // Call something slow ...
if (Sender = acButton2) then // Call something ...
if (Sender = acButton3) then // Call something ...
finally
fRunning:= False;
end;
end;
procedure TForm1.acButtonUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled:= not fRunning;
end;
You don't have to do this at all, since all of this is happening in the main (VCL) thread:
No other button (VCL) event can be entered until the previous (VCL) event handler has returned...
The simultaneous execution of another event handler could only happen unexpectedly if some other thread was preemptively entering a second button event (before the first one has completed), but that can't happen, since there is only one VCL thread.
Now if the lengthy thing you are doing is done in another thread because you don't want it to block the GUI, then you can simply set the Button.Enabled property to false until your processing is done.
And if you decide to just stick in the button event until everything has completed, use application.processmessages frequently enough in your processing loop to prevent the gui from freezing. In which case, yes, you must disable the original button to prevent reentry.
As Gerry already mentioned in one of the comments, you can disable entire form:
procedure TFormFoo.Button_Click(Sender: TObject);
begin
try
Enabled := False;
//...
finally
Enabled := True;
end;
end;
If your app is a single-threaded one, then while your event-handler code is running, your app cannot run other codes, so all calls to that event-handler will be serialized, and you don't need to be worried.
If your event-handler is running any asynchronous job, then you can use the technique you presented in your question.