Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2018年03月25日] [更新 2018年03月25日] Delphi サンプルプログラム集
078_コントロールのマウスホイール操作によるスクロール
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
078_Control_MouseWheel.zip [3,934 KB] 2018年03月25日版 (EXE 同梱)







スクロール機能を持つントロールのマウスホイールによる操作


TListBox や TListView, TComboBox 等はアイテム (表示するリストの項目) の数が増えるとスクロールバーが現れて,マウスホイールでスクロール表示できるようになります.本ページはそのマウスホイールによるスクロールのテスト用サンプルです.

マウスホイールによるスクロールは通常フォーカスがあるコントロールに対して行われますが,マウスカーソル (マウスのポインタ) がそれらのコントロール上にある時だけスクロールするようにするテストもしています.フォーカスがあるコントロールとは,親であるフォームの ActiveControl の値がそのコントロールである場合のことです.

TScrollBox もマウスホイールでスクロール表示できますが,OnMouseWheel イベントで処理しないとスクロール動作はしてくれません.





01_TListBox のマウスホイールによるスクロール


TListBox のマウスホイールによるスクロール操作を確認するためだけのテストプログラムです.
フォームに TEdit, TListBox を配置しているだけです.



図1
EXE 実行開始時
  • Edit1 にフォーカスがあるので,TListBox はマウスホイールでスクロールしない
図2
フォーカスを TListBox に移動
  • TLitBox をクリックしてフォーカスを移動
  • マウスホイールでスクロールできるようになる
図3
TListBox 以外の場所でもスクロール可能
  • TListBox にフォーカスがあるので,マウスカーソルが別の場所にあってもマウスホイールでスクロール可能

リスト1
TListBox のマウスホイールによるスクロール
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  テスト用のデータをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LCount : Integer;
  LIndex : Integer;
  LText  : string;
begin
  ActiveControl := Edit1;

  LCount := 50;

  ListBox1.Font.Name := 'Courier New';
  ListBox1.Font.Size := 9;

  ListBox1.Items.BeginUpdate;
  for LIndex := 0 to LCount - 1 do begin
    LText := 'ITem-' + Format('%.3d', [LIndex + 1]);
    ListBox1.Items.Add(LText);
  end;
  ListBox1.Items.EndUpdate;
end;

end.




02_TListView のマウスホイールによるスクロール


TListView のマウスホイールによるスクロール操作を確認するためだけのテストプログラムです.
フォームに TEdit, TListView を配置しているだけです.




図4
実行時の画面
  • マウスホイールによる動作は TListBox と同じ

リスト2
TListView のマウスホイールによるスクロール
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  テスト用のデータをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LCount : Integer;
  LIndex : Integer;
  LText  : string;
begin
  ActiveControl := Edit1;

  LCount := 50;

  ListView1.ViewStyle := vsReport;
  ListView1.Columns.Add;
  ListView1.Column[0].Width   := -1;
  ListView1.Column[0].Caption := '項目';

  ListView1.Font.Name := 'Courier New';
  ListView1.Font.Size := 9;

  ListView1.Items.BeginUpdate;
  for LIndex := 0 to LCount - 1 do begin
    LText := 'ITem-' + Format('%.3d', [LIndex + 1]);
    ListView1.Items.Add.Caption := LText;
  end;
  ListView1.Items.EndUpdate;
end;

end.




03_TComboBox のマウスホイールによるスクロール


TComboBox のマウスホイールによるスクロール操作を確認するためだけのテストプログラムです.
フォームに TEdit, TComboBox を配置しているだけです.




図5
実行時の画面
  • マウスホイールによる動作は TListBox と同じ

図6
ドロップダウンリストを閉じた状態
  • TComboBox にフォーカスがあるので,この状態でもマウスホイールでスクロール可能
  • マウスホイールで TComboBox の項目の値が変わる

リスト3
TComboBox のマウスホイールによるスクロール
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  テスト用のデータをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LCount : Integer;
  LIndex : Integer;
  LText  : string;
begin
  ActiveControl := Edit1;

  LCount := 50;

  ComboBox1.Style := csDropDownList;

  ComboBox1.Font.Name := 'Courier New';
  ComboBox1.Font.Size := 9;

  ComboBox1.Items.BeginUpdate;
  for LIndex := 0 to LCount - 1 do begin
    LText := 'ITem-' + Format('%.3d', [LIndex + 1]);
    ComboBox1.Items.Add(LText);
  end;
  ComboBox1.ItemIndex := 0;
  ComboBox1.Items.EndUpdate;
end;

end.




04_マウスカーソル下のコントロールだけをスクロール (1)


ここまでで単独のコントロールのマウスホイールによるスクロールのテストをしました.それらの
コントロールにフォーカスがあればマウスホイールでスクロールできます.

本サンプルは,対象のコントロールの領域内にマウスカーソル (マウスポインタ) がある時だけマウスホイールによるスクロールができるようにするサンプルです.状況によってはこの方が都合がいい場合があります.コントロールの親フォームの OnMouseWheel イベントで処理します.
フォーカスのあるコントロールだけを対象にしたい時は,親フォームの ActiveControl の値も判定の条件に追加することになります.
TListBox, TListView, TScrollBox 等は継承元が TWinControl なので,FindVCLWindow 関数を使用してマウスカーソル下のコントロールを検出できます.

TComboBox はドロップダウンリストが表示されている時だけマウイホイールによるスクロールできるようにしています.
対象のコントロールが TComboBox の時は ActiveControl の値で判定します.ActiveControl,つまりフォーカスがあるコントロールが TComboBox で,かつ,ドロップダウンリストが表示されていない場合は,イベントの Handled の値を True にして返します.この値を True にするとスクロールメッセージが行われたことになり,このイベントで処理する以外のスクロール動作をしなくなります.




図7
実行時の画面
  • TComboBox にフォーカスがあるが,ドロップダウンリストが表示されていないのでマウスホイールではスクロールしない
  • マウスホイールで TComboBox の値は変更できない

リスト4
マウスカーソル下のコントロールだけをスクロール
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListView1: TListView;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  テスト用のデータをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LCount : Integer;
  LIndex : Integer;
  LText  : string;
begin
  LCount := 50;


  ListBox1.Font.Name := 'Courier New';
  ListBox1.Font.Size := 9;

  ListBox1.Items.BeginUpdate;
  for LIndex := 0 to LCount - 1 do begin
    LText := 'ITem-' + Format('%.3d', [LIndex + 1]);
    ListBox1.Items.Add(LText);
  end;
  ListBox1.Items.EndUpdate;


  ListView1.ViewStyle := vsReport;
  ListView1.Columns.Add;
  ListView1.Column[0].Width := -1;

  ListView1.Font.Name := 'Courier New';
  ListView1.Font.Size := 9;

  ListView1.Items.BeginUpdate;
  for LIndex := 0 to LCount - 1 do begin
    LText := 'ITem-' + Format('%.3d', [LIndex + 1]);
    ListView1.Items.Add.Caption := LText;
  end;
  ListView1.Items.EndUpdate;


  ComboBox1.Style := csDropDownList;

  ComboBox1.Font.Name := 'Courier New';
  ComboBox1.Font.Size := 9;

  ComboBox1.Items.BeginUpdate;
  for LIndex := 0 to LCount - 1 do begin
    LText := 'ITem-' + Format('%.3d', [LIndex + 1]);
    ComboBox1.Items.Add(LText);
  end;
  ComboBox1.ItemIndex := 0;
  ComboBox1.Items.EndUpdate;
end;

//=============================================================================
//  親であるこのフォームのOnMouseWheelイベント処理
//  引数のHandledプロパティが動作を決める
//=============================================================================
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  LWinCtrl : TWinControl;
begin
  LWinCtrl := FindVCLWindow(MousePos);

  //TListBox,TListViewの場合
  //マウスカーソル下にあればスクロールする
  if (LWinCtrl is TListBox) or (LWinCtrl is TListView) then begin
    if WheelDelta > 0 then begin
      LWinCtrl.Perform(WM_VSCROLL, SB_LINEUP, 0);
    end else begin
      LWinCtrl.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
    end;
    Handled := True;
  end else
  //TComboBoxの場合
  //ドロップダウンしている時だけスクロールを許可する
  if ActiveControl = ComboBox1 then begin
    if not ComboBox1.DroppedDown then begin
      Handled := True;
    end;
  end;
end;

end.




05_TScrollBox のマウスホイールによるスクロール


TScrollBox のマウスホイールによるスクロール操作を確認するためだけのテストプログラムです. フォームに TScrollBox を配置しているだけです.
TScrollBox はイベントで処理しないとスクロール動作はしてくれません.以降のサンプルでは親フォームの OnMouseWheel イベントで処理しています.

フォームに配置したのが TScrollBox 1 つだけですから,ActiveControl はこの TScrollBox です.



[備考]
TScrollBox, TPanel 等でも ActiveControl にすると OnKeyDown イベント等でキー操作を処理できるようになります.ただし,矢印キー等の特殊キーを検出するには WM_GETDLGCODE メッセージを処理する必要があります.




図8
フォームに TScrollBox だけを配置
  • その TScrollBox に TPanel を 1 つだけ配置
  • ActiveControl はこの TScrollBox なので,EXE を起動すればただちにマウスホイールでスクロールできる

図9
マウスカーソルがこの位置でもマウスホイールでスクロールする

図10
Range プロパティの効果の確認用
  • マウスホイールによるスクロールのテストとは直接関係ない
  • Range プロパティを設定していない場合は,スクロールバーの下端と TScrollBox に配置したコントロールの下端が一致する

リスト5
TScrollBox のマウスホイールによるスクロール
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //TScrollBoxのスクロールレンジ設定
  ScrollBox1.VertScrollBar.Range := Panel1.Height + 50;

  //TScrollBoxのスクロールのトラッキング設定
  ScrollBox1.VertScrollBar.Tracking := True;
end;

//=============================================================================
//  親であるこのフォームのOnMouseWheelイベント処理
//=============================================================================
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  LDelta : Integer;
begin
  LDelta  := WheelDelta div 5;
  if ssCtrl in Shift then begin
    ScrollBox1.HorzScrollBar.Position := ScrollBox1.HorzScrollBar.Position - LDelta;
  end else begin
    ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - LDelta;
  end;
  Handled := True;
end;

end.




06_TScrollBox と TListView 等を配置した時のスクロール


フォームに TScrollBox と TListBox, TListView 等を配置する場合のテストです.フォーカスのあるコントロール,つまり ActiveControl をマウスホイールでスクロール表示します.
TScrollBox はクリックしても ActiveControl にはなりません.そこで TScrollBox とその上に配置しているコントロールの OnClick イベントで ActiveControl にしています.




図11
実行時の画面
  • TScrollBot を ActiveControl にするには,TScrollBox のクライアント領域内をクリックする
  • スクロールバー (非クライアント領域) のクリックではアクティブにならない

リスト6
TScrollBox と TListView 等を配置した時のマウスホイールによるスクロール制御
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure ScrollBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LCount : Integer;
  LIndex : Integer;
  LText  : string;
begin
  //TListViewにテスト用のデータをセット
  LCount := 50;

  ListView1.ViewStyle := vsReport;
  ListView1.Columns.Add;
  ListView1.Column[0].Width   := -1;
  ListView1.Column[0].Caption := '項目';

  ListView1.Font.Name := 'Courier New';
  ListView1.Font.Size := 9;

  ListView1.Items.BeginUpdate;
  for LIndex := 0 to LCount - 1 do begin
    LText := 'ITem-' + Format('%.3d', [LIndex + 1]);
    ListView1.Items.Add.Caption := LText;
  end;
  ListView1.Items.EndUpdate;


  //TScrollBoxのスクロールレンジ設定
  ScrollBox1.HorzScrollBar.Range := Panel1.Width + 50;
  ScrollBox1.VertScrollBar.Range := Panel1.Height + 50;

  //TScrollBoxのスクロールのトラッキング設定
  ScrollBox1.HorzScrollBar.Tracking := True;
  ScrollBox1.VertScrollBar.Tracking := True;
end;

//=============================================================================
//  親であるこのフォームのOnMouseWheelイベント処理
//=============================================================================
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  LDelta : Integer;
begin
  //if ScrollBox1.Focused then begin でも同じ
  if Self.ActiveControl = ScrollBox1 then begin
    LDelta  := WheelDelta div 5;
    if ssCtrl in Shift then begin
      ScrollBox1.HorzScrollBar.Position := ScrollBox1.HorzScrollBar.Position - LDelta;
    end else begin
      ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - LDelta;
    end;
    Handled := True;
  end;
end;

//=============================================================================
//  ScrollBox1のOnClickイベント処理
//  Panel1のOnClickイベント処理と兼用
//
//  ScrollBox1がOnMouseWheelイベントを処理できるようにする
//=============================================================================
procedure TForm1.ScrollBox1Click(Sender: TObject);
begin
  Self.ActiveControl := ScrollBox1;
end;

end.




07_マウスカーソル下のコントロールだけをスクロール (2)


上の方でも同じ動作のサンプルがありますが,本サンプルは TScrollBox と TListView をフォームに配置した場合のサンプルです.
対象のコントロールの領域内にマウスカーソル (マウスポインタ) がある時だけマウスホイールによるスクロールができるようにします.状況によってはこの方が都合がいい場合があります.
フォーカスのあるコントロールだけを対象にしたい時は,親フォームの ActiveControl の値も判定の条件に追加することになります.




図12
実行時の画面

リスト7
マウスカーソル下のコントロールだけをマウスホイールでスクロール
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LCount : Integer;
  LIndex : Integer;
  LText  : string;
begin
  //TListViewにテスト用のデータをセット
  LCount := 50;

  ListView1.ViewStyle := vsReport;
  ListView1.Columns.Add;
  ListView1.Column[0].Width   := -1;
  ListView1.Column[0].Caption := '項目';

  ListView1.Font.Name := 'Courier New';
  ListView1.Font.Size := 9;

  ListView1.Items.BeginUpdate;
  for LIndex := 0 to LCount - 1 do begin
    LText := 'ITem-' + Format('%.3d', [LIndex + 1]);
    ListView1.Items.Add.Caption := LText;
  end;
  ListView1.Items.EndUpdate;


  //TScrollBoxのスクロールレンジ設定
  ScrollBox1.HorzScrollBar.Range := Panel1.Width + 50;
  ScrollBox1.VertScrollBar.Range := Panel1.Height + 50;

  //TScrollBoxのスクロールのトラッキング設定
  ScrollBox1.HorzScrollBar.Tracking := True;
  ScrollBox1.VertScrollBar.Tracking := True;
end;

//=============================================================================
//  親であるこのフォームのOnMouseWheelイベント処理
//=============================================================================
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  LWinCtrl : TWinControl;
  LCurPos  : TPoint;
  LDelta   : Integer;
begin
  LWinCtrl := FindVCLWindow(MousePos);


  //TListBox,TListViewの場合
  if (LWinCtrl is TListBox) or (LWinCtrl is TListView) then begin
    if WheelDelta > 0 then begin
      LWinCtrl.Perform(WM_VSCROLL, SB_LINEUP, 0);
    end else begin
      LWinCtrl.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
    end;
  end else begin
    //マウスカーソル位置がScrollBox1のクライアント領域内の時
    LCurPos := ScrollBox1.ScreenToClient(MousePos);

    if PtInRect(ScrollBox1.ClientRect, LCurPos) then begin
      LDelta  := WheelDelta div 5;
      if ssCtrl in Shift then begin
        ScrollBox1.HorzScrollBar.Position := ScrollBox1.HorzScrollBar.Position - LDelta;
      end else begin
        ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - LDelta;
      end;
    end;
  end;

  Handled := True;
end;

end.


上のコードでは,TListView はコントロールの領域内にマウスカーソルがあればマウスホイールでスクロールします.一方,TScrollBox は,非クライアント領域であるスクロールバーの部分ではマウスホイールによるスクロールはできません.
TScrollBox の非クライアント領域でもマウスホイールでスクロールさせるには,例えば以下のように領域として BoundsRect を使用します.



リスト8
マウスカーソルが TScrollBox の領域内にある時だけスクロールを可能にする
    //マウスカーソル位置がScrollBox1の領域内の時
    LCurPos := ScrollBox1.Parent.ScreenToClient(MousePos);

    if PtInRect(ScrollBox1.BoundsRect, LCurPos) then begin


本サンプルでは TScrollBox に TPanel を 1 つしか配置していません.したがって,TScrollBox の部分は次のように書くこともできます.



リスト9
マウスカーソルが TScrollBox の領域内にある時だけスクロールを可能にする
  end else begin
    if (LWinCtrl = ScrollBox1) or (LWinCtrl = Panel1) then begin
      LDelta  := WheelDelta div 5;
      if ssCtrl in Shift then begin
        ScrollBox1.HorzScrollBar.Position := ScrollBox1.HorzScrollBar.Position - LDelta;
      end else begin
        ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - LDelta;
      end;
    end;
  end;