讓 Delphi DBGrid 支援滑鼠滾輪：自訂元件完整教學

問題由來

標準 TDBGrid 無 OnMouseWheel 事件，滾動大量資料時只能用鍵盤或捲軸，體驗極差。Windows 發送 WM_MOUSEWHEEL 訊息，我們可透過覆寫 WndProc 攔截並轉發為自訂事件。

WM_MOUSEWHEEL 訊息參數解析

// wParam 高位字 = 滾輪增量 (WHEEL_DELTA = 120 的倍數，正=向前/上，負=向後/下)
// wParam 低位字 = 虛擬鍵狀態 (MK_CONTROL, MK_SHIFT 等)
// lParam 低位字 = X 座標 (螢幕)，高位字 = Y 座標

自訂元件 TMyDBGrid 完整實現

1. 建立元件專案

• File → New → Package 或現有套件
• Add → New Component
• Ancestor Type: TDBGrid (Grids 單元)
• Class Name: TMyDBGrid
• Palette Page: Samples

2. 元件核心代碼 (MyDBGrid.pas)

unit MyDBGrid;
interface
uses Windows, Messages, SysUtils, Classes, Controls, Grids, DBGrids;

type
  TMouseWheelEvent = procedure(Sender: TObject; Shift: TShiftState;
    WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean) of object;
  TMouseWheelUpDownEvent = procedure(Sender: TObject; Shift: TShiftState;
    MousePos: TPoint; var Handled: Boolean) of object;

  TMyDBGrid = class(TDBGrid)
  private
    fOnMouseWheel: TMouseWheelEvent;
    fOnMouseWheelUp: TMouseWheelUpDownEvent;
    fOnMouseWheelDown: TMouseWheelUpDownEvent;
  protected
    procedure WndProc(var Msg: TMessage); override;
  published
    property OnMouseWheel: TMouseWheelEvent read fOnMouseWheel write fOnMouseWheel;
    property OnMouseWheelUp: TMouseWheelUpDownEvent read fOnMouseWheelUp write fOnMouseWheelUp;
    property OnMouseWheelDown: TMouseWheelUpDownEvent read fOnMouseWheelDown write fOnMouseWheelDown;
  end;

procedure Register;
implementation

procedure TMyDBGrid.WndProc(var Msg: TMessage);
var
  Pt: TPoint;
  Handled: Boolean;
  ShiftState: TShiftState;
  Delta: Integer;
begin
  if Msg.Msg = WM_MOUSEWHEEL then
  begin
    // 解碼參數
    Pt.X := SmallInt(LoWord(Msg.lParam));
    Pt.Y := SmallInt(HiWord(Msg.lParam));
    Pt := ScreenToClient(Pt);  // 轉為客戶區座標
    Delta := SmallInt(HiWord(Msg.wParam)); // 滾輪增量 (±120)
    ShiftState := KeysToShiftState(LoWord(Msg.wParam));
    Handled := False;

    // 觸發對應事件
    if Delta > 0 then
      if Assigned(fOnMouseWheelUp) then
        fOnMouseWheelUp(Self, ShiftState, Pt, Handled)
    else
      if Assigned(fOnMouseWheelDown) then
        fOnMouseWheelDown(Self, ShiftState, Pt, Handled);

    if Assigned(fOnMouseWheel) then
      fOnMouseWheel(Self, ShiftState, Delta, Pt, Handled);

    if Handled then Exit; // 使用者已處理，不再傳遞
  end;
  inherited; // 交給祖先處理 (含預設捲動)
end;

procedure Register;
begin
  RegisterComponents('Samples', [TMyDBGrid]);
end;
end.

3. 安裝與測試

1. 編譯套件 → Install
2. 新建專案，從 Samples 頁拖放 TMyDBGrid
3. 連接 DataSource → Table/Query
4. 在 OnMouseWheelUp 寫入捲動邏輯：

procedure TForm1.MyDBGrid1MouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  // 向上滾動一行 (或多行)
  TDBGrid(Sender).DataSource.DataSet.Prior;
  Handled := True;
end;

procedure TForm1.MyDBGrid1MouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  TDBGrid(Sender).DataSource.DataSet.Next;
  Handled := True;
end;

4. 進階：支援頁面捲動與 Shift 加速

procedure TForm1.MyDBGrid1MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var Grid: TDBGrid; Steps: Integer;
begin
  Grid := TDBGrid(Sender);
  Steps := Abs(WheelDelta) div WHEEL_DELTA; // 通常 1
  if ssShift in Shift then Steps := Steps * 5; // Shift 加速 5 行
  if ssCtrl in Shift then Steps := Steps * 20; // Ctrl 加速 20 行 (頁面)

  if WheelDelta > 0 then
    for var i := 1 to Steps do Grid.DataSource.DataSet.Prior
  else
    for var i := 1 to Steps do Grid.DataSource.DataSet.Next;
  Handled := True;
end;

效果展示

關鍵技術點總結

遷移至現代 Delphi 版本注意事項

• Delphi 10.4+ VCL 已內建 OnMouseWheel 於 TWinControl，TDBGrid 可能已支援，請先檢查再決定是否需要自訂元件。
• High-DPI 環境下滾輪增量可能不同，建議使用 MulDiv(WheelDelta, 1, WHEEL_DELTA) 正規化。
• FireMonkey (FMX) 使用 OnMouseWheel 事件直接支援，無需此技巧。