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;
|