Tab and Esc keys sometimes don't work

[MarcinW]

Steps to reproduce (tested with beta 25):
1) compare any two different files (Files -> Compare By Content) - "Compare contents" window will be shown
2) modify one of the files and save it (using any method: TCMD, notepad, etc.)
3) switch to "Compare contents" window - message box will appear: "File(s) modified, recompare?"
4) don't close this message box, but switch to the main TCMD window
5) "Tab" key doesn't work, we can't change active panel (until we go back and close message box)
6) open any file with F3 (Lister)
7) "Esc" key doesn't work, we can't close Lister (until we go back and close message box)

Regards!

[umbra]

Confirmed also in 7.57a.

[Hacker]

Well, there are about a gazillion threads about this on the forum, the result of all is that this is not avoidable.

Roman

[umbra]

Hi, Hacker. I could not find those "gazillion threads", only one and it's from 2003. So it's not surprising that someone asked about it again. And who knows, maybe there is a solution for it now.

[Hacker]

Hello umbra,
For instance these:
Some keys disabled after Compare By Content
[bug] messagebox copying interference...
[REQ] Replace MessageBox'es with usual dialogs
Find files dlg: unable to close

Roman

[ghisler(Author)]

The only way to avoid it would be to use compare as a standalone tool. To do this, add the following to your wincmd.ini:

CompareTool="%commander_path%\totalcmd.exe" /S=C

[MaxX]

Having "onlyonce=1" enabled, I've just added this as you said:

CompareTool="%commander_path%\totalcmd.exe" /S=C

And that became a great mistake! (my or TC's?)
Command "cm_CompareFilesByContent" have frozen my PC with high-frequently cycle "appearing TC process -> then self-killong -> then again appearing another TC process with another PID...", so I could not kill it (I can't click so fast). The only solution could be - reboot.
But, I did not want to lose my another working processes and un-resumeable uploads. Ignoring 100% CPU load, I manually commented this new string with ";". And... Surprise! Bug-cycling finally stopped, finaly showing my desired compare-window! That was strange, because commenting "onlyonce=1" or setting it to "0" did NOT help.
Even more, each new process had to reread wincmd.ini every time, so my changes of "onlyonce=1" had to have effect, but only disabling of your new string helped.
--------------------
[TC 8.0 b25 x32] @ Win7 SP1 x64, 12GB RAM (>80% free).

[MarcinW]

I've found a global solution to this problem.

The cause of this problem is inner message loop inside message boxes. Message boxes (and Win32 dialogs) handle messages internally, so Delphi application doesn't get any messages in its own message queue. Since Delphi executes some preprocessing code before dispatching messages to the destination windows, it's a problem. Let's see:

Code: Select all

function TApplication.ProcessMessage(var Msg: TMsg): Boolean;

...

  Result := True;
  if Msg.Message <> WM_QUIT then
  begin
    Handled := False;

    if Assigned(FOnMessage) then
      FOnMessage(Msg, Handled);

    if not IsPreProcessMessage(Msg) and not IsHintMsg(Msg) and
      not Handled and not IsMDIMsg(Msg) and
      not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then
    begin
      TranslateMessage(Msg);
      if Unicode then
        DispatchMessageW(Msg)
      else
        DispatchMessageA(Msg);
    end;
  end
  else
    FTerminate := True;

...

As we can see, before calling DispatchMessage, the message can be handled by:
- FOnMessage
- IsPreProcessMessage
- IsHintMsg
- IsMDIMsg
- IsKeyMsg
- IsDlgMsg
(more info: http://edn.embarcadero.com/article/38447)


Not calling IsKeyMsg (by the inner message loop of the message box) is a cause of the problem. So what is a solution? We have to force message boxes to call the functions listed above. How? By using WH_GETMESSAGE message hook.


@ghisler(Author):
Below is the source code of my solution to this problem. Simply attach this unit to your project - that's all. If you find it useful, feel free to attach this unit to the next beta.

Code: Select all

unit DialogsMessageHandler;

{Tested with Delphi 2, Delphi 5 and Delphi 2006}
{Lazarus doesn't need this unit}

interface

implementation

{$IFDEF VER90} {Delphi 2}
  {$DEFINE DEFINE_HINTMSG_FUNCTION}
{$ENDIF}
{$IFDEF VER100} {Delphi 3}
  {$DEFINE DEFINE_HINTMSG_FUNCTION}
{$ENDIF}
{$IFDEF VER120} {Delphi 4}
  {$DEFINE DEFINE_HINTMSG_FUNCTION}
{$ENDIF}
{$IFDEF VER130} {Delphi 5}
  {$DEFINE DEFINE_HINTMSG_FUNCTION}
{$ENDIF}

{$IFDEF VER90} {Delphi 2}
  {$DEFINE DEFINE_MSG_FUNCTIONS}
{$ENDIF}
{$IFDEF VER100} {Delphi 3}
  {$DEFINE DEFINE_MSG_FUNCTIONS}
{$ENDIF}
{$IFDEF VER120} {Delphi 4}
  {$DEFINE DEFINE_MSG_FUNCTIONS}
{$ENDIF}
{$IFDEF VER130} {Delphi 5}
  {$DEFINE DEFINE_MSG_FUNCTIONS}
{$ENDIF}
{$IFDEF VER140} {Delphi 6}
  {$DEFINE DEFINE_MSG_FUNCTIONS} {Not necessary, but adds partial Unicode support}
{$ENDIF}
{$IFDEF VER150} {Delphi 7}
  {$DEFINE DEFINE_MSG_FUNCTIONS} {Not necessary, but adds partial Unicode support}
{$ENDIF}
{$IFDEF VER160} {Delphi 8}
  {$DEFINE DEFINE_MSG_FUNCTIONS} {Not necessary, but adds partial Unicode support}
{$ENDIF}
{$IFDEF VER170} {Delphi 2005}
  {$DEFINE DEFINE_MSG_FUNCTIONS} {Not necessary, but adds partial Unicode support}
{$ENDIF}

uses
  Windows, Messages, {$IFDEF DEFINE_MSG_FUNCTIONS}Controls,{$ENDIF} Forms;

var
  GetMsgProcHookHandle : HHOOK;

{$IFDEF DEFINE_HINTMSG_FUNCTION}
{Copied from TApplication.IsHintMsg and THintWindow.IsHintMsg}
function IsHintMsg(var Msg : TMsg) : Boolean;
begin
  Result:=False;
  with Msg do
  if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) or
     ((Message = CM_ACTIVATE) or (Message = CM_DEACTIVATE)) or
      (Message = CM_APPKEYDOWN) or (Message = CM_APPSYSCOMMAND) or
      (Message = WM_COMMAND) or ((Message > WM_MOUSEMOVE) and
      (Message <= WM_MOUSELAST)) or (Message = WM_NCMOUSEMOVE) then
    Application.CancelHint;
end;
{$ENDIF}

{$IFDEF DEFINE_MSG_FUNCTIONS}
{Copied from TApplication.IsMDIMsg}
function IsMDIMsg(var Msg : TMsg) : Boolean;
begin
  Result:=False;
  with Application do
  if (MainForm <> nil) and (MainForm.FormStyle = fsMDIForm) and
     (Screen.ActiveForm <> nil) and (Screen.ActiveForm.FormStyle = fsMDIChild) then
    Result:=TranslateMDISysAccel(MainForm.ClientHandle,Msg);
end;

{Copied from TApplication.IsKeyMsg (with fixes from Delphi 2010)}
function IsKeyMsg(var Msg : TMsg) : Boolean;
var
  Wnd : HWND;
  WndPID : Cardinal;
begin
  Result:=False;
  with Application do
  with Msg do
  if (Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST) then
  begin
    Wnd:=GetCapture;
    if Wnd = 0 then
    begin
      Wnd:=HWnd;
      if (MainForm <> nil) and (Wnd = MainForm.ClientHandle) then
        Wnd:=MainForm.Handle
      else
      begin
        // Find the nearest VCL component. Non-VCL windows won't know what
        // to do with CN_BASE offset messages anyway.
        // TOleControl.WndProc needs this for TranslateAccelerator
        while (FindControl(Wnd) = nil) and (Wnd <> 0) do
          Wnd:=GetParent(Wnd);
        if Wnd = 0 then
          Wnd:=HWnd;
      end;
      if IsWindowUnicode(Wnd) then
      begin
        if SendMessageW(Wnd,CN_BASE + Message,wParam,lParam) <> 0 then
          Result:=True;
      end else
      begin
        if SendMessageA(Wnd,CN_BASE + Message,wParam,lParam) <> 0 then
          Result:=True;
      end;
    end else
    begin
      WndPID:=0;
      GetWindowThreadProcessId(Wnd,@WndPID);
      if WndPID = GetCurrentProcessId then
      if IsWindowUnicode(Wnd) then
      begin
        if SendMessageW(Wnd,CN_BASE + Message,wParam,lParam) <> 0 then
          Result:=True;
      end else
      begin
        if SendMessageA(Wnd,CN_BASE + Message,wParam,lParam) <> 0 then
          Result:=True;
      end;
    end;
  end;
end;

{Copied from TApplication.IsDlgMsg (with fixes from Delphi 2010)}
function IsDlgMsg(var Msg : TMsg) : Boolean;
begin
  Result:=False;
  with Application do
  if DialogHandle <> 0 then
  if IsWindowUnicode(Msg.hwnd) then
    Result:=IsDialogMessageW(DialogHandle,Msg)
  else
    Result:=IsDialogMessageA(DialogHandle,Msg);
end;
{$ENDIF}

type
  THookApplication = class(TApplication)
  end;

function GetMsgProcHook(Code : Integer; wParam : WPARAM; lParam : PMsg) : LRESULT; stdcall;
var
  Handled : Boolean;
begin
  Result:=CallNextHookEx(GetMsgProcHookHandle,Code,wParam,Windows.LPARAM(lParam));
  if Code = HC_ACTION then
  if wParam = PM_REMOVE then
  if Application <> nil then
  {Partial implementation of TApplication.ProcessMessage(var Msg: TMsg)}
  if lParam^.message <> WM_QUIT then
  begin
    Handled:=False;

    with Application do
    if Assigned(OnMessage) then
      OnMessage(lParam^,Handled);

    if
{$IFNDEF VER90} {Delphi 2}
{$IFNDEF VER100} {Delphi 3}
{$IFNDEF VER120} {Delphi 4}
{$IFNDEF VER130} {Delphi 5}
{$IFNDEF VER140} {Delphi 6}
{$IFNDEF VER150} {Delphi 7}
       not THookApplication(Application).IsPreProcessMessage(lParam^) and
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
       not {$IFNDEF DEFINE_HINTMSG_FUNCTION}THookApplication(Application).{$ENDIF}IsHintMsg(lParam^) and
       not Handled and
       not {$IFNDEF DEFINE_MSG_FUNCTIONS}THookApplication(Application).{$ENDIF}IsMDIMsg(lParam^) and
       not {$IFNDEF DEFINE_MSG_FUNCTIONS}THookApplication(Application).{$ENDIF}IsKeyMsg(lParam^) and
       not {$IFNDEF DEFINE_MSG_FUNCTIONS}THookApplication(Application).{$ENDIF}IsDlgMsg(lParam^) then
    begin
      {All functions above will be called again inside TApplication.ProcessMessage
       function; this is not a problem in general, however, you may want to rewiew
       it in case of using your own Application.OnMessage handler or non-empty
       PreProcessMessage methods in your custom controls}
    end else
    begin
      lParam^.message:=WM_NULL;
      Exit;
    end;
  end;
end;

initialization
  GetMsgProcHookHandle:=SetWindowsHookEx(WH_GETMESSAGE,@GetMsgProcHook,0,GetCurrentThreadId);
finalization
  UnHookWindowsHookEx(GetMsgProcHookHandle);
end.

Update: Now compatible with Delphi 2.

[ghisler(Author)]

Unfortunately some firewalls and virus scanners freak out when a program uses hooks, so I prefer not to use them for such a small problem...

[MarcinW]

Yes, firewalls and virus scanners don't like hooks - but only global hooks, installed for all proceses in the system. Such hooks must exist in an external DLL. This DLL is being injected to all processes after calling SetWindowsHookEx. Local hooks are safe.

Moreover, local hooks are used (without programmer's knowledge) in almost every Delphi application. For example:
- hints use hooks (Forms.pas -> TApplication.ActivateHint -> HookHintHooks)
- common controls use hooks (ComCtrls.pas -> TToolBar.CheckMenuDropdown -> InitToolMenuHooks; ComCtrls.pas -> TToolBar.InitMenu -> InitToolMenuKeyHooks)

If the last parameter of the SetWindowsHookEx is GetCurrentThreadId (or any ThreadId belonging to the current process), we are on the safe side.

More info: http://www.symantec.com/connect/articles/introduction-spyware-keyloggers

Regards!

[MarcinW]

Fixed in rc1.

[Flint]

Confirm fixed too.

MarcinW, my dearest thanks to you for helping to finally fix this annoying problem!

[ghisler(Author)]

Actually I didn't use MarcinW's code: I just added code to TC and to Lister which reacts just to the TAB key and to the ESC key, respectively. These are only called when Delphi isn't handling these key by itself, which is in the above cases.

[Flint]

ghisler(Author)
OK, then thanks to MarcinW for giving you inspiration to solve this problem.

[MarcinW]

@ghisler(Author)

Thanks for the fix :) Please add also handling for that edit control, being shown after pressing Shift+F6. Arrows work without any problems, but (when message box is on) Tab, Esc and Enter don't work.

Regards!