Delphi Programming / Object Pascal
[掲載 2015年07月25日] [更新 2015年08月01日] Delphi サンプルプログラム集
074_TListBox のスクロールバーの表示制御
動作確認等
Windows 7 U64(SP1) + Delphi XE(UP1) Pro
074_TListBox_ScrollBar.zip [2,755 KB] 2015年08月01日版 (EXE 同梱)
TListBox のスクロールバーの設定関係のサンプルです.
TListBox には,TStringGrid や TRichEdit のような,ScrollBars プロパティはありません.
水平スクロールバーは常に非表示,垂直スクロールバーは,TListBox のクライアント領域にデータの全てが表示できない状態の時に自動的に現れます.
本ページのサンプルは,これらのスクロールバーを強制的に表示したり,非表示にするサンプルです.作成したプログラムで,表示と非表示を切り換えるには,プロパティを実装することになります.そのプロパティを変更したら,TList.RecreateWnd を実行します.
本ページのサンプルでは,継承クラスをコンポーネントとして登録 (インストール) しないで,[派生元のコンポーネントと交換する方法] で説明しているユニットを使用しています.
01_ TListBox のスクロールバーを常に表示
TListBox の継承クラス (コンポーネント) を作成して,WM_NCCALCSIZE メッセージ処理内で強制的に TListBox のスタイルに WS_VSCROLL と WS_HSCROLL を追加して,垂直と水平スクロールバーを常に表示するようにしたサンプルです.
WM_NCCALCSIZE メッセージは,ウィンドウが生成または再生成されると発生します.
水平スクロールバーを表示しても,水平スクロールボックス (つまみ) の部分のサイズはスクロールバーのサイズのままです,そこで,LB_SETHORIZONTALEXTENT メッセージでスクロール長であるスクロールレンジの値を設定しています.この値を,表示する文字列の最大長としています.
図1
設計時の画面
継承クラス (コンポーネント) を実行時に生成するので,フォームには TListBox はない
図2
実行開始画面
図3
フォームをリサイズ
TListBox に表示しているデータ行数分が全て表示されている状態
縦方向のスクロールバーの操作はできなくなる
横方向のスクロールバーは操作可能
リスト1
TListBox の水平スクロールバーと垂直スクロールバーを常に表示
copy code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TplListBox = class (TListBox)
protected
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
end ;
TForm1 = class (TForm)
Panel1: TPanel;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private 宣言 }
plListBox1 : TplListBox;
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
uses
StrUtils;
{$R *.dfm}
// =============================================================================
// フォーム作成時の処理
// TListBoxの派生コンポーネントを生成
// DupeStringの使用にはusesにStrUtilsが必要
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
LText1 : String ;
LText2 : String ;
begin
Panel1.Caption := '' ;
plListBox1 := TplListBox.Create(Self);
plListBox1.Parent := Self;
plListBox1.Align := alClient;
plListBox1.Font.Charset := ANSI_CHARSET;
plListBox1.Font.Name := 'Courier New' ;
plListBox1.Font.Size := 9 ;
// テスト用のデータをセット
plListBox1.Items.BeginUpdate;
for i:=0 to 19 do begin
LText1 := Format('%.6d' ,[i + 1 ]);
LText2 := ' ' + LText1 + ' - ' + DupeString(Trim(LText1), 9 );
plListBox1.Items.Add(LText2);
end ;
plListBox1.Items.EndUpdate;
end ;
// =============================================================================
// フォームが表示される時の処理
// 横スクロールバーを表示するコードを実行
// LB_SETHORIZONTALEXTENTメッセージ処理はOnCreateでは実行しないこと
// =============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
i : Integer;
LMaxTextWidth : Integer;
LTextWidth : Integer;
begin
// TListBoxのCanvasのフォントをTListBoxと同じにする
plListBox1.Canvas.Font.Assign(plListBox1.Font);
// Itemの文字列の長さの最大値を取得
LMaxTextWidth := 0 ;
for i := 0 to plListBox1.Items.Count - 1 do begin
LTextWidth := plListBox1.Canvas.TextWidth(plListBox1.Items[i]);
if (LMaxTextWidth < LTextWidth) then begin
LMaxTextWidth := LTextWidth;
end ;
end ;
// スクロールして全部見えるように,1文字分多くしておく
LMaxTextWidth := LMaxTextWidth + plListBox1.Canvas.TextWidth('W' );
// 横スクロールのスクロール長を設定
// この長さよりクライアント領域の幅が短ければスクロールバーが表示される
plListBox1.Perform(LB_SETHORIZONTALEXTENT, LMaxTextWidth, 0 );
end ;
{ TplListBox }
// =============================================================================
// WM_NCCALCSIZEメッセージ処理
// 垂直と水平スクロールバーを強制的に表示するスタイルに変更
// =============================================================================
procedure TplListBox.WMNCCalcSize(var Message: TWMNCCalcSize);
var
LStyle : Integer;
begin
LStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, LStyle or WS_VSCROLL or WS_HSCROLL);
inherited ;
end ;
end .
02_ TListBox のスクロールバーを常に表示 - コンポの置き換え
実行時に,継承クラス (コンポーネント) を,フォームに配置したコンポーネントと入れ換えてテストするサンプルです.
実行結果は,上のサンプルと全く同じです.
図4
設計時の画面
リスト2
TListBox の水平スクロールバーと垂直スクロールバーを常に表示
実行時に TListBox の継承クラス (コンポーネント) を置き換える例
copy code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TplListBox = class (TListBox)
protected
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
end ;
TForm1 = class (TForm)
Panel1: TPanel;
Button1: TButton;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private 宣言 }
plListBox1 : TplListBox;
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
uses
plChgCompo;
{$R *.dfm}
// =============================================================================
// フォーム作成時の処理
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
begin
Panel1.Caption := '' ;
// フォーム作成時にコンポーネントの入れ替え
plListBox1 := TplListBox(ChangeComponent(ListBox1, TplListBox));
// テスト用のデータをセット
plListBox1.Items.BeginUpdate;
for i:=0 to 19 do begin
plListBox1.Items.Add(Format(' %.6d' ,[i + 1 ])+ ' - 00000000000000000000' );
end ;
plListBox1.Items.EndUpdate;
end ;
// =============================================================================
// フォームが表示される時の処理
// 横スクロールバーを表示するコードを実行
// LB_SETHORIZONTALEXTENTメッセージ処理はOnCreateでは実行しないこと
// =============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
i : Integer;
LMaxTextWidth : Integer;
LTextWidth : Integer;
begin
// TListBoxのCanvasのフォントをTListBoxと同じにする
plListBox1.Canvas.Font.Assign(plListBox1.Font);
// Itemの文字列の長さの最大値を取得
LMaxTextWidth := 0 ;
for i := 0 to plListBox1.Items.Count - 1 do begin
LTextWidth := plListBox1.Canvas.TextWidth(plListBox1.Items[i]);
if (LMaxTextWidth < LTextWidth) then begin
LMaxTextWidth := LTextWidth;
end ;
end ;
// スクロールして全部見えるように,1文字分多くしておく
LMaxTextWidth := LMaxTextWidth + plListBox1.Canvas.TextWidth('W' );
// 横スクロールのスクロール長を設定
// この長さよりクライアント領域の幅が短ければスクロールバーが表示される
plListBox1.Perform(LB_SETHORIZONTALEXTENT, LMaxTextWidth, 0 );
end ;
{ TplListBox }
// =============================================================================
// WM_NCCALCSIZEメッセージ処理
// 垂直と水平スクロールバーを強制的に表示するスタイルに変更
// =============================================================================
procedure TplListBox.WMNCCalcSize(var Message: TWMNCCalcSize);
var
LStyle : Integer;
begin
LStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, LStyle or WS_VSCROLL or WS_HSCROLL);
inherited ;
end ;
end .
03_ TListBox のスクロールバーを常に非表示
WM_NCCALCSIZE メッセージ処理内で,LStyle or WS_VSCROLL の部分を LStyle and not WS_VSCROLL とすると,垂直スクロールバーを常に表示しないようにできます.
その動作確認用のサンプルです.ここでは,水平,垂直スクロールバーの両方を非表示にします.
図5
設計時の画面
図6
実行画面
リスト3
TListBox のスクロールバーを常に非表示にする
copy code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TplListBox = class (TListBox)
protected
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
end ;
TForm1 = class (TForm)
Panel1: TPanel;
Button1: TButton;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
plListBox1 : TplListBox;
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
uses
plChgCompo,
StrUtils;
{$R *.dfm}
// =============================================================================
// フォーム作成時の処理
// DupeStringの使用にはusesにStrUtilsが必要
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
LText1 : String ;
LText2 : String ;
begin
Panel1.Caption := '' ;
// フォーム作成時にコンポーネントの入れ替え
plListBox1 := TplListBox(ChangeComponent(ListBox1, TplListBox));
// テスト用のデータをセット
plListBox1.Items.BeginUpdate;
for i:=0 to 19 do begin
LText1 := Format('%.6d' ,[i + 1 ]);
LText2 := ' ' + LText1 + ' - ' + DupeString(Trim(LText1), 9 );
plListBox1.Items.Add(LText2);
end ;
plListBox1.Items.EndUpdate;
end ;
{ TplListBox }
// =============================================================================
// WM_NCCALCSIZEメッセージ処理
// 垂直と水平スクロールバーを強制的に非表示するスタイルに変更
// =============================================================================
procedure TplListBox.WMNCCalcSize(var Message: TWMNCCalcSize);
var
LStyle : Integer;
begin
LStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, LStyle and not WS_VSCROLL and not WS_HSCROLL);
inherited ;
end ;
end .
04_ TListBox のスクロールバーの無効化表示
TListBox のスクロールバーを,単に,常に表示するようにしても,スクロールバーの操作が不可の状態になっても,無効化の表示にはなりません.
本サンプルは,TListBox のクライアント領域にデータが全て表示できているかどうかを判定して,水平,垂直スクロールバーの無効化の設定を行います.無効化,有効化の設定には,EnableScrollBar 関数を使用しています.
TListBox のリサイズ,アイテムの追加,挿入,削除によって有効,無効の判定が必要です.その処理をメッセージの受信で行っています.アイテムの高さの変更,フォントの変更に対応する処理も追加してみました.
[備考]
TListBox のメッセージとして,MSDN の [List Box Messages] の記事に LB_XXXX という形式がありますが,これらのメッセージは,情報の取得や設定に使用するメッセージです.これらのメッセージを受信するには,本サンプルのように,LB_XXX 受信用のプロシージャーを実装します.
これらのメッセージのプロシージャーは,VCL には実装されていません.したがって,コード補完の入力支援の機能は使えません.
図7
設計時の画面
図8
実行開始時の画面
図9
Button1 をクリック
全ての項目のテキストの長さが短くなる
水平スクロールバーが無効化の状態になる
図10
垂直方向(縦方向) にリサイズ
TListBox に表示しているデータ行数分が全て表示されている状態
垂直スクロールバーが無効化の状態になる
リスト4
TListBox の水平,垂直スクロールバーの無効化表示
copy code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TplListBox = class (TListBox)
private
FMaxTextWidth : Integer;
FMaxTextIndex : Integer;
FMarginWidth : Integer;
procedure Available_Disable_ScrollBars;
procedure LBAddString(var Message: TMessage); message LB_ADDSTRING;
procedure LBInsertString(var Message: TMessage); message LB_INSERTSTRING;
procedure LBDeleteString(var Message: TMessage); message LB_DELETESTRING;
procedure LBSetItemHeight(var Message: TMessage); message LB_SETITEMHEIGHT;
procedure SetMaxTextWidth;
protected
procedure Resize; override ;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure CMFontchange(var Message: TMessage); message CM_FONTCHANGED;
public
constructor Create(AOwner: TComponent); override ;
end ;
TForm1 = class (TForm)
Panel1: TPanel;
Button1: TButton;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
plListBox1 : TplListBox;
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
uses
StrUtils,
plChgCompo;
{$R *.dfm}
// =============================================================================
// フォーム作成時の処理
// DupeStringの使用にはusesにStrUtilsが必要
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
LText1 : String ;
LText2 : String ;
begin
Panel1.Caption := '' ;
// フォーム作成時にコンポーネントの入れ替え
plListBox1 := TplListBox(ChangeComponent(ListBox1, TplListBox));
// テスト用のデータをセット
plListBox1.Items.BeginUpdate;
for i:= 0 to 19 do begin
LText1 := Format('%.6d' ,[i + 1 ]);
LText2 := ' ' + LText1 + ' - ' + DupeString(Trim(LText1), 9 );
plListBox1.Items.Add(LText2);
end ;
plListBox1.Items.EndUpdate;
end ;
// =============================================================================
// 全ての文字列を短くしてみる
// 水平スクロールバーの無効化の確認用
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
i : Integer;
LText1 : String ;
begin
for i := 0 to plListBox1.Items.Count - 1 do begin
LText1 := Format('%.6d' ,[i + 1 ]);
plListBox1.Items[i] := ' ' + LText1 + ' - ' + LText1 + LText1;
end ;
end ;
{ TplListBox }
// =============================================================================
// コントラクタ
// =============================================================================
constructor TplListBox.Create(AOwner: TComponent);
begin
inherited ;
FMaxTextWidth := 0 ;
FMaxTextIndex := -1 ;
FMarginWidth := 0 ;
end ;
// =============================================================================
// TplListBoxのResizeメソッド
// リサイズされると自動的に実行されるメソッド
// =============================================================================
procedure TplListBox.Resize;
begin
inherited ;
Available_Disable_ScrollBars;
end ;
// -----------------------------------------------------------------------------
// LB_ADDSTRING(文字列の追加)メッセージ処理
// -----------------------------------------------------------------------------
procedure TplListBox.LBAddString(var Message: TMessage);
var
LText : String ;
LWidth : Integer;
begin
inherited ;
Canvas.Font.Assign(Self.Font);
FMarginWidth := Canvas.TextWidth('W' );
LText := PChar(Message.LParam);
LWidth := Canvas.TextWidth(LText) + FMarginWidth;
if LWidth > FMaxTextWidth then begin
FMaxTextWidth := LWidth;
FMaxTextIndex := Count - 1 ;
Perform(LB_SETHORIZONTALEXTENT, FMaxTextWidth, 0 );
end ;
Available_Disable_ScrollBars;
end ;
// -----------------------------------------------------------------------------
// LB_INSERTSTRING(文字列の挿入)メッセージ処理
// アイテムの文字列を変更した時も受信可能
// -----------------------------------------------------------------------------
procedure TplListBox.LBInsertString(var Message: TMessage);
var
LIndex : Integer;
LText : String ;
LWidth : Integer;
begin
inherited ;
Canvas.Font.Assign(Self.Font);
FMarginWidth := Canvas.TextWidth('W' );
LIndex := Message.LParam;
LText := PChar(LIndex);
LWidth := Canvas.TextWidth(LText) + FMarginWidth;
if LWidth > FMaxTextWidth then begin
FMaxTextWidth := LWidth;
FMaxTextIndex := LIndex;
Perform(LB_SETHORIZONTALEXTENT, FMaxTextWidth, 0 );
end ;
Available_Disable_ScrollBars;
end ;
// -----------------------------------------------------------------------------
// LB_DELETESTRING(文字列の削除)メッセージの処理
// -----------------------------------------------------------------------------
procedure TplListBox.LBDeleteString(var Message: TMessage);
var
LText : String ;
LWidth : Integer;
begin
// 削除前のテキストを取得するためにinheritedの前で取得
LText := Items[Message.WParam];
inherited ;
LWidth := Canvas.TextWidth(LText) + FMarginWidth;
if LWidth >= FMaxTextWidth then begin
SetMaxTextWidth;
end ;
Available_Disable_ScrollBars;
end ;
// -----------------------------------------------------------------------------
// LB_SETITEMHEIGHT(アイテムの高さ変更)メッセージの処理
// -----------------------------------------------------------------------------
procedure TplListBox.LBSetItemHeight(var Message: TMessage);
begin
inherited ;
Available_Disable_ScrollBars;
end ;
// -----------------------------------------------------------------------------
// CM_FONTCHANGED(フォントの変更)メッセージの処理
// スクロール長さの値を変更する
// -----------------------------------------------------------------------------
procedure TplListBox.CMFontchange(var Message: TMessage);
begin
inherited ;
if FMaxTextIndex < 0 then exit;
Canvas.Font.Assign(Self.Font);
FMarginWidth := Canvas.TextWidth('W' );
FMaxTextWidth := Canvas.TextWidth(Items[FMaxTextIndex]) + FMarginWidth;
Perform(LB_SETHORIZONTALEXTENT, FMaxTextWidth, 0 );
Available_Disable_ScrollBars;
end ;
// -----------------------------------------------------------------------------
// 表示するテキストの最大長さ(ピクセル数)を取得してスクロール長を設定
// -----------------------------------------------------------------------------
procedure TplListBox.SetMaxTextWidth;
var
i : Integer;
LWidth : Integer;
begin
FMaxTextWidth := 0 ;
for i := 0 to Items.Count - 1 do begin
LWidth := Canvas.TextWidth(Items[i]) + FMarginWidth;
if (FMaxTextWidth < LWidth) then begin
FMaxTextWidth := LWidth;
FMaxTextIndex := i;
end ;
end ;
// 横スクロールのスクロール長を設定
// この長さよりクライアント領域の幅が短ければスクロールバーが有効化される
Perform(LB_SETHORIZONTALEXTENT, FMaxTextWidth, 0 );
end ;
// -----------------------------------------------------------------------------
// スクロールバーの有効化表示と無効化表示の制御用メソッド
// -----------------------------------------------------------------------------
procedure TplListBox.Available_Disable_ScrollBars;
begin
// 垂直スクロールバー
if (Items.Count * ItemHeight) < ClientHeight then begin
EnableScrollBar(Handle, SB_VERT, ESB_DISABLE_BOTH);
end else begin
EnableScrollBar(Handle, SB_VERT, ESB_ENABLE_BOTH);
end ;
// 水平スクロールバー
if FMaxTextWidth < ClientWidth then begin
EnableScrollBar(Handle, SB_HORZ, ESB_DISABLE_BOTH);
end else begin
EnableScrollBar(Handle, SB_HORZ, ESB_ENABLE_BOTH);
end ;
end ;
// =============================================================================
// WM_NCCALCSIZEメッセージ処理
// 垂直と水平スクロールバーを強制的に表示するスタイルに変更
// =============================================================================
procedure TplListBox.WMNCCalcSize(var Message: TWMNCCalcSize);
var
LStyle : Integer;
begin
LStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, LStyle or WS_VSCROLL or WS_HSCROLL);
inherited ;
end ;
end .
05_ TListBox のスクロールバーのコンテキストメニュー
TListBox のスクロールバー上で,マウスの右ボタンをクリックすると,下図のようなコンテキストメニューが現れます.このコンテキストメニューを表示しないようにする方法です.
コンテキストメニューが表示する際,WM_CONTEXTMENU メッセージが発生します.このメッセージ処理内で何もしなければコンテキストメニューは現れません.何もしないと,TListBox で TPopupMenue コンポーネント等を使用していると,そのポップアップメニューも表示しなくなってしまいます.
そこで,マウスクリックの位置が,TListBox のクライアント領域の時は,WM_CONTEXTMENU メッセージ本来の処理を実行するようにしています.
図11
スクロールバーのコンテキストメニュー
リスト5
TListBox のスクロールバーのコンテキストメニューを表示しないようにする
copy code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus;
type
TplListBox = class (TListBox)
protected
procedure WMContextMenu(var Message: TWMContextMenu);
message WM_CONTEXTMENU;
end ;
TForm1 = class (TForm)
Panel1: TPanel;
Button1: TButton;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
plListBox1 : TplListBox;
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
uses
plChgCompo,
Types;
{$R *.dfm}
// =============================================================================
// フォーム作成時の処理
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
begin
Panel1.Caption := '' ;
// フォーム作成時にコンポーネントの入れ替え
plListBox1 := TplListBox(ChangeComponent(ListBox1, TplListBox));
// テスト用のデータをセット
plListBox1.Items.BeginUpdate;
for i:=0 to 19 do begin
plListBox1.Items.Add(Format(' %.6d' ,[i + 1 ])+ ' - 00000000000000000000' );
end ;
plListBox1.Items.EndUpdate;
end ;
{ TplListBox }
// =============================================================================
// WM_CONTEXTMENUメッセージ処理
// スクロールバーのコンテキストメニューを表示しないようにする
// =============================================================================
procedure TplListBox.WMContextMenu(var Message: TWMContextMenu);
var
LPos : TPoint;
begin
LPos := ScreenToClient(Point(Message.XPos, Message.YPos));
if PtInRect(ClientRect, LPos) then begin
inherited ;
end else begin
Message.Result := 0 ;
end ;
end ;
end .