Problem with Keyboard hook proc - delphi

The background: My form has a TWebBrowser. I want to close the form with ESC but the TWebBrowser eats the keystrokes - so I decided to go with a keyboard hook.
The problem is that the Form can be open in multiple instances at the same time.
No matter what I do, in some situations, if there are two instances open of my form, closing one of them closes the other as well.
I've attached some sample code. Any ideas on what causes the issue?
var
EmailDetailsForm: TEmailDetailsForm;
KeyboardHook: HHook;
implementation
function KeyboardHookProc(Code: Integer; wParam, lParam: LongInt): LongInt; stdcall;
var
hWnd: THandle;
I: Integer;
F: TForm;
begin
if Code < 0 then
Result := CallNextHookEx(KeyboardHook, Code, wParam, lParam)
else begin
case wParam of
VK_ESCAPE:
if (lParam and $80000000) <> $00000000 then
begin
hWnd := GetForegroundWindow;
for I := 0 to Screen.FormCount - 1 do
begin
F := Screen.Forms[I];
if F.Handle = hWnd then
if F is TEmailDetailsForm then
begin
PostMessage(hWnd, WM_CLOSE, 0, 0);
Result := HC_SKIP;
break;
end;
end; //for
end; //if
else
Result := CallNextHookEx(KeyboardHook, Code, wParam, lParam);
end; //case
end; //if
end;
function TEmailDetailsForm.CheckInstance: Boolean;
var
I, J: Integer;
F: TForm;
begin
Result := false;
J := 0;
for I := 0 to Screen.FormCount - 1 do
begin
F := Screen.Forms[I];
if F is TEmailDetailsForm then
begin
J := J + 1;
if J = 2 then
begin
Result := true;
break;
end;
end;
end;
end;
procedure TEmailDetailsForm.FormCreate(Sender: TObject);
begin
if not CheckInstance then
KeyboardHook := SetWindowsHookEx(WH_KEYBOARD, #KeyboardHookProc, 0, GetCurrentThreadId());
end;
procedure TEmailDetailsForm.FormDestroy(Sender: TObject);
begin
if not CheckInstance then
UnHookWindowsHookEx(KeyboardHook);
end;

You could do this with TApplicationEvents.OnMessage instead. Drop a TApplicationEvents component on your application's main form with this code:
procedure TMainForm.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
var
C: TControl;
H: HWND;
begin
if (Msg.message = WM_KEYDOWN) and (Msg.wParam = VK_ESCAPE) then begin
H := Msg.hwnd;
while GetParent(H) <> 0 do
H := GetParent(H);
C := FindControl(H);
if C is TEmailDetailsForm then begin
TEmailDetailsForm(C).Close;
Handled := True;
end;
end;
end;
If you want to keep using a keyboard hook instead, you should only hook it once, rather than once for each form, especially since you're overwriting a global variable. Try adding a HookCount global variable, and only hook/unhook if it's the only form.

The background: My form has a
TWebBrowser. I want to close the form
with ESC but the TWebBrowser eats the
keystrokes - so I decided to go with a
keyboard hook.
There might be a simpler solution. Have you tried setting the form's KeyPreview property to True?

Well, both forms are signed up to receive the keyboard notice, so they both close.
You need to put code in there to decide "is this ESC for me?". Maybe by determining if you're the window with focus or not. If it's not your ESCape, then don't close.
But, this all seems rather drastic. There must be a simpler, non-obtrusive way to detect the ESC within THIS APP, without having to monitor the keyboard for the whole system.

Related

How to get text from found component?

I have a problem with Text inside of a found TEdit.
This is my code:
function TfrmGenerateExam.zlicz_liczby(Component: TControl): integer;
var
i, j: integer;
begin
Result := 0;
for i := 0 to Component.ComponentCount - 1 do
begin
for j := 0 to Panel.ComponentCount - 1 do
begin
if Components[j] is TEdit then
begin
Result := Result + ???;
end;
end;
end;
end;
In a nutshell:
I create dynamic panels with ComboBoxes, Edits, Buttons etc.
When I have some panels, I want to count the edits which are in panels, which are in ScrollBox:
What do I need to put here?
if Components[j] is TEdit then
begin
Result := Result + ???;
end;
The code provided does not match the screenshot shown. What is being passed as the Component parameter to zlicz_liczby()? Is it the Form itself? The ScrollBox? A specified Panel?
Let's just iterate the Panels in the ScrollBox directly. Try something more like this:
function TfrmGenerateExam.zlicz_liczby: Integer;
var
i, j: integer;
Panel: TPanel;
begin
Result := 0;
for i := 0 to ScrollBox1.ControlCount - 1 do
begin
Panel := ScrollBox1.ControlCount[i] as TPanel;
for j := 0 to Panel.ControlCount - 1 do
begin
if Panel.Controls[j] is TEdit then
Result := Result + StrToIntDef(TEdit(Panel.Controls[j]).Text, 0);
end;
end;
end;
That being said, as #AndreasRejbrand stated in comments, you should use an array instead. When you create a new TPanel with a TEdit on it, put its TEdit into a TList<TEdit>, for instance. If you destroy the TPanel, remove its TEdit from the list. And then you can simply loop through that list whenever needed, without having to hunt for the TEdit controls at all. For example:
private
Edits: TList<TEdit>;
procedure TfrmGenerateExam.FormCreate(Sender: TObject);
begin
Edits := TList<TEdit>.Create;
end;
procedure TfrmGenerateExam.FormDestroy(Sender: TObject);
begin
Edits.Free;
end;
function TfrmGenerateExam.FillScrollBox;
var
Panel: TPanel;
Edit: TEdit;
begin
...
Panel := TPanel.Create(Self);
Panel.Parent := ScrollBox1;
...
Edit := TEdit.Create(Panel);
Edit.Parent := Panel;
...
Edits.Add(Edit);
...
end;
function TfrmGenerateExam.zlicz_liczby: Integer;
var
i: integer;
begin
Result := 0;
for i := 0 to Edits.Count - 1 do
Result := Result + StrToInt(Edits[i].Text);
end;

MDI Application, check if a child form with the same caption is open

I have a Delphi MDI application that has a customer search child form which can only be opened once (checking isAssigned), however the view / edit form can be opened multiple times so that the end user can open multiple customers at once (Tabbed), what I'd like to do is be able to stop them from opening the same customer record more than once, on the open of the customer form I set the caption to the customers account reference and if that form exists I would like to .BringToFront, if not I'll create it.
What would be the best way to achieve this please, as I'm scratching my head!
Thanks in advance.
procedure TfrmCustomerSearch.ViewCustomerExecute(Sender: TObject);
begin
screen.cursor := crappstart;
if not IsMDIChildOpen(frmMainMenu, 'frmCustomerView', pfrmCaption) then
frmCustomerView := TfrmCustomerView.createform(nil,dmCustomerSearchfrm.FDQCustSearchreference.Value,cxGrid1DBTableView1.DataController.FocusedRecordIndex)
else
frmCustomerView.BringToFront;
screen.cursor := crdefault;
end;
function TfrmCustomerSearch.IsMDIChildOpen(const AFormName: TForm; const AMDIChildName, AMDICaption : string): Boolean;
var
i: Integer;
begin
Result := False;
for i := Pred(AFormName.MDIChildCount) DownTo 0 do
if (AFormName.MDIChildren[i].name = AMDIChildName) then
begin
if (AFormName.MDIChildren[i].caption = AMDICaption) then
begin
Result := True;
Break;
end
end;
end;
Try something more like this instead:
procedure TfrmCustomerSearch.ViewCustomerExecute(Sender: TObject);
begin
Screen.Cursor := crAppStart;
try
frmCustomerView := TfrmCustomerView(FindMDIChildOpen(frmMainMenu, TfrmCustomerView, pfrmCaption));
if frmCustomerView = nil then
frmCustomerView := TfrmCustomerView.CreateForm(nil, dmCustomerSearchfrm.FDQCustSearchreference.Value, cxGrid1DBTableView1.DataController.FocusedRecordIndex);
frmCustomerView.BringToFront;
finally
Screen.Cursor := crDefault;
end;
end;
function TfrmCustomerSearch.FindMDIChildOpen(const AParentForm: TForm; const AMDIChildClass: TFormClass; const AMDICaption : string): TForm;
var
i: Integer;
Child: TForm;
begin
Result := nil;
for i := Pred(AParentForm.MDIChildCount) DownTo 0 do
begin
Child := AParentForm.MDIChildren[i];
if Child.InheritsFrom(AMDIChildClass) and
(Child.Caption = AMDICaption) then
begin
Result := Child;
Exit;
end;
end;
end;

How to make a screen shot of my actual window

I defined a Tactionlist which contains all actions to show/hide my forms. This could be modal (showmodal) or non modal (visible:=true). I found some code to catch the screen shots by this:
procedure GetScreenShot(shotType: TScreenShotType; var img: TJpegImage);
var
w,h: integer;
DC: HDC;
hWin: Cardinal;
r: TRect;
tmpBmp: TBitmap;
begin
hWin := 0;
case shotType of
sstActiveWindow:
begin //This is what I use
//only the active window
hWin := GetForegroundWindow;
dc := GetWindowDC(hWin);
GetWindowRect(hWin,r);
w := r.Right - r.Left;
h := r.Bottom - r.Top;
end; //sstActiveWindow
sstActiveClientArea:
begin
end; //sstActiveClientArea
sstPrimaryMonitor:
begin
end; //sstPrimaryMonitor
sstDesktop:
begin
end; //sstDesktop
else begin
Exit;
end; //case else
end; //case
//convert to jpg
tmpBmp := TBitmap.Create;
try
tmpBmp.Width := w;
tmpBmp.Height := h;
BitBlt(tmpBmp.Canvas.Handle,0,0,tmpBmp.Width,
tmpBmp.Height,DC,0,0,SRCCOPY);
img.Assign(tmpBmp);
finally
ReleaseDC(hWin,DC);
FreeAndNil(tmpBmp);
end; //try-finally
end;
My "scan" routine is as follows:
for ACnt := 0 to GenActions.ActionCount - 1 do
begin
try
LogBook.ML(Format('%d. Aktion %s gestartet',[ACnt,quotedstr(GenActions.Actions[ACnt].Name)]));
if GenActions.Actions[ACnt].Tag > 0 then
begin // Action is ready for test
TAction(GenActions.Actions[ACnt]).checked:=true;
if GenActions.Actions[ACnt].Execute then
begin
LogBook.ML(Format('%d. Aktion %s erfolgreich ausgeführt',[ACnt,quotedstr(GenActions.Actions[ACnt].Name)]));
if SaveScreens then // var boolean
begin
img:=TJPEGImage.Create;
try
GetScreenShot(sstActiveWindow,img);
img.SaveToFile(IncludeTrailingBackslash(Optionen.PictPfad.Text)+inttostr(ACnt)+'.jpg');
finally
img.Free;
end;
end;
repeat
sleep(100);
Application.ProcessMessages;
until not DM_Gen.TestTimer.Enabled ; //for modal windows a timer sends modalresult:=mrcancel
end;
end
else
begin
LogBook.ML(Format('%d Aktion %s nicht getestet',[ACnt,quotedstr(GenActions.Actions[ACnt].Name)]));
end;
except
on E: Exception do
LogBook.ML(Format('%d. Aktion hat Fehler %s gemeldet',[ACnt,E.Message]));
end;
end;
finally
LogBook.ML('Testlauf beendet');
end;
When I run this code I get for about the first 150 actions the mainform, then some other forms like the logbook or the browser or ... Nearly never the form I want.
I found some posts which recommended the use of "findwindow". Here is my problem that I don't know the exact caption of the window, because in all windows the caption is modified in the onshow event in order to show actual information.
Any ideas how can catch my actual opened window?
So a problem is to understand how my actions work. Here two typical examples:
procedure TDM_Gen.VALstVisActExecute(Sender: TObject);
begin
if Sender is TAction then
begin // set some properties
end;
ListeVeranst_2.Visible:=VALstVisAct.Checked;
end;
procedure TDM_Gen.NewVAActExecute(Sender: TObject);
var
NewVA : TNewVeranstaltung;
begin
if Sender <> nil then
begin
if Sender is TButton then
begin //do something depending on who fired
end;
end;
try
NewVA:=TNewVeranstaltung.Create(nil);
case NewVA.ShowModal of
mrOk:
begin // e.g. refresh some lists
end;
mrCancel:
begin // clean up
end;
end;
finally
NewVA.Free;
end;
end;
The caption of the window is set during the onshow event by:
caption:=Format('This is window %s %s',[Param1, Param2]);
Problem you are facing is due to ShowModal method that is blocking call. That means that all subsequent code after that call will start executing after the form is closed.
Code flow in following simplified example:
MyAction.Execute;
CaptureScreen;
procedure TSomeForm.MyActionExecute(Sender: TObject);
var frm: TForm;
begin
frm := TForm.Create(nil);
try
frm.ShowModal; // this call blocks execution of subsequent code in this method until form is closed
finally
frm.Free;
end;
end;
will be MyAction.Execute -> frm.ShowModal -> frm.Close -> frm.Free -> CaptureScreen
You will have to initiate screen capturing from within your modal form in order to capture its screen.

Understanding how to use Windows Hooks

Im trying to use SetWindowsHookEx to Hook Mouse in some process. Im using Delphi 7.
Code (DLL):
function MouseProc(code: integer; wParam: WPARAM; lParam: LPARAM)
: LongInt; stdcall;
var
AppWnd: HWND;
begin
Result := 0;
if (code < 0) then
Result := CallNextHookEx(HookHandle, code, wParam, lParam)
else begin
AppWnd := FindWindowW('ichookapplication', nil);
SendMessage(AppWnd, MW_MOUSEHOOKED, wParam, GetCurrentProcessId);
Result := CallNextHookEx(HookHandle, code, wParam, lParam);
end;
end;
procedure HookThreadId(theadId: Cardinal) export; stdcall;
var
e: DWORD;
begin
HookHandle := SetWindowsHookEx(WH_MOUSE, #MouseProc, 0, theadId);
if (HookHandle = 0) then
begin
e := GetLastError;
MessageBox(0, 'error', PAnsiChar(IntToStr(e)), MB_OK);
end;
end;
MW_MOUSEHOOKED is WM_USER + 101;
application:
//loading code
if (dll = 0) then
begin
dll := LoadLibrary('mhook.dll');
#Hook := nil;
#SetThreadHook := nil;
end;
if (dll > HINSTANCE_ERROR) then
begin
pH := GetProcAddress(dll, 'Hook');
#Hook := pH;
pSth := GetProcAddress(dll, 'HookThreadId');
#SetThreadHook := pSth;
end;
// attach code
h := FindWindow(nil, 'Form1');
terminalProc := GetWindowThreadProcessId(h, nil);
if (terminalProc = 0) then
begin
ShowMessage(IntToStr(GetLastError));
Exit;
end;
SetThreadHook(terminalProc);
So. SetWindowsHookEx returns 1428 error: Cannot set nonlocal hook without a module handle.
But as i know if im using dll hmodule is not needed...
How i whant it will work:
Every mouse event will passing to my app (window class is 'ichookapplication') using WM_DATA (wParam is event data, lParam is ProcessId)
Thanks!
WH_MOUSE is a global hook. The DLL will be injected into hooked processes. You do need to supply a module handle. The name associated with error code 1428 is pretty clear, ERROR_HOOK_NEEDS_HMOD. It's not as though it's difficult to provide a module handle. Pass HInstance.
If you don't want to inject, then you'll need to use WH_MOUSE_LL instead of WH_MOUSE.

How to display hint for a disabled control?

I have a check box which will be enabled/disabled at run time. I just want to show different tool tips if it is enabled/disabled. I was thinking about overriding OnMouseEnter event and handle it there but OnMouseEnter will be called only if the control is enabled. How can i possible achieve that behavior? Any help would be appreciated.
I tried to handle OnMouseMove of the form and do something like this
procedure Tdlg.pnlTopMouseMove(Sender: TObject;Shift: TShiftState; X, Y: Integer);
var
point: TPoint;
checkBoxCursorPos: TPoint;
begin
inherited;
point.X := X;
point.Y := Y;
checkBoxCursorPos := chkBx.ScreenToClient(point);
if (PtInRect(chkBx.ClientRect, checkBoxCursorPos)) then
begin
if(chkBx.Enabled) then
chkBx.Hint := 'Enabled'
else
chkBx.Hint := 'Disabled' ;
Application.ShowHint := True;
end;
end;
but the condition PtinRect is not satisfied. What i am doing wrong?
There is a simple solution: place an empty TLabel over the checkbox and set its Hint to the value for the disabled checkbox state. The label has to be AutoSize off and you can enforce position and size by its BoundsRect property set to that of the CheckBox.
When the CheckBox is enabled the Hint of the Checkbox is used, while the Hint of the Label is used when the CheckBox is disabled.
Update: just saw that Bummi mentions a similar idea in his comment.
The official answer: you can’t.
The workaround: you could try using the form's MouseMove-event (assuming that won’t be disabled, of course), and if the mouse cursor is over the relevant control, display the appropriate hint.
Here is a unit that can show hints for disabled controls.
I used it like this:
TATHintControl.Create(self).HintStyleController := GlobalHintStyleController;
GlobalHintStyleController is a DevExpress stylecontroller.
Then the unit
unit ATHintControl;
{
The purpose of this component is to show hints for disabled controls (VCL doesn't)
It uses timestamp comparison instead of Timers to save resources
}
interface
uses
// VCL
Classes,
Controls,
Forms,
AppEvnts,
Messages,
Windows,
// DevEx
cxHint;
type
TGetHintForControlEvent = function(AControl: TControl): string of object;
THandleControlEvent = function(AControl: TControl): boolean of object;
TATHintControl = class(TComponent)
private
fHintTimeStamp: TDateTime;
fHintHideTimeStamp: TDateTime;
fHintControl: TControl;
fHintVisible: boolean;
FHintStyleController: TcxHintStyleController;
FHintShowDelay: Integer;
FHintHideDelay: Integer;
fGetHintForControlEvent: TGetHintForControlEvent;
fHandleControlEvent: THandleControlEvent;
fApplicationEvents: TApplicationEvents;
procedure IdleHandler(Sender: TObject; var Done: Boolean);
procedure ShortcutHandler(var Msg: TWMKey; var Handled: Boolean);
procedure SetHintStyleController(const Value: TcxHintStyleController);
procedure HideHint;
function GetCursorPos(out APoint: TPoint): Boolean;
function HandleHint: boolean;
protected
function GetHintForControl(AControl: TControl): string; virtual;
function HandleControl(AControl: TControl): boolean; virtual;
public
procedure AfterConstruction; override;
published
property HintStyleController: TcxHintStyleController read FHintStyleController write SetHintStyleController;
property OnGetHintForControl: TGetHintForControlEvent read fGetHintForControlEvent write fGetHintForControlEvent;
property OnHandleControl: THandleControlEvent read fHandleControlEvent write fHandleControlEvent;
end;
implementation
uses
Types,
SysUtils,
DateUtils;
const
cHintShowDelay: Integer = 500; // msec
cHintHideDelay: Integer = 3 * 1000; // 3 sec
{ TATHintControl }
procedure TATHintControl.AfterConstruction;
begin
inherited;
fApplicationEvents := TApplicationEvents.Create(self);
fApplicationEvents.OnIdle := IdleHandler;
fApplicationEvents.OnShortCut := ShortcutHandler;
fHintShowDelay := cHintShowDelay;
fHintHideDelay := cHintHideDelay;
end;
function TATHintControl.GetCursorPos(out APoint: TPoint): Boolean;
begin
{$WARN SYMBOL_PLATFORM OFF}
result := Windows.GetCursorPos(APoint);
{$WARN SYMBOL_PLATFORM ON}
end;
function TATHintControl.GetHintForControl(AControl: TControl): string;
begin
if Assigned(OnGetHintForControl) then
result := OnGetHintForControl(AControl)
else
result := AControl.Hint;
end;
procedure TATHintControl.HideHint;
begin
HintStyleController.HideHint;
fHintTimeStamp := 0;
fHintVisible := false;
fHintHideTimeStamp := 0;
end;
procedure TATHintControl.IdleHandler(Sender: TObject; var Done: Boolean);
begin
if Assigned(HintStyleController) then
Done := HandleHint;
end;
procedure TATHintControl.SetHintStyleController(
const Value: TcxHintStyleController);
begin
FHintStyleController := Value;
end;
procedure TATHintControl.ShortcutHandler(var Msg: TWMKey; var Handled: Boolean);
begin
fHintControl := nil; // clear the HintControl so that keypress causes it to be shown again w/o having to move the mouse
end;
function TATHintControl.HandleControl(AControl: TControl): boolean;
begin
if Assigned(OnHandleControl) then
result := OnHandleControl(AControl)
else
result := not AControl.Enabled;
end;
function TATHintControl.HandleHint: boolean;
var
vNow: TDateTime;
vScreenPos: TPoint;
vClientPos: TPoint;
vControl: TControl;
vHintString: string;
vForm: TForm;
vWinControl: TWinControl;
begin
result := (fHintTimeStamp = 0);
vForm := Screen.ActiveForm;
if not Assigned(vForm) then
exit;
if not boolean(GetCursorPos(vScreenPos)) then
exit;
vNow := Now;
vControl := nil;
vWinControl := vForm as TWinControl;
while Assigned(vWinControl) do
try
vClientPos := vWinControl.ScreenToClient(vScreenPos);
vControl := vWinControl.ControlAtPos(vClientPos, true, true, true);
if not Assigned(vControl) then
begin
vControl := vWinControl;
break;
end
else
if vControl is TWinControl then
vWinControl := vControl as TWinControl
else
vWinControl := nil;
except
exit; // in some cases ControlAtPos can fail with EOleError: Could not obtain OLE control window handle.
end;
if (fHintControl <> vControl) then
begin
if fHintVisible then
HideHint;
if Assigned(vControl) and HandleControl(vControl) then
begin
fHintControl := vControl;
fHintTimeStamp := vNow; // starts timer for hint to show
end
else
begin
fHintTimeStamp := 0;
fHintControl := nil;
end;
end
else
begin
if fHintVisible and (vNow > fHintHideTimeStamp) then
begin
HideHint;
end
else // we check HandleControl again here to make sure we still want to show the hint
if not fHintVisible and Assigned(vControl) and HandleControl(vControl) and (fHintTimeStamp > 0) and (vNow > IncMillisecond(fHintTimeStamp, fHintShowDelay)) then
begin
vHintString := GetHintForControl(vControl);
if vHintString = '' then
exit;
HintStyleController.ShowHint(vScreenPos.X + 0, vScreenPos.Y + 18, '', vHintString);
fHintTimeStamp := vNow;
fHintControl := vControl;
fHintVisible := true;
// base hide delay + dynamic part based on length of the hint string, 500 msec per 30 characters
fHintHideTimeStamp := vNow + IncMillisecond(0, fHintHideDelay) + ((Length(vHintString) div 20) * EncodeTime(0,0,0,500));
end
end;
result := (fHintTimeStamp = 0);
end;
end.

Resources