[nixon232]

Добрый вечер прошу помощи.
Есть статичная таблица 14х14. Пользователю запрещено по ней кликать.
Но если крутить колесико над Гридом, то через некоторое время вылазит ошибка Grid index out of range. Как это побороть? вылезает только при прокрутки.

Код:

    object SGBB: TStringGrid
      AlignWithMargins = True
      Left = 5
      Top = 64
      Width = 382
      Height = 269
      Margins.Left = 1
      Margins.Top = 1
      Margins.Right = 1
      Margins.Bottom = 1
      BiDiMode = bdRightToLeftReadingOnly
      Color = clWhite
      ColCount = 14
      DefaultColWidth = 26
      DefaultRowHeight = 18
      DrawingStyle = gdsGradient
      RowCount = 14
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clBlack
      Font.Height = -9
      Font.Name = 'Tahoma'
      Font.Style = [fsBold]
      GradientEndColor = clWhite
      Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine]
      ParentBiDiMode = False
      ParentFont = False
      TabOrder = 0
      ColWidths = (
        26
        26
        26
        27
        26
        26
        26
        26
        26
        26
        26
        26
        26
        26)
    end

Код:

 procedure TMF.OnSelectCell(Sender: TObject;ACol,ARow:Integer; var CanSelect:Boolean);
begin
CanSelect:=False;
end;

При создании убераем фокус:

Код:

//r:TGridRect;
 r.Left:=-1;
    r.Top:=-1;
    r.Bottom:=-1;
    r.Right:=-1;
    SGBB.Selection:=r;

[NumLock]

Код:

type
  TStringGrid = class(Grids.TStringGrid)
  protected
    procedure WMMOUSEWHEEL(var Msg: TMessage); message WM_MOUSEWHEEL;
  end;

procedure TStringGrid.WMMOUSEWHEEL(var Msg: TMessage);
begin
  Msg.Result:=0;
end;

[nixon232]

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

Код:

type
  TStringGrid = class(Grids.TStringGrid)
  protected
    procedure WMMOUSEWHEEL(var Msg: TMessage); message WM_MOUSEWHEEL;
  end;

procedure TStringGrid.WMMOUSEWHEEL(var Msg: TMessage);
begin
  Msg.Result:=0;
end;

Спасибо за решение, но пока сыпется код. У меня компилятор хе4, так что пришлось поправить.

Код:

TStringGrid = class(Vcl.Grids.TStringGrid)
  protected
    procedure WMMOUSEWHEEL(var Msg: TMessage); message WM_MOUSEWHEEL;
  end;

Тогда ваш кусок прошел, но не проходит кусок:

Код:

 procedure PaintHand( S:TStringGrid );

Есть 3 грида, на 3х формах и когда вызываю эту процедуру компилятор пишет, что не то передается в параметре. Ваш кусок вставил на все формы. Что не так, делаю?

[poli-smen]

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

Есть 3 грида, на 3х формах и когда вызываю эту процедуру компилятор пишет, что не то передается в параметре. Ваш кусок вставил на все формы. Что не так, делаю?

Эту "процедуру" не нужно вызывать - она сама должна вызываться при получении событий от колёсика и тем самым блокировать его работу.
Тот код который написал NumLock нужно вставить в новый модуль (unit) и потом этот модуль добавить через uses в нужные модули (только это нужно сделать после Grids).

[nixon232]

Большое спасибо за помощь, все как надо работает.

[nixon232]

Поторопился я радоваться. Выдает туже ошибку в этом обработчике

Код:

procedure TPForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const  SC_DragMove = $F012;
begin
  ReleaseCapture;
  Perform(WM_SYSCOMMAND, SC_DragMove, 0);
end;

т.е. перетягивание формы за объект. За любой другой объект нормально, а за грид не тянется. т.е тянется, но с ошибкой.

Код:

procedure TPForm.WMSysCommand(var Msg: TWMSysCommand);
begin
inherited;
 if (Msg.CmdType and $FFF0) = SC_MOVE  then
   begin
     FForm.Left:=FForm.Left+(MF.Left-mX);
     FForm.Top:=FForm.Top+(MF.Top-mY);

     PForm.Left:=PForm.Left+(MF.Left-mX);
     PForm.Top:=PForm.Top+(MF.Top-mY);
     mX:=MF.Left;
     mY:=MF.Top;
  
   end;

end;

[poli-smen]

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

т.е. перетягивание формы за объект. За любой другой объект нормально, а за грид не тянется. т.е тянется, но с ошибкой.

Я так понимаю тебе нужно чтобы StringGrid был прозрачным для мышки - тогда можешь ловить сообщение WM_NCHITTEST и возвращать в ответ, что StringGrid везде прозрачный (HTTRANSPARENT).

Т.е. тот новый модуль который ты создал расширится до примерно такого варианта:

Код:

unit HackGridsUnit;

interface

uses Windows, Messages, Grids;

type
  TStringGrid = class(Grids.TStringGrid)
  protected
    procedure WMMOUSEWHEEL(var Msg: TMessage); message WM_MOUSEWHEEL;
    procedure WMNCHITTEST(var Msg: TMessage); message WM_NCHITTEST;
  end;

implementation

procedure TStringGrid.WMMOUSEWHEEL(var Msg: TMessage);
begin
  Msg.Result := 0;
end;

procedure TStringGrid.WMNCHITTEST(var Msg: TMessage);
begin
  Msg.Result := HTTRANSPARENT;
end;

end.

[nixon232]

То, что и нужно, но работает на 2х из 3х гридах, хотя в тоже время колесико не крутиться на 3х, как и должно. Теряюсь в дагадках. Спасибо всем еще раз.

[nixon232]

удалите пост, пожалуйста. форум что-то виснет.

[poli-smen]

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

То, что и нужно, но работает на 2х из 3х гридах, хотя в тоже время колесико не крутиться на 3х, как и должно. Теряюсь в дагадках. Спасибо всем еще раз.

Ну исходники у тебя - тебе видней. Угадывать можно очень долго. Может тот грид лежит не не форме, а на какой нибудь панели. Или может на той форме где лежит этот грид нет обработчика FormMouseDown посылающего магическое сообщение SC_DragMove.

[nixon232]

Сообщение от poli-smen

Ну исходники у тебя - тебе видней. Угадывать можно очень долго. Может тот грид лежит не не форме, а на какой нибудь панели. Или может на той форме где лежит этот грид нет обработчика FormMouseDown посылающего магическое сообщение SC_DragMove.

Вы правы. Не было обработчика на одной из форм, но почему это мешало? Грид то лежит на груп-боксе со свойством alClient. и обработчиком OnMouseDown, посылающим SC_DragMove.
А вообще, было бы интересно узнать, что все-таки вызывает в моем случае выход за индекс грида? Если с колесиком еще можно допустить, что идет пррокрутка, а grid.selection у меня -1, то что вызывает ошибку в обработчике OnMouseDown?