[aford]

Всем привет!

Прошу помощи в такой проблеме. В DBGridEh скроллинг мышкой по умолчанию работает и это замечательно!
Но, когда увожу курсор с таблицы - он все равно работает на этой же таблице до тех пор, пока у нее не отпадет фокус. Функционал программы не страдает, но неудобства все же есть. Хотелось бы, чтобы при наведении на таблицу скроллинг работал, а если курсор не над таблицей - соответственно отключался.

[dr. F.I.N.]

Код:

type
  TForm1 = class(TForm)
    DBGridEh1: TDBGridEh;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    OldWindowProc: TWndMethod;
    procedure NewWindowProc(var Msg: TMessage);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.NewWindowProc(var Msg: TMessage);
var
  p: TPoint;
begin
  if Msg.Msg = WM_MOUSEWHEEL then
  begin
    p := Point(TWMMouseWheel(Msg).XPos, TWMMouseWheel(Msg).YPos);
    if ControlAtPos(ScreenToClient(p), False, True) = DBGridEh1 then
      OldWindowProc(Msg)
    else
      Msg.Result := 0;
  end
  else
    OldWindowProc(Msg);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OldWindowProc := DBGridEh1.WindowProc;
  DBGridEh1.WindowProc := NewWindowProc;
end;

[aford]

К сожалению, код выше полностью отключает скроллинг мышью
А как быть, если таблиц 2 и более?

[Alegun]

А вот отключалка по имени класса получилась и на простой DBGrid работает

Код:

uses Messages;
...

type
  TfrmMain = class(TForm)
  DBGrid1: TDBGrid;
 procedure FormCreate(Sender: TObject);
  procedure DbGridWindowProc(var Msg: TMessage);
...
private
   FGridWndProc: TWndMethod;
    { Private declarations }
...
procedure TfrmMain.FormCreate(Sender: TObject);
begin
 FGridWndProc := DBGrid1.WindowProc;
 DBGrid1.WindowProc := DbGridWindowProc;
end;
procedure TfrmMain.DbGridWindowProc(var Msg: TMessage);
var
 hWnd: THandle;
 rPos: TPoint;
 aName: array [0..255] of Char;
 begin
 case Msg.Msg of
      WM_MOUSEWHEEL:
       if Boolean(GetCursorPos(rPos)) then
       begin
        hWnd:= WindowFromPoint(rPos);
        GetClassName(hWnd, aName, 256);
        if string(aName) <> 'TDBGrid' then exit;
       end;
   end;
   if Assigned(FGridWndProc) then  FGridWndProc(Msg);
end;

только имя поменять

[dr. F.I.N.]

Сообщение от aford

К сожалению, код выше полностью отключает скроллинг мышью
А как быть, если таблиц 2 и более?

Вероятно Вы что-то сделали не так. У меня работает приведенный пример так как Вам требовалось. NewWindowProc устанавливается для конкретного контрола не влияя на другие. Собственно, поэтому бессмысленно усложнение кода предложенное Alegun, только на случай установки данной процедуры нескольким контролам.

[Alegun]

Оффтоп:

Сообщение от dr. F.I.N.

Вероятно Вы что-то сделали не так. У меня работает приведенный пример так как Вам требовалось...

Подтверждаю, решение приведённое коллегой работает как должно, тщательнее надо в примеры вникать, прежде чем делать огульные выводы

[aford]

Все работает как надо, разобрался, спасибо!