Delphi DBgrid DBCtrlGrid控件的滾動條問題

Delphi DBgrid DBCtrlGrid控件的滾動問題

1、不支持鼠標中鍵

2、鼠標一定要松開才生效

3、滾動條才滾動的時候數據庫也會跟著滾動 (不能算缺點只有不一樣的方式，如果能提供多種選擇就好了)

 

以上1、2點現可以解決。3點暫沒有找到方法

用法

  TDBGridEx.Create(Application, DBGrid1);
  TDBCtrlGridEx.Create(Application, DBCtrlGrid1);

 

//DBGridEx單元代碼

//////////////////////////////////////////////////////////////////////////

unit uDBGridEx;

interface

uses
  Windows, Forms, Classes, Messages, DBGrids;

type
  TDBGridEx = class(TComponent)
  private
    D: TDBGrid;
    F: TWndMethod;
  protected
    procedure DBGridProc(var Message:TMessage);virtual;
  Public
    constructor Create(AOwner: TComponent; DBGrid: TDBGrid);reintroduce;
    destructor Destroy; override;
  end;

procedure WiseDBGrid(DBGrid: TDBGrid);overload;
procedure WiseDBGrid(AForm: TForm; DBGrid: TDBGrid);overload;

implementation

procedure WiseDBGrid(DBGrid: TDBGrid);overload;
begin
  TDBGridEx.Create(Application, DBGrid);
end;

procedure WiseDBGrid(AForm: TForm; DBGrid: TDBGrid);overload;
begin
  TDBGridEx.Create(AForm, DBGrid);
end;

{ TDBGridEx }

constructor TDBGridEx.Create(AOwner: TComponent; DBGrid: TDBGrid);
begin
  inherited Create(AOwner);
  F := DBGrid.WindowProc;
  D := DBGrid;
  D.WindowProc := DBGridProc;
end;

procedure TDBGridEx.DBGridProc(var Message: TMessage);
var
  si: TScrollInfo;
  Par: WPARAM;
begin
  case Message.Msg of
    WM_MOUSEWHEEL: //鼠标中键
      begin
        FillChar(si,SizeOf(si),0);
        si.cbSize := SizeOf(si); //拿全部信息
        si.fMask := SIF_TRACKPOS or SIF_RANGE or SIF_POS or SIF_PAGE;
        with TWMMouseWheel(Message) do begin
          GetScrollInfo(D.Handle, SB_VERT, si);  // 拿滚动条相关信息
          if WheelDelta <0 then    //小于 0 则表示向下滚动
            begin
              if Keys = MK_CONTROL then  //按下CTRL键,则翻页滚动.
                Par := SB_PAGEDOWN
              else Par := SB_LINEDOWN;   //不按特殊键,则单行滚动
              D.Perform(WM_VSCROLL,Par,0);
            end
          else begin
            if Keys = MK_CONTROL then    //同上,只是滚动方向相反
              Par := SB_PAGEUP
            else Par := SB_LINEUP;
            D.Perform(WM_VSCROLL,Par,0);
          end;
        end;
      end;
    WM_VSCROLL:  //纵向滚动条
      begin
        with TWMVScroll(Message) do
        begin
          case ScrollCode of
            SB_THUMBTRACK:
              D.Perform(WM_VSCROLL,SB_THUMBPOSITION,Pos)
          end;
        end;
      end;
    end;
  F(Message);
end;

destructor TDBGridEx.Destroy;
begin
  if (D <> nil) then D.WindowProc := F;
  inherited Destroy;
end;

end.

 

//DBCtrlGridEx單元代碼

//////////////////////////////////////////////////////////////////////////

unit uDBCtrlGridEx;

interface

uses
  Windows, Forms, Classes, Messages, DBCGrids;

type
  TDBCtrlGridEx = class(TComponent)
  private
    D: TDBCtrlGrid;
    F: TWndMethod;
  protected
    procedure DBCtrlGridProc(var Message:TMessage);virtual;
  Public
    constructor Create(AOwner: TComponent; DBCtrlGrid: TDBCtrlGrid);reintroduce;
    destructor Destroy; override;
  end;

procedure WiseDBCtrlGrid(DBCtrlGrid: TDBCtrlGrid);overload;
procedure WiseDBCtrlGrid(AForm: TForm; DBCtrlGrid: TDBCtrlGrid);overload;

implementation

procedure WiseDBCtrlGrid(DBCtrlGrid: TDBCtrlGrid);overload;
begin
  TDBCtrlGridEx.Create(Application, DBCtrlGrid);
end;

procedure WiseDBCtrlGrid(AForm: TForm; DBCtrlGrid: TDBCtrlGrid);overload;
begin
  TDBCtrlGridEx.Create(AForm, DBCtrlGrid);
end;

{ TDBCtrlGridEx }

constructor TDBCtrlGridEx.Create(AOwner: TComponent; DBCtrlGrid: TDBCtrlGrid);
begin
  inherited Create(AOwner);
  F := DBCtrlGrid.WindowProc;
  D := DBCtrlGrid;
  D.WindowProc := DBCtrlGridProc;
end;

procedure TDBCtrlGridEx.DBCtrlGridProc(var Message: TMessage);
var
  si: TScrollInfo;
  Par: WPARAM;
begin
  case Message.Msg of
    WM_MOUSEWHEEL: //鼠标中键
      begin
        FillChar(si,SizeOf(si),0);
        si.cbSize := SizeOf(si); //拿全部信息
        si.fMask := SIF_TRACKPOS or SIF_RANGE or SIF_POS or SIF_PAGE;
        with TWMMouseWheel(Message) do begin
          GetScrollInfo(D.Handle, SB_VERT, si);  // 拿滚动条相关信息
          if WheelDelta <0 then    //小于 0 则表示向下滚动
            begin
              if Keys = MK_CONTROL then  //按下CTRL键,则翻页滚动.
                Par := SB_PAGEDOWN
              else Par := SB_LINEDOWN;   //不按特殊键,则单行滚动
              D.Perform(WM_VSCROLL,Par,0);
            end
          else begin
            if Keys = MK_CONTROL then    //同上,只是滚动方向相反
              Par := SB_PAGEUP
            else Par := SB_LINEUP;
            D.Perform(WM_VSCROLL,Par,0);
          end;
        end;
      end;
    WM_VSCROLL:  //纵向滚动条
      begin
        with TWMVScroll(Message) do
        begin
          case ScrollCode of
            SB_THUMBTRACK:
              D.Perform(WM_VSCROLL,SB_THUMBPOSITION,Pos)
          end;
        end;
      end;
    end;
  F(Message);
end;

destructor TDBCtrlGridEx.Destroy;
begin
  if (D <> nil) then D.WindowProc := F;
  inherited Destroy;
end;

end.