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;