MessageBox steals mouse wheel messages

[MarcinW]

The cause of this problem is exactly the same as in this topic: Tab and Esc keys sometimes don't work.


Steps to reproduce:
1) open any two files with Lister,
2) in the first Lister search for any string until "not found" message box appears,
3) now in the second Lister scrolling with mouse wheel is not working.

The same problem is with Compare By Content window and with some other windows.


In the main application message loop (TApplication.ProcessMessage), there is a piece of code called between PeekMessageA/W and TranslateMessage - probably your Application.OnMessage handler. There is a piece of code there, which compares the window class name with "tlister", "townlistbox" and "tscrollbox", then calls GetKeyState(VK_SHIFT), then calls GetScrollRange and then sends WM_HSCROLL or WM_VSCROLL messages. It isn't being called when we are inside the inner message loop of the MessageBox function.



P.S. I haven't looked at this code carefully, but maybe - instead of checking for particular, hardcoded class names before sending the WM_VSCROLL/WM_HSCROLL messages - it would be more universal to check:

if GetWindowLong(Control.Handle,GWL_STYLE) and WS_VSCROLL <> 0 then ...
if GetWindowLong(Control.Handle,GWL_STYLE) and WS_HSCROLL <> 0 then ...

Regards

[ghisler(Author)]

Sorry, can't do anything about it. Just use a standalone Lister and compare tool if this bothers you.

[MarcinW]

It's not a big problem, at least for me.

However, it's easy to move mouse wheel handling from global Application.OnMessage handler to classes like TScrollBox, TForm etc. I created a small example for TForm and TScrollBox classes, for Delphi 2 (newer Delphi versions have built-in mouse wheel handling, so the code would be a bit modified):

Code: Select all

unit UnitMouseWheel;

interface

uses
  Windows, Messages, Forms, Controls;

{$IFDEF VER90} {Delphi 2}
const
  WHEEL_DELTA = 120;

const
  WM_MOUSEWHEEL = $20A;
  CM_MOUSEWHEEL = WM_MOUSEWHEEL;

type
  TWMMouseWheel = packed record
    Msg : Cardinal;
    Keys : SmallInt;
    WheelDelta : SmallInt;
    case Integer of
      0 : (XPos : Smallint;
           YPos : Smallint);
      1 : (Pos : TSmallPoint;
           Result : Longint);
  end;
{$ENDIF}

type
  TForm = class(Forms.TForm)
    procedure CMMouseWheel(var Message : TWMMouseWheel); message CM_MOUSEWHEEL;
  end;

type
  TScrollBox = class(Forms.TScrollBox)
    procedure CMMouseWheel(var Message : TWMMouseWheel); message CM_MOUSEWHEEL;
  end;

implementation

procedure CustomMouseWheelHandler(Control : TScrollingWinControl; const Message : TWMMouseWheel);
begin
  {Example code for vertical scrolling; place your own code here}
  with Control do
    VertScrollBar.Position:=VertScrollBar.Position - 30 * Message.WheelDelta div WHEEL_DELTA;
end;

procedure TForm.CMMouseWheel(var Message : TWMMouseWheel);
begin
  CustomMouseWheelHandler(Self,Message);
  {We shouldn't call inherited here, because we don't want to pass this message to the parent}
end;

procedure TScrollBox.CMMouseWheel(var Message : TWMMouseWheel);
begin
  CustomMouseWheelHandler(Self,Message);
  {We shouldn't call inherited here, because we don't want to pass this message to the parent}
end;

end.

Usage example:

Code: Select all

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, UnitMouseWheel;

UnitMouseWheel must be declared _after_ Forms, because it overrides classes from Forms unit.

[ghisler(Author)]

Sorry, that would be too risky now, it would make the beta test much much longer for very little gain.

[MarcinW]

Yes, of course, It may be not a good time to do such changes now.

However, this technique of replacing standard classes is quite nice. It doesn't require registering new components in Delphi. It's enough to add our unit to the "uses" clauses and we can easily override standard behavior of, for example, all comboboxes in our project. You may find this technique useful some day in the future.

Regards!

[ghisler(Author)]

I'm already using a custom form for most dialogs, but not for the main window. Your redefinition of TForm (TForm = class(Forms.TForm) ) looks strange, does that really work?

[MarcinW]

It works perfectly :) Even with old Delphi versions. I've seen this trick for the first time on the Embarcadero QualityCentral forum. They sometimes use this trick to show a workaround for bugs that they are describing. An example: http://qc.embarcadero.com/wc/qcmain.aspx?d=7144 (it's for .NET, so there is Borland.Vcl.StdCtrls.TButton instead of StdCtrls.TButton there).

The main advantage of this trick is that the class name doesn't change, so it's not necessary to register patched components in Delphi (and giving them new names). We can for example put the standard TButton on our form, and - during runtime - get patched TButton.