How to avoid repeating execution of TAction.Shortcut? - delphi

In Delphi 10.1.2, inside a TActionList I have created a TAction with these properties and assigned a shortcut Ctrl+F12 to it:
At runtime, when I keep the shortcut keys Ctrl+F12 pressed, the action is executed repeatedly (with speed depending on the system keyboard repeating speed).
So how can I make the action execute only ONCE (until these keys are lifted up), even if the user keeps the keys pressed down or if the user's system has a high keyboard repeat speed setting?

You can retrieve system keyboard settings by using SystemParametersInfo. SPI_GETKEYBOARDDELAY gives the repeat delay; the time between the first and second generated events. SPI_GETKEYBOARDSPEED gives keyboard repeat rate; the duration between events after the initial delay. The documentation has approximate values of the slowest and fastest settings which may help you decide on an acting point.
Suppose you decided to act on. Since shortcuts expose no direct relation to the event that generated them, they have no property or anything that could reveal information about if it is an initial, delayed, or repeated execution.
Then, one option is to disable a shortcut's execution as soon as it is entered and re-enable after the appropriate key has been released. You have to set KeyPreview of the form to true to implement this solution as any of the controls on the form might be the one with the focus when a shortcut is generated.
A less cumbersome solution I would find is to prevent generation of the shortcut when it's not generated by an initial key-down. You have to watch for key down events this time.
One possible implementation can be to install a local keyboard hook.
var
KeybHook: HHOOK;
procedure TForm1.FormCreate(Sender: TObject);
begin
KeybHook := SetWindowsHookEx(WH_KEYBOARD, KeyboardProc, 0, GetCurrentThreadId);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnhookWindowsHookEx(KeybHook);
end;
It's probably tempting to test for the repeat count of the interested key in the callback, however, as mentioned in the documentation for WM_KEYDOWN, the repeat count is not cumulative. What that practically means is that the OS does not supply this information. The previous key state information is provided though. That would be bit 30 of the "lParam" of the callback. You can prevent any keyboard message when your shortcut keys are down, and the primary shortcut has been previously down, from reaching the window procedure of the focused control.
function KeyboardProc(code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
stdcall;
begin
if code > 0 then begin
if (wParam = vk_f12) and (GetKeyState(VK_CONTROL) < 0) and
((lParam and $40000000) > 0) then begin
Result := 1;
Exit;
end;
end;
Result := CallNextHookEx(KeybHook, code, wParam, lParam);
end;
Lastly, don't disregard the probability that if a user's system has been set up with a fast keyboard repeat, it's the user's choice rather than not.

Related

Delphi, TEdit text as action trigger

I am using a TEdit to allow the user to enter a number, e.g. 10.
I convert the TEdit.Text to an integer and a calculation procedure is called.
In this calc procedure, a check was built-in to make sure no numbers below 10 are processed.
Currently I use the OnChange event. Suppose the user wants to change '10' into e.g.'50'. But as soon as the '10' is deleted or the '5' (to be followed by the 0) is typed, I trigger my warning that the minimum number is 10. I.e. the program won't wait until I have fully typed the 5 and 0.
I tried OnEnter, OnClick, OnExit, but I seem not to overcome this problem. The only solution is to add a separate button that will trigger the calculation with the new number. It works, but can I do without the button?
Use a timer for a delayed check, e.g.:
procedure TForm1.Edit1Change(Sender: TObject);
begin
// reset the timer
Timer1.Enabled := false;
Timer1.Enabled := true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := false;
// do your check here
end;
Setting the timer to 500 ms should be fine for most users.
And as David suggested in the comments to the question: Do not show an error dialog, use something less intrusive instead, e.g. an error message in a label near the edit or change the background color. And also: Do not prevent the focus to be moved away from that control and do not play a sound, that's also very annoying.
For our in house software we set the background of a control to yellow if there is an error and display the error message of the first such error in the status bar and also as a hint of the control. If you do that, you probably don't even need to have the delay.
Thanks, for your help. I tried the timer option, but could not get that to work. I now have this code, which works (almost - see below), but requires the used to always type a CR:
procedure Calculate;
begin
// this is my calculation procedure
ShowMessage('calculation running correctly');
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
N : integer;
begin
if Key = #13 then
begin
N := StrtoInt(Edit1.Text);
if N<10 then ShowMessage('<10!') else
if N>100 then ShowMessage('>100!') else Calculate;
end;
end;
I used the ShowMessage() here only to see if the sample code worked. In the real program I have left that out, as you all suggested.
I also included the 'turn yellow on wrong entry' (thanks David). The only issue is that if the user runs this I get a beep from my computer. I can't see what went wrong. But what is causing the beep?

Detect key(s) held down in another process

I have a Delphi 2007 Win32 executable which sends keystrokes to other applications. My app is invoked from within these target applications by a hotkey like F11 or Shift+F11.
I want users to be able to hold down a key to abort the keystroke sending (say, if they realize they invoked my app in the wrong location). I had thought Shift, Ctrl, and Alt were good candidates because, alone, those key presses aren't likely to disrupt anything in the target application. (Escape, for instance, is a bad choice, as it might cause the target application to close one or more windows.)
I wrote the function farther below and call it periodically as follows, while sending keystrokes with the intent of detecting keys held down.
if wsAnyKeysDownInWindow( TgtWindow, [VK_Escape, VK_Menu{Alt}, VK_Control, VK_Shift] ) then
Abort;
Problem is, my app sends keystroke combinations like Shift+Tab and Ctrl+Home, which (I think) makes this approach fail--it always detects a down state for Shift and/or Ctrl. (I also tried a similar function which called SetKeyboardState just prior to beginning to send keystrokes, to set the key states' high-order (down) bit but that didn't help.)
Anyone think of a workable approach, short of hooking the keyboard?
function wsAnyKeysDownInWindow(Handle: HWnd; VKeys: array of byte): boolean;
{ Checks whether each of the VKeys set of virtual keys is down in Handle,
a window created by another process. }
var
OtherThreadID : integer;
State: TKeyboardState;
AKey: byte;
begin
Result := False;
if not IsWindow(Handle) then
exit;
OtherThreadID := GetWindowThreadProcessID( Handle, nil);
if AttachThreadInput( GetCurrentThreadID, OtherThreadID, True ) then try
GetKeyboardState(State);
for AKey in VKeys do
if (State[AKey] and 128) <> 0 then begin //If high-order bit is set, key is down
Result := True;
exit;
end;
finally
AttachThreadInput( GetCurrentThreadID, OtherThreadID, False );
end;
end;
Consider using Scroll Lock for this. It is rarely used (only of Excel comes to my mind), and you will have even visual indicator if keys are being sent or not.
BTW, Alt is not a good choice for another reason - it invokes the main menu in an application (if there is one, of course).

Determine if SHIFT is pressed insde keyboard Hook Proc

inside my hook proc, how can i determine whether a used is pressing SHIFT (without releasing it) and then a char key (like A) ?
for example, if i press Shift+A, i want to know that it will be an uppercase a instead of getting it like Shift, a
so it will be A, if a user presses and releases Shift, it will capture Shift only.
the instaleld hook is WH_KEYBOARD (Global)
function KeyHookProc(Code: Integer; wVirtKey: WPARAM; lKeyStroke: LPARAM)
: LRESULT; stdcall;
type
TTransitionState = (tsPressed, tsReleased);
PKeystrokeData = ^TKeystrokeData;
TKeystrokeData = record
VirtualKey: WPARAM;
KeyStroke: LPARAM;
KeyState: TKeyboardState;
end;
var
Transition: TTransitionState;
KeystrokeDataPtr: PKeystrokeData;
begin
Result := CallNextHookEx(hKeyHook, Code, wVirtKey, lKeyStroke);
Transition := TTransitionState((lKeyStroke shr 31) and 1);
if (Code = HC_ACTION) and (Transition = tsPressed) then
begin
New(KeystrokeDataPtr);
try
KeystrokeDataPtr^.VirtualKey := wVirtKey;
KeystrokeDataPtr^.KeyStroke := lKeyStroke;
GetKeyboardState(KeystrokeDataPtr^.KeyState);
SendMessage(hConsole, WM_NULL, 0, LPARAM(KeystrokeDataPtr));
finally
Dispose(KeystrokeDataPtr);
end;
end;
end;
Here's the code we use in normal day-to-day use to detect the shift key. I've never used it in a hooked context, so I don't know if it would work there, or if something is different in that context that would prevent it.
function ShiftIsDown : Boolean;
var
State: TKeyboardState;
begin
WINDOWS.GetKeyboardState(State);
Result := ((State[vk_Shift] and 128) <> 0);
end;
You detect the pressing of the SHIFT key when your hook proc is called with wParam equal to VK_SHIFT.
When your hook proc is called corresponding to the A key being pressed, the wParam and lParam values are identical whether or not the SHIFT key is down. Since you are not calling TranslateMessage and DispatchMessage as would happen in a normal message loop, you are going to have to translate the raw key down/up events into actual key presses.
It's probably going to be easiest for you to use GetKeyState(VK_SHIFT)<0 to detect whether or not the SHIFT key is down. That depends on exactly what you are trying to do. It looks a little like you are making a fully functioned keylogger. In which case ad-hoc calls to GetKeyState(VK_SHIFT)<0 may not meet your needs, and proper processing of the individual key down/up messages would be better.
Some other comments:
Why are you heap allocating your TKeystrokeData record? You can perfectly well use a stack allocated record.
I hope that hConsole is a window in the same process as your hook. If not it won't receive any useful information because the pointer you send it is only meaningful in the process that defines it. If you want to send information cross-process them WM_COPYDATA is your guy.

accessing components of frame1 with frame2, with frame2 being on frame1, in delphi, frames are created dynamically

Originally the question had to be how to access the components in the first place, however I somehow managed to figure it out. I am just learning Delphi so I am prone to dumb and obvious questions. I am also at a stage when I'm not actually writing anything useful, but just messing with random stuff to see how it works and maybe learn something.
Wall of text incoming, i want to explain what i am exploring at the moment...
Basically i have a form1 with a button1, pressing it creates a frame2, that frame2 has a button2, pressing button2 creates a frame3 within frame2 (it being frame3's parent and owner). Each frame has an another freeandnil-button. Upon pressing each button1/2/3, it gets disabled to prevent creating multiple instances. My original problem was that after using freeandnil-button, I couldnt access the button on the previous frame (it worked fine for forms, form1.button1.enabled:=true works fine from within frame2) that got disabled in order to re-enable it (frame2.button1.enabled:=true from within frame3 creates an access violation, I think).
Suppose I write something in the future that requires such communication? So I added an editbox to each frame, with a button on the other to change the editbox text, this is my current working solution:
procedure TFrame2.Button3Click(Sender: TObject);
var i,z:integer;
begin
for i := 0 to ComponentCount - 1 do
if components[i] is tframe3 then
for z := 0 to (components[i] as tframe3).ComponentCount - 1 do
if (components[i] as tframe3).Components[z] is TEdit then
((components[i] as tframe3).Components[z] as TEdit).Text:='ping';
end;
and
procedure TFrame3.Button3Click(Sender: TObject);
var i:integer;
begin
for i := 0 to parent.ComponentCount-1 do
if parent.components[i] is TEdit then
(parent.Components[i] as TEdit).Text:='pong';
end;
If I have a bunch of editboxes or whatever the hell, I suppose I could use Tag property to identify them, however, this much component counting and passing something AS something doesn't really look right or efficient enough to me.
My questions at the moment are: can it be done in a better way? and can someone provide the reasoning why cant I access "parent-frame" components from a "child-frame" in a dumb way (ie: frame2.button1.enabled:=true from within frame3)?
A couple of points:
Controls/Components are usually set to be owned by the form/frame that controls their lifetime and parented to the control that shows them. So when you create a TEdit to sit on a TPanel on a TForm, you would set TForm as the owner and TPanel as the parent of the TEdit. With frames you do the same: the frame is the owner of all controls on it, controls are parented to whatever container on the frame (can be the frame itself) is holding and and is thus reponsible for showing (painting) it.
When you iterate over the children of a control, iterating over Components uses the Owner relation; iterating over Controls uses the Parent relation. So your code above would already do a lot less if it were to iterate over the Controls.
Of course you can reference other controls in a "dumb" way, but you will have to provide for the access method. If you want others (not just child frames) you will at the very least have to declare a method to retrieve that control. Many ways to do this. One is to "ask" the form when you need it (using a method on the form), or have the form set a property on the frame when it is created...
Avoid accessing form's and frame's published properties. They are mainly there for Delphi's streaming system. When you tie your application together using your approach described above it can very soon become one incredibly tangled mess...
Example coming up (sometime this evening), it will take me a bit of time to also explain and I have work to do...
The following example deals only with the ping-pong game between the frames. Freeing any form or frame from one of its own event handlers is not such a good idea. Use the Release method for that as it prevents the form/frame from processing messages after is was freed. (Plenty of questions about this on SO by the way). Also, when you do release a frame from one of its own buttons, you will need to take care that the frame that created it has a chance to nil the references it may have held to that frame otherwise you are setting yourself up for some interesting to debug mayhem. Look into "Notification" and "NotifyControls" and the automatic notification by forms and frames that is sent to their owner/parent so these can remove the control from their components/controls collection. In your example, if you were to release Frame3 from its own "FreeAndNil" button's OnClick event handler, you would have to make sure that the Frame2 responds to the deletion (I think) notification message and nil's any references it holds to Frame3 (besides the ones that will already be cleared automatically in the components/controls collections).
Now, the ping pong game. There are a couple of ways to go about this.
Method 1
The first way is what you already tried with a loop over the components of the other frame. While it certainly is a way to avoid having to "use" the other frame, it is cumbersome and not very concise. Plus when you get more controls on your forms/frames, you will have to add a check on the name to know that you have the correct TEdit. And then you might just as well use the name directly, especially as one frame already has the other frame in its uses clause because it is creating it.
// PingFrame (your Frame2)
uses
...
Pong_fr;
type
TPingFrame = class(TFrame)
...
procedure CreateChildBtnClick(Sender: TObject);
procedure PingPongBtnClick(Sender: TObject);
private
FPong: TPongFrame; // This is the "extra" reference you need to nil when
// freeing the TPongFrame from one of its own event handlers.
...
end;
procedure TPingFrame.CreateChildBtnClick(Sender: TObject);
begin
CreateChildBtn.Enabled := False;
FPong := TPongFrame.Create(Self);
FPong.Parent := ContainerPnl;
FPong.Align := alClient;
end;
procedure TPingFrame.PingPongBtnClick(Sender: TObject);
begin
if Assigned(FPong) then
FPong.Edit1.Text := 'Ping';
end;
And on the other end:
// PongFrame (your Frame3)
type
TPongFrame = class(TFrame)
...
procedure PingPongBtnClick(Sender: TObject);
end;
implementation
uses
Ping_fr;
procedure TPongFrame.PingPong1BtnClick(Sender: TObject);
begin
(Owner as TPingFrame).Edit1.Text := 'Pong called';
end;
This method seems all nice and dandy, but it has drawbacks:
You need to use the unit that holds the TPingFrame (Ping_fr in this example). Not too bad I guess, but... as Ping_fr already uses Pong_fr (the unit holding TPongFrame), you can't have Ping_fr using Pong_fr in the interface section and have Pong_fr using Ping_fr in the interface section as well. Doing so would have Delphi throwing an error because of a circular references. This can be solved by moving one of the uses to the implementation section (as done in the example for the use of Ping_fr in the Pong_fr unit.
A bigger drawback is that there is now a very tight coupling between the two frames. You cannot change the TEdit in either one to another type of control (unless that happens to have a Text property as well) without having to change the code in the other unit as well. Such tight coupling is a cause of major headaches and it is good practice to try and avoid it.
Method 2
One way to decrease the coupling between the frames and allow each frame to change it controls as it sees fit is not to use the controls of another form/frame directly. To do so you declare a method on each frame that the other can call. Each method updates its own controls. And from the OnClick event handlers you no longer access the other frame's controls directly, but you call that method
type
TPingFrame = class(TFrame)
...
public
procedure Ping;
end;
implementation
procedure TPingFrame.PingPongBtnClick(Sender: TObject);
begin
if Assigned(FPong) then
FPong.Ping;
end;
procedure TPingFrame.Ping;
begin
Edit1.Text := 'Someone pinged me';
end;
And on the other end:
type
TPongFrame = class(TFrame)
...
public
procedure Ping;
end;
implementation
procedure TPongFrame.PingPongBtnClick(Sender: TObject);
begin
(Owner as TPingFrame).Ping;
end;
procedure TPongFrame.Ping;
begin
Edit1.Text := 'Someone pinged me';
end;
This is better than Method 1 as it allows both frames to change their controls without having to worryabout "outsiders" referencing them, but still has the drawback of the circular reference that can only be "solved" by moving one "use" to the implementation section.
It is a good practice to try and avoid circular references altogether instead of patching them by moving units to the implementation section's uses clause. A rule of thumb I use is:
Any form/frame may know and use the public interface of the forms/frames it instantiates (though it should avoid the controls in the "default visibility" part of that interface), but no form/frame should not have any knowledge of the specific form/frame that created it.
Method 3
One way of achieving this (there are many) it to use events just like the TButton's OnClick event.
On the TPongFrame side of things you can remove the use of Ping_fr. You no longer need it.
Then you need to declare a property and the field it references and declare a method to fire the event.
type
TPongFrame = class(TFrame)
private
FOnPingPongClicked: TNotifyEvent;
protected
procedure DoPingPongClicked;
public
property OnPingPongClicked: TNotifyEvent
read FOnPingPongClicked write FOnPingPongClicked;
end;
The Ping method stays and its implementation is unchanged. The PingPongBtnClick event handler also stays, but its implementation now becomes:
procedure TPongFrame.PingPongBtnClick(Sender: TObject);
begin
DoPingPongClicked;
end;
procedure TPongFrame.DoPingPongClicked;
begin
if Assigned(FOnPingPongClicked) then
FOnPingPongClicked(Self);
end;
You could put the code from DoPingPongClicked straight in here, but it is a good practice to fire an event in a separate method. It avoids duplicating the exact same code if you would have an event that can be fired from multiple parts of your code. And it also allows descendants (when you get those) to override the "firing" method (you'll have to mark it virtual in the ancestor) and do something specific all the times the event is fired.
On the TPingFrame side of things you need to code a handler for the new event:
type
TPingFrame = class(TFrame)
...
protected
procedure HandleOnPingPongClicked(Sender: TObject);
Note that the signature of this handler needs to be what the TNotifyEvent specifies. And of course you need to ensure that this event handler gets called when the event fires in TPongFrame:
procedure TPingFrame.CreateChildBtnClick(Sender: TObject);
begin
CreateChildBtn.Enabled := False;
FPong := TPongFrame.Create(Self);
FPong.Parent := ContainerPnl;
FPong.Align := alClient;
// Listen to event fired by PongFrame whenever it's PingPingBtn is clicked
FPong.OnPingPongClicked := HandleOnPingPongClicked;
end;
In the handler code you can do what you need to do. It can be general:
procedure TPingFrame.HandleOnPingPongClicked(Sender: TObject);
begin
Edit1.Text := 'OnPingPongClicked event was fired';
end;
And of course you can also use the fact that the event passes a reference to the instance firing the event as well:
procedure TPingFrame.HandleOnPingPongClicked(Sender: TObject);
var
Pong: TPongFrame;
begin
// This checks that Sender actually is a TPongFrame and throws an exception if not
Pong := Sender as TPongFrame;
// Use properties from the Pong instance that was passed in
Edit1.Text := 'OnPingPongClicked event was fired by ' + Pong.Name;
end;
Enjoy!

How can I capture modifier keys while starting a Delphi app to force some behavior

I'm writing an application in Delphi which uses an SQLite3 database. I'd like to be able to start the application while holding some modifier keys, such as CTRL + SHIFT, to signal reinitialization of the database.
How can I capture that the application was started while these keys were held?
Tim has the right answer, but you might need a little more framework:
procedure TForm56.Button1Click(Sender: TObject);
begin
if fNeedReinit then
ReinitializeDatabase;
end;
procedure TForm56.FormCreate(Sender: TObject);
begin
fNeedReinit := False;
end;
procedure TForm56.FormShow(Sender: TObject);
begin
fNeedReinit := (GetKeyState(VK_SHIFT) < 0) and (GetKeyState(VK_CONTROL) < 0);
end;
Change Button1Click with your later event that checks to see if fNeedReinit has been set. You can also set KeyPreview on your main form if you have trouble getting it to catch the key stroke. I just tested the above code and it works, but if you have a splash screen, etc. then it might change things.
if (GetKeyState(VK_SHIFT) < 0) and (GetKeyState(VK_CONTROL) < 0) then
ReinitializeDatabase;
Try one of GetAsyncKeyState, GetKeyState or GetKeyboardState API functions to read the current state of the ctrl and shift keys at program startup. Adding a keyboard hook at startup may not work since the key press events for the shift keys could have occurred before your application has a chance to install the hook.
You have to capture keyboard hooks in your application.
See Here
and then process the hooks before you show the main form - eg before the CreateForm and Run in the dpr file

Resources