[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;