请问：在dbgrid中怎样使鼠标的滑轮对滚动条起作用?

Question

如题，我想通过鼠标滑轮控制dbgrid中记录上下移动，方便查看信息。请指教！！！！

Answer 1

unit Uni_MyDbGrid;interfaceuses
  Windows,SysUtils, Classes,
  Controls, Grids, DBGrids,Messages,DB,
  DBClient,Graphics,Dialogs;Type
  TIndexType = (
               DecIndext,    //  升序  [ixCaseInsensitive]
               AecIndex      //  降序  [ixDescending,ixCaseInsensitive]
               );type
  TMYDBGrid = class(TDBGrid)
  private
    { Private declarations }
    FOldGridWnd : TWndMethod;
    FColumnsIndex : Integer;    //排序Columns的编号
    FIndexType : TIndexType;
    FIndexField : String;      //排序字段名；
    FindexName : string;       //索引名称
    FOColor : TColor;
    FIColor : TColor;
    FColored : Boolean;
    Procedure TitleClick(Column: TColumn);override;
    procedure NewGridWnd (var Message : TMessage);
    Function GetIndexType(InTy : TIndexType): TIndexType;
    Procedure ClearTitle;
    Procedure KeyDown(var Key: Word;Shift: TShiftState);override;
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
   protected
    Procedure Set0Color ( Values : TColor );
    Procedure Set1Color ( Values : TColor );
    Procedure SetColor ( Values : Boolean );
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
    Property Colored : Boolean Read FColored Write SetColor;
    Property OColor : TColor Read FOColor Write Set0Color;
    Property IColor : TColor Read FIColor Write Set1Color;
    property OnTitleClick;
    property OnKeyDown;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Monkey', [TMYDBGrid]);
end;{ TMYDBGrid }procedure TMYDBGrid.ClearTitle;
Var
I,J : Integer;
begin
  For I := 0 to self.Columns.Count - 1 do
    begin
      J := Pos('▼',Self.Columns[I].Title.Caption);
      If J > 0 then
        Self.Columns[I].Title.Caption := Copy(Self.Columns[I].Title.Caption,0,J-1);
    end;end;constructor TMYDBGrid.Create(AOwner: TComponent);
begin
  inherited;
  FColumnsIndex := -1;
  Self.OColor := clSkyBlue;
  Self.IColor := clYellow;
  Self.Color := clScrollBar;
  Self.FOldGridWnd := Self.WindowProc;
  Self.WindowProc :=  NewGridWnd;
end;procedure TMYDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
begin
  If FColored then
  Begin
  //Self.Row
  //Self.DataSource.DataSet.RecNo
  If (Self.DataSource.DataSet.RecNo mod 2) = 0 then
    Self.Canvas.Font.Color := FOColor
  else
    Self.Canvas.Font.Color := FIColor;
    Self.DefaultDrawColumnCell(Rect,DataCol,Column,State);
  end;
  inherited;
end;function TMYDBGrid.GetIndexType(InTy: TIndexType): TIndexType;
begin
  If InTy = DecIndext then
    Result := AecIndex
  else
    InTy := DecIndext ;
end;procedure TMYDBGrid.KeyDown(var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  If (Shift = [ssCtrl]) and (key = 107) then
    begin
    self.TitleFont.Size := self.TitleFont.Size + 2;
    self.Font.Size := self.Font.Size + 2;
    end;
  If (Shift = [ssCtrl]) and (key = 109) then
    begin
    self.TitleFont.Size := self.TitleFont.Size - 2;
    self.Font.Size := self.Font.Size - 2;
    end;
end;procedure TMYDBGrid.NewGridWnd(var Message: TMessage);
var
  IsNeg : Boolean;
begin
  if Message.Msg = WM_MOUSEWHEEL then
  begin
    IsNeg := Short(Message.WParamHi) < 0;
    If Self.DataSource.DataSet <> nil then
    begin
      If Self.DataSource.DataSet.Active then
      begin
        if IsNeg then
          Self.DataSource.DataSet.MoveBy(1)
        else
          Self.DataSource.DataSet.MoveBy(-1)
      end;
    end;
  end
  else Self.FOldGridWnd(Message); end;
procedure TMYDBGrid.Set0Color(Values: TColor);
begin
  FOColor := Values;
end;procedure TMYDBGrid.Set1Color(Values: TColor);
begin
  FIColor := Values;
end;procedure TMYDBGrid.SetColor(Values: Boolean);
begin
  FColored := Values;
end;procedure TMYDBGrid.TitleClick(Column: TColumn);
{$J+}
{$J-}
Var
I,J : Integer;
begin
  inherited;
  If Self.FieldCount = 0 then
    Exit;
  If Self.DataSource.DataSet = nil then
    Exit;
  If Not Self.DataSource.DataSet.Active then
    Exit;
  If Self.DataSource.DataSet Is TClientDataset then
    begin        With TClientDataset(Self.DataSource.DataSet) do        begin
          Case Column.Field.DataType of
            ftBoolean,ftBytes,ftBlob,ftMemo,ftGraphic,ftFmtMemo, ftParadoxOle:
            begin
              MessageBeep(0);
              Exit;
            end;
          end;// end case;
          //
          If FColumnsIndex < 0 then //地一次排序
            begin
              FIndexField := Column.FieldName;
              FIndexType := DecIndext;
              FColumnsIndex := Column.Index;
              FindexName :=FIndexField+ '1';
              AddIndex(FindexName,FIndexField,[ixCaseInsensitive],'','',0);
              ClearTitle;
              Column.Title.Caption := Column.Title.Caption + '▼';
            end else if FColumnsIndex = Column.Index then //对同一个接点的排序
              begin
               FIndexType := GetIndexType(FIndexType);
               If FIndexType = DecIndext then //我定义的升序
                  begin
                    FindexName :=FIndexField+ '1';
                    AddIndex(FindexName, FIndexField,[ixCaseInsensitive],'','',0);
                    ClearTitle;
                    Column.Title.Caption := Column.Title.Caption + '▼';
                  end
               else begin
                    FindexName :=FIndexField+ '2';
                    AddIndex(FindexName, FIndexField,[ixDescending,ixCaseInsensitive],'','',0);
                    ClearTitle;
                    end;
              end else begin //对另一个列排序
                        FIndexField := Column.FieldName;
                        FIndexType := DecIndext;
                        FColumnsIndex := Column.Index;
                        FindexName :=FIndexField+ '1';
                        AddIndex(FindexName,FIndexField,[ixCaseInsensitive],'','',0);
                        ClearTitle;
                        Column.Title.Caption := Column.Title.Caption + '▼';
                       end;
              IndexFieldNames := FIndexField;
        end;// end with
    end;//end if ;
end;end.

Answer 2

//先在form上加一个TApplicationEventsprocedure   TForm1.ApplicationEvents1Message(var   Msg:   tagMSG;
    var   Handled:   Boolean);
begin
  if   (DBGrid1.Focused)   And   (Msg.message   =   WM_MOUSEWHEEL)   then
        begin
            if   Msg.wParam   >   0   then
                SendMessage(DBGrid1.Handle,   WM_KEYDOWN,   VK_UP,   0)
            else
                SendMessage(DBGrid1.Handle,   WM_KEYDOWN,   VK_DOWN,   0);
            Handled   :=   True;
        end;
end;

Answer 3

to madyak(无天) :
   请问如何调用该过程呢？

Answer 4

这个不用调用,是消息处理,你注意把里面的DBGrid1改成你的DBGrid的名字就行了

Answer 5

当DBGrid1处于焦点，并且鼠标滚轮的时候自动会调用无天的函数的，呵呵