[aford]

Всем привет!

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

[dr. F.I.N.]

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41

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 работает

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35

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]

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