☆DBGridに複数行選択のオペレーション機能を追加する。

Excelのようにインジゲーター部分をスライドさせて複数行選択できる機能を実装してみます。 DBGridの複数行選択機能としては、CTRL＋左クリックとShift＋上下キーの ２種類がありますが、今回は、MouseMove時にShift＋上下キーをシミュレートします。 スライド選択でのポイントは、端部にスライドした場合の処理です。 当初WMTimerで処理していたのですが、タイトルをクリックしたときにも メッセージが流れてきてたので、Timerコントロールを使いました。

こんなイメージです。

unit HRSlideSelectDBGrid;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, Grids, DBGrids, ExtCtrls;

type
  THRSlideSelectDBGrid = class(TDBGrid)
  private
    FEditMode: Boolean;
    FTrackingDirection :Integer;
    FTracking: Boolean;
    FIndicatorWidth: Integer;
    FScrollTimer: TTimer;
    FScrollOperation: Word;
    procedure ShiftPlusUp;
    procedure ShiftPlusDn;
    procedure SetIndicatorWidth(Value: Integer);
    procedure ScrollTimer(Sender: TObject);
  protected
    procedure SetColumnAttributes; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property IndicatorWidth: Integer read  FIndicatorWidth
      write SetIndicatorWidth default 30;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Hiderin', [THRSlideSelectDBGrid]);
end;

constructor THRSlideSelectDBGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // スライドし易いように、Indicator幅を広くする。
  FIndicatorWidth := 30;
  SetColumnAttributes;

  // スクロールタイマー
  FScrollTimer := TTimer.Create(Self);
  with FScrollTimer do
  begin
    Interval := 50;
    OnTimer  := ScrollTimer;
    Enabled := False;
  end;

  // 複数選択できるようにしておく。
  Options :=  Options + [dgMultiSelect];
end;

destructor THRSlideSelectDBGrid.Destroy;
begin
  FScrollTimer.Free;
  inherited Destroy;
end;

procedure THRSlideSelectDBGrid.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Cell: TGridCoord;
begin
  // セル位置の取得
  Cell := MouseCoord(X, Y);

  // スライド選択開始のための設定
  if (Cell.X = 0) and (Cell.Y > 0) and (not FTracking) and
     (not (ssCtrl in Shift)) and (not (ssShift in Shift)) then
  begin
    FTracking := True;
    FTrackingDirection := Cell.Y;
    // dgEditingがOptionsに含まれていると、スライド選択時に最終行を追加
    // 処理してしまうため、一時無効にしておく。
    if ([dgEditing] * Options = [dgEditing]) then
    begin
      FEditMode := True;
      Options := Options - [dgEditing];
    end;
  end;

  inherited MouseDown(Button, Shift, X, Y);;
end;

procedure THRSlideSelectDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  // スライド選択の終了処理
  FScrollTimer.Enabled := False;
  FTracking := False;
  // 必要ならば無効にしたdgEditingを有効に戻しておく。
  if FEditMode then
  begin
    FEditMode := False;
    Options := Options + [dgEditing];
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure THRSlideSelectDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);

  procedure RowSelectByMouseMove;
  const
    Offset = 20; //適当
  var
    Cell: TGridCoord;
  begin
    // セル位置の取得
    Cell := MouseCoord(X, Y);

    // 表示されていない部分をスクロールさせます。
    if (Y < Offset) or (Y >= ClientHeight - Offset) then
      begin
        if (Y < Offset) then
          FScrollOperation := SB_LINEUP
        else
          FScrollOperation := SB_LINEDOWN;
        FScrollTimer.Enabled := True;
      end
    else
      FScrollTimer.Enabled := False;

    // マウスの位置の行を選択させます。
    if (FTrackingDirection <> Cell.Y) then
    begin
      if (FTrackingDirection < Cell.Y) then
        ShiftPlusDn
      else
        ShiftPlusUp;
      FTrackingDirection := Cell.Y;
    end;
  end;

begin
  // スライド選択が開始されていない場合には処理しません。
  if FTracking then
  begin
    RowSelectByMouseMove;
    Exit;
  end;
  inherited MouseMove(Shift, X, Y);
end;


procedure THRSlideSelectDBGrid.ScrollTimer(Sender: TObject);
var
  KeyBoardState: TKeyBoardState;
  DefaultKeyState: Byte;
begin
  if (FScrollOperation = SB_LINEDOWN) then
  begin
    GetKeyBoardState(KeyBoardState);
    DefaultKeyState := KeyBoardState[VK_SHIFT];
    KeyBoardState[VK_SHIFT] := $81;
    SetKeyBoardState(KeyBoardState);
    Perform(WM_KEYDOWN, VK_DOWN, 1);
    Perform(WM_KEYUP, VK_DOWN, 1);
    KeyBoardState[VK_SHIFT] := DefaultKeyState;
    SetKeyBoardState(KeyBoardState);
  end
  else
  begin
    GetKeyBoardState(KeyBoardState);
    DefaultKeyState := KeyBoardState[VK_SHIFT];
    KeyBoardState[VK_SHIFT] := $81;
    SetKeyBoardState(KeyBoardState);
    Perform(WM_KEYDOWN, VK_UP, 1);
    Perform(WM_KEYUP  , VK_UP, 1);
    KeyBoardState[VK_SHIFT] := DefaultKeyState;
    SetKeyBoardState(KeyBoardState);
  end;
end;

procedure THRSlideSelectDBGrid.ShiftPlusDn;
var
  KeyBoardState: TKeyBoardState;
  DefaultKeyState: Byte;
begin
  GetKeyBoardState(KeyBoardState);
  DefaultKeyState := KeyBoardState[VK_SHIFT];
  KeyBoardState[VK_SHIFT] := $81;
  SetKeyBoardState(KeyBoardState);
  Perform(WM_KEYDOWN, VK_DOWN, 1);
  Perform(WM_KEYUP, VK_DOWN, 1);
  KeyBoardState[VK_SHIFT] := DefaultKeyState;
  SetKeyBoardState(KeyBoardState);
end;

procedure THRSlideSelectDBGrid.ShiftPlusUp;
var
  KeyBoardState: TKeyBoardState;
  DefaultKeyState: Byte;
begin
  GetKeyBoardState(KeyBoardState);
  DefaultKeyState := KeyBoardState[VK_SHIFT];
  KeyBoardState[VK_SHIFT] := $81;
  SetKeyBoardState(KeyBoardState);
  Perform(WM_KEYDOWN, VK_UP, 1);
  Perform(WM_KEYUP  , VK_UP, 1);
  KeyBoardState[VK_SHIFT] := DefaultKeyState;
  SetKeyBoardState(KeyBoardState);
end;

procedure THRSlideSelectDBGrid.SetIndicatorWidth(Value: Integer);
begin
  if Value <> FIndicatorWidth then
  begin
    FIndicatorWidth := Value;
    SetColumnAttributes;
  end;
end;

procedure THRSlideSelectDBGrid.SetColumnAttributes;
begin
  inherited;
  if (dgIndicator in Options) then
    ColWidths[0] := IndicatorWidth;
end;

end.