Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2015年07月20日] [更新 2020年02月10日]　Delphi サンプルプログラム集
070_TStringGrid のスクロールバー制御
動作確認等 Windows 7 U64(SP1) + Delphi XE5(UP2) Pro VCL-32
070_TStringGrid_ScrollBar.zip　[7,432 KB]　2020年02月10日版 (EXE 同梱)






TStringGrid のスクロールバー制御


TStrinGrid のスクロールバーの設定関係のサンプルです．

TStringGrid のスクロールバーの表示は，ScrollBars プロパティで設定できますが，スクロールバーを表示する設定にしても，TStringGrid のクライアント領域内に全てのデータが表示されている場合は表示しません．これを強制的に表示するテストをしてみました．また，クライアント領域に全てのデータが表示されてる場合は，スクロールバーを無効化の状態にするテストもしています．

本ページのサンプルでは，継承クラスをコンポーネントとして登録 (インストール) しないで，[派生元のコンポーネントと交換する方法] で説明しているユニットを使用しています．






01_TStringGrid のスクロールバーの基本動作確認用テスト


本ページのサンプル作成のために，最初に作成したテストプログラムです．
スクロール長が MaxShortInt の値である 127 であることが分かります．水平スクロールバー (横スクロールバー) も同じです．この値は，行数や列数を変更しても常に 127 となります．
また，TScrollInfo.nPage の値，つまり，スクロールのページサイズの値が 0 になっています．このページサイズの値は，スクロールボックス (つまみ) の値です．




図1
マウスで下端までスクロールする
  • Range の値は 常に 0
  • スクロール長は 127 (MaxShortInt の値)

図2
クライアントの高さを高くして下端までスクロール
  • 下端のスクロール位置は 127
  • この値は行数を変えても同じ

リスト1
TStringGrid のスクロールバーの基本動作確認用テスト		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls,
  Vcl.ExtCtrls;

type
  TplStringGrid = class(TStringGrid)
  protected
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    StringGrid1: TStringGrid;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    plStringGrid1 : TplStringGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォームのOnCreateイベント処理
//  すぐにテストできるように，列数と列幅等を設定し，データをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  //フォーム作成時にコンポーネントの入れ替え
  plStringGrid1 := TplStringGrid(ChangeComponent(StringGrid1, TplStringGrid));

  plStringGrid1.Options := plStringGrid1.Options + [goDrawFocusSelected];
  plStringGrid1.Options := plStringGrid1.Options + [goThumbTracking];
  plStringGrid1.Options := plStringGrid1.Options + [goRowSizing];
  plStringGrid1.Options := plStringGrid1.Options + [goColSizing];

  plStringGrid1.ScrollBars := ssBoth;

  plStringGrid1.ColCount        := 10;
  plStringGrid1.FixedCols       := 1;
  plStringGrid1.FixedRows       := 1;
  plStringGrid1.DefaultColWidth := 70;
  plStringGrid1.RowCount        := 20 + plStringGrid1.FixedRows;

  //左端の列幅設定
  plStringGrid1.ColWidths[0] := 30;
  //スクロールした状態を把握するために，左端の列に番号を表示しておく
  for i := 1 to plStringGrid1.RowCount - 1 do begin
    plStringGrid1.Cells[0, i] := IntToStr(i);
  end;

  //固定行に文字列を描画
  for i := StringGrid1.FixedRows to StringGrid1.ColCount - 1 do begin
    StringGrid1.Cols[i].Text := 'COL-' + IntToStr(i);
  end;
end;

//=============================================================================
//  行数と列数を変えてテストしてみる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  i : Integer;
begin
  StringGrid1.RowCount := 31;
  for i := 1 to plStringGrid1.RowCount - 1 do begin
    plStringGrid1.Cells[0, i] := IntToStr(i);
  end;
  StringGrid1.ColCount := 5;
end;

{ TplStringGrid }

//=============================================================================
//  WM_VSCROLLメッセージ処理
//=============================================================================
procedure TplStringGrid.WMVScroll(var Message: TWMVScroll);
var
  LScrollInfo : TScrollInfo;
begin
  inherited;

  LScrollInfo.cbSize := SizeOf(LScrollInfo);
  FillChar(LScrollInfo, SizeOf(LScrollInfo), #0);

  LScrollInfo.cbSize := SizeOf(LScrollInfo);
  LScrollInfo.fMask  := SIF_ALL;
  GetScrollInfo(Handle, SB_VERT, LScrollInfo);

  Form1.Memo1.Lines.BeginUpdate;
  Form1.Memo1.Lines.Clear;
  Form1.Memo1.Lines.Add('       nMin : ' + IntToStr(LScrollInfo.nMin));
  Form1.Memo1.Lines.Add('       nMax : ' + IntToStr(LScrollInfo.nMax));
  Form1.Memo1.Lines.Add('      nPage : ' + IntToStr(LScrollInfo.nPage));
  Form1.Memo1.Lines.Add('  nTrackPos : ' + IntToStr(LScrollInfo.nTrackPos));
  Form1.Memo1.Lines.Add('  ScrollPos : ' + IntToStr(Message.Pos));
  Form1.Memo1.Lines.EndUpdate;
end;

//=============================================================================
//  WM_HSCROLLメッセージ処理
//=============================================================================
procedure TplStringGrid.WMHScroll(var Message: TWMHScroll);
var
  LScrollInfo : TScrollInfo;
begin
  inherited;

  LScrollInfo.cbSize := SizeOf(LScrollInfo);
  FillChar(LScrollInfo, SizeOf(LScrollInfo), #0);

  LScrollInfo.cbSize := SizeOf(LScrollInfo);
  LScrollInfo.fMask  := SIF_ALL;
  GetScrollInfo(Handle, SB_HORZ, LScrollInfo);

  Form1.Memo1.Lines.BeginUpdate;
  Form1.Memo1.Lines.Clear;
  Form1.Memo1.Lines.Add('       nMin : ' + IntToStr(LScrollInfo.nMin));
  Form1.Memo1.Lines.Add('       nMax : ' + IntToStr(LScrollInfo.nMax));
  Form1.Memo1.Lines.Add('      nPage : ' + IntToStr(LScrollInfo.nPage));
  Form1.Memo1.Lines.Add('  nTrackPos : ' + IntToStr(LScrollInfo.nTrackPos));
  Form1.Memo1.Lines.Add('  ScrollPos : ' + IntToStr(Message.Pos));
  Form1.Memo1.Lines.EndUpdate;
end;

end.



02_TStringGrid のスクロールバーを常に表示して無効化機能を追加


TStringGrid の継承クラス (コンポーネント) を作成して，WM_NCCALCSIZE メッセージ処理内で強制的に TStringGrid のスタイルに WS_HSCROLL と WS_VSCROLL を追加して，スクロールバーを常に表示するようにしたサンプルです．
WM_NCCALCSIZE メッセージは，ウィンドウが生成された場合や TWinControl.RecreateWnd で再生成された場合に発生します．このことを利用しています．

この変更をすると，ScrollBars プロパティの値を ssNone にしても，垂直スクロールバーを非表示にすることはできません．

本サンプルでは，データが TStringGrid のクライアント領域に全て表示されている場合は，スクロールバーの表示を無効化状態にするコードを追加しています．また，行または列の追加と削除，行の高さの変更と列幅の変更にも対応してみました．



図3
設計時の画面
図4
実行開始画面
図5
フォームをリサイズ
  • TStringGrid コンポーネントの高さがデータ領域よりも大きい場合
  • 垂直スクロールバーが見えているが，スクロール操作はできない無効化の状態になる
図6
Button2 をクリックして列を削除
  • TStringGrid コンポーネントの幅がデータ領域よりも広い場合
  • 水平スクロールバーが見えているが，スクロール操作はできない無効化の状態になる

リスト2
TStringGrid スクロールバーを常に表示して，無効化の機能を追加		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls,
  Vcl.ExtCtrls;

type
  TplStringGrid = class(Vcl.Grids.TStringGrid)
  protected
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure Resize; override;
    procedure ColWidthsChanged; override;
    procedure RowHeightsChanged; override;
    procedure SizeChanged(OldColCount: Integer; OldRowCount: Integer); override;
  public
    procedure Available_Disable_ScrollBars;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    StringGrid1: TStringGrid;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    plStringGrid1 : TplStringGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォームのOnCreateイベント処理
//  すぐにテストできるように，列数と列幅等を設定し，データをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  //フォーム作成時にコンポーネントの入れ替え
  plStringGrid1 := TplStringGrid(ChangeComponent(StringGrid1, TplStringGrid));

  plStringGrid1.Options := plStringGrid1.Options + [goDrawFocusSelected];
  plStringGrid1.Options := plStringGrid1.Options + [goThumbTracking];
  plStringGrid1.Options := plStringGrid1.Options + [goRowSizing];
  plStringGrid1.Options := plStringGrid1.Options + [goColSizing];

  plStringGrid1.ColCount        := 10;
  plStringGrid1.FixedCols       := 1;
  plStringGrid1.FixedRows       := 1;
  plStringGrid1.DefaultColWidth := 70;
  plStringGrid1.RowCount        := 20 + plStringGrid1.FixedRows;

  //左端の列幅設定
  plStringGrid1.ColWidths[0] := 30;
  //スクロールした状態を把握するために，左端の列に番号を表示しておく
  for i := 1 to plStringGrid1.RowCount - 1 do begin
    plStringGrid1.Cells[0, i] := IntToStr(i);
  end;

  //固定行に文字列を描画
  for i := StringGrid1.FixedRows to StringGrid1.ColCount - 1 do begin
    StringGrid1.Cols[i].Text := 'COL-' + IntToStr(i);
  end;
end;

//=============================================================================
//  TStringGridの行数を変更した時の動作確認用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  i      : Integer;
  iRowNo : Integer;
begin
  plStringGrid1.RowCount := 10 + plStringGrid1.FixedRows;

  //スクロールした状態を把握するために，左端の列に番号を表示しておく
  for i := plStringGrid1.FixedRows to plStringGrid1.RowCount - 1 do begin
    iRowNo := i - plStringGrid1.FixedRows + 1;
    plStringGrid1.Cells[0, i] := IntToStr(iRowNo);
  end;
  plStringGrid1.td-date := plStringGrid1.FixedRows;

  //行または列の追加のときはこのメソッドを実行する
  plStringGrid1.Available_Disable_ScrollBars;
end;

//=============================================================================
//  列の削除(列の数を少なくして動作を確認するため)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if plStringGrid1.ColCount >= 4 then begin
    plStringGrid1.DeleteColumn(plStringGrid1.ColCount);
  end;
end;

{ TplStringGrid }

//-----------------------------------------------------------------------------
//  垂直スクロールバーと水平スクロールバーの無効化を設定するメソッド
//  行または列を追加したらこのメソッドを外部から実行する
//-----------------------------------------------------------------------------
procedure TplStringGrid.Available_Disable_ScrollBars;
var
  LRealVisbleRows : Integer;
  LRealVisbleCols : Integer;
begin
  //垂直スクロールバーの無効化の設定
  LRealVisbleRows := VisibleRowCount + FixedRows;
  if LRealVisbleRows = RowCount then begin
    EnableScrollBar(Handle, SB_VERT, ESB_DISABLE_BOTH);
  end else begin
    EnableScrollBar(Handle, SB_VERT, ESB_ENABLE_BOTH);
  end;


  //水平スクロールバーの無効化の設定
  LRealVisbleCols := VisibleColCount + FixedCols;
  if LRealVisbleCols = ColCount then begin
    EnableScrollBar(Handle, SB_HORZ, ESB_DISABLE_BOTH);
  end else begin
    EnableScrollBar(Handle, SB_HORZ, ESB_ENABLE_BOTH);
  end;
end;

//=============================================================================
//  Resizeメソッド処理
//  リサイズされると自動的に実行されるメソッド
//=============================================================================
procedure TplStringGrid.Resize;
begin
  inherited;
  Available_Disable_ScrollBars;
end;

//=============================================================================
//  行の高さを変更すると発生するメソッドの処理
//=============================================================================
procedure TplStringGrid.RowHeightsChanged;
begin
  inherited;
  Available_Disable_ScrollBars;
end;

//=============================================================================
//  カラム(列)の幅を変更すると発生するメソッドの処理
//=============================================================================
procedure TplStringGrid.ColWidthsChanged;
begin
  inherited;
  Available_Disable_ScrollBars;
end;

//=============================================================================
//  TplStringGrid の行または列の数が変更された時の処理
//=============================================================================
procedure TplStringGrid.SizeChanged(OldColCount, OldRowCount: Integer);
begin
  inherited;
  Available_Disable_ScrollBars;
end;

//=============================================================================
//  TStringGirdのWM_NCCALCSIZEメッセージ処理
//  スクロールバー表示のスタイルを強制的に変更
//  以下のコードを実行すると，ScrollBarsによる設定は無効になる
//=============================================================================
procedure TplStringGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  LStyle : Integer;
begin
  LStyle := GetWindowLong(Handle, GWL_STYLE);
  SetWindowLong(Handle, GWL_STYLE, LStyle or WS_HSCROLL or WS_VSCROLL);

  inherited;
end;

end.



03_TStringGrid のスクロールボックス ( つまみ ) のサイズを設定


上のサンプルでは，スクロールボックス (つまみ) のサイズは設定していません．
このスクロールボックスのサイズを変更するサンプルです．ただし，垂直スクロールバーだけの制御となっています．

スクロールボックスのサイズは，一般的にはページサイズの値です．この値を SetScrollInfo 関数を使用して設定しています．
TStringGrid のスクロールバーのスクロール長さは MaxShortInt (= 127) の固定です．スクロール長を変更しても TStringGrid が内部で MaxShortInt の値に応じた処理をするようになっています．
したがって，スクロールボックスのサイズは，これに見合った値に設定する必要があります．

実行してみると，下図のように，スクロールバーを下端までドラッグしても，最終行が見えません．実用的には問題がありそうです．
TStringGrid のスクロールバーのスクロール長は，常に MaxShortInt の値です．それを強引にスクロールボックスの値を変更しているわけですから，スクロール位置は，最大値の MaxShortInt の値にはなりません．当然と言えば当然なのですが，この現象を回避するには，スクロール長を変更できない限り難しいように思われます．

スクロール長を変更するテストもしてみましたが，MaxShortInt の値に戻されてしまいます．
TStringGrid の内部処理を変更するか，スクロールメッセージ等の処理が必要と思われますが，ここではこれ以上追及しないことにします．
興味のある方は，Grids ユニット内の MaxShortInt を追いかけてみてください．




図7
設計時の画面 実行してスクロールボックスを下端まで移動

図8
実行してスクロールボックスを下端まで移動
  • データの行は 20 行あるが，最後までスクロールできていない

リスト3
TStringGrid のスクロールボックス (つまみ) のサイズを設定		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls,
  Vcl.ExtCtrls;

type
  TplStringGrid = class(Vcl.Grids.TStringGrid)
  protected
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure Resize; override;
  public
    procedure Available_Disable_ScrollBars;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    plStringGrid1 : TplStringGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォームのOnCreateイベント処理
//  すぐにテストできるように，列数と列幅等を設定し，データをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  //フォーム作成時にコンポーネントの入れ替え
  plStringGrid1 := TplStringGrid(ChangeComponent(StringGrid1, TplStringGrid));

  plStringGrid1.Options := plStringGrid1.Options + [goDrawFocusSelected];
  plStringGrid1.Options := plStringGrid1.Options + [goThumbTracking];
  plStringGrid1.Options := plStringGrid1.Options + [goRowSizing];
  plStringGrid1.Options := plStringGrid1.Options + [goColSizing];

  plStringGrid1.ColCount        := 10;
  plStringGrid1.FixedCols       := 1;
  plStringGrid1.FixedRows       := 1;
  plStringGrid1.DefaultColWidth := 70;
  plStringGrid1.RowCount        := 20 + plStringGrid1.FixedRows;

  //左端の列幅設定
  plStringGrid1.ColWidths[0] := 30;
  //スクロールした状態を把握するために，左端の列に番号を表示しておく
  for i := 1 to plStringGrid1.RowCount - 1 do begin
    plStringGrid1.Cells[0, i] := IntToStr(i);
  end;

  //固定行に文字列を描画
  for i := StringGrid1.FixedRows to StringGrid1.ColCount - 1 do begin
    StringGrid1.Cols[i].Text := 'COL-' + IntToStr(i);
  end;
end;

//=============================================================================
//  TStringGridの行数を変更した時の動作確認用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  i      : Integer;
  iRowNo : Integer;
begin
  plStringGrid1.RowCount := 10 + plStringGrid1.FixedRows;

  //スクロールした状態を把握するために，左端の列に番号を表示しておく
  for i := plStringGrid1.FixedRows to plStringGrid1.RowCount - 1 do begin
    iRowNo := i - plStringGrid1.FixedRows + 1;
    plStringGrid1.Cells[0, i] := IntToStr(iRowNo);
  end;
  plStringGrid1.td-date := plStringGrid1.FixedRows;

  //行または列の追加のときはこのメソッドを実行する
  plStringGrid1.Available_Disable_ScrollBars;
end;

{ TplStringGrid }

//-----------------------------------------------------------------------------
//  垂直スクロールバーのスクロールボックスサイズと無効化の設定
//-----------------------------------------------------------------------------
procedure TplStringGrid.Available_Disable_ScrollBars;
var
  LRealVisbleRows : Integer;
  LScrollInfo     : TScrollInfo;
begin
  LRealVisbleRows := VisibleRowCount + FixedRows;
  if LRealVisbleRows = RowCount then begin
    EnableScrollBar(Handle, SB_VERT, ESB_DISABLE_BOTH);
  end else begin
    EnableScrollBar(Handle, SB_VERT, ESB_ENABLE_BOTH);

    FillChar(LScrollInfo, SizeOf(TScrollInfo), #0);
    LScrollInfo.cbSize := SizeOf(TSCrollInfo);
    GetScrollInfo(Handle, SB_VERT, LScrollInfo);

    LScrollInfo.fMask  := SIF_PAGE;
    LScrollInfo.nPage  := MaxShortInt * LRealVisbleRows div RowCount;
    SetScrollInfo(Handle, SB_VERT, LScrollInfo, True);
  end;
end;

//=============================================================================
//  Resizeメソッド処理
//  リサイズされると自動的に実行されるメソッド
//=============================================================================
procedure TplStringGrid.Resize;
begin
  inherited;
  Available_Disable_ScrollBars;
end;

//=============================================================================
//  TStringGirdのWM_NCCALCSIZEメッセージ処理
//  スクロールバー表示のスタイルを強制的に変更
//=============================================================================
procedure TplStringGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  LStyle : Integer;
begin
  LStyle := GetWindowLong(Handle, GWL_STYLE);
  SetWindowLong(Handle, GWL_STYLE, LStyle or WS_HSCROLL or WS_VSCROLL);

  inherited;
end;

end.



04_スクロール制御用に TScrollBar を実装した TStringGrid


前項の現象を回避する方法として，スクロールの制御を TScrollBar を配置して行う方法です．
フォーム上に TScrollBar を配置したのではコードが複雑になりますが，TStringGrid の継承クラス (コンポーネント) を作成して， protected 部のメソッド類を使用すれは効率的な処理が可能となります．例えば，行や列の追加や削除，あるいは行の高さの変更や列幅の変更を自動的にに検出して処理できます．
以下は，TScrollBar を実装したコンポーネントの例です．

このコンポーネントは TStringGrid の ScrollBars プロパティの仕様を変更して，ssNone 以外のときは常にスクロールバーを表示するようになっています．例えば ssVertical にすると縦スクロールバーだけを常に表示します．
ScrollBars プロパティの設定は実行時に反映されます．オブジェクト・インスペクタで変更しても表示は変わりません．．



[備考]
垂直スクロールバーのページサイズ，つまり，スクロールバーのボックス (つまみ) のサイズと位置は，行の高さが全て同じと仮定して計算しています．水平スクロールバーは，列の幅が全て同じと仮定した時のクライアント領域の表示幅に相当する列数をボックスのサイズとしています．この設定によって，全列幅のどの程度の範囲が表示されているかを確認できます．




図9
実行時にコンポーネントを生成してテスト

このコンポーネントは，スクロールバーの背景色のプロパティ Color を実装しています． 


  plStringGrid1.VScrollBar.Color := clLime;
  plStringGrid1.HScrollBar.Color := $000984FF;



 図10
スクロールバーの背景色を変更

リスト4
スクロールバーの制御を TScrollBar コンポーネントで行う TStringGrid コンポーネント		 
unit plStrGrid;

interface

uses
  Winapi.Windows, Winapi.Messages, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls,
  Vcl.Grids, System.UITypes, Vcl.Graphics, Vcl.Dialogs, System.SysUtils;

type
  TplStringGrid = class;

  TplStringGridBar = class(TScrollBar)
  private
    FStrGrid : TplStringGrid;
  protected
    procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); override;
    procedure CNCtlcolorscrollbar(var Message: TMessage);
      message CN_CTLCOLORSCROLLBAR;
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Color;
  end;

  TplStringGrid = class(TStringGrid)
  private
    FVPageSize     : Integer;
    FHPageSize     : Integer;
    FVScrollMax    : Integer;
    FHScrollMax    : Integer;
    FVScrollBar    : TplStringGridBar;
    FHScrollBar    : TplStringGridBar;
    FBottomMargin  : Integer;
    FRightMargin   : Integer;
    FScrollBars    : System.UITypes.TScrollStyle;
    procedure SetScrollBars(Value: TScrollStyle);
    procedure ScrollBarsSetSizePos(ALeft, ATop, AWidth, AHeight: Integer);
    function CalcHorzPageSize: Integer;
  protected
    procedure SetParent(AParent: TWinControl); override;
    procedure Resize; override;
    procedure SizeChanged(OldColCount: Integer; OldRowCount: Integer); override;
    procedure ColWidthsChanged; override;
    procedure RowHeightsChanged; override;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure CMVisiblechanged(var Message: TMessage);
      message CM_VISIBLECHANGED;
    procedure CMEnabledchanged(var Message: TMessage);
      message CM_ENABLEDCHANGED;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure TopLeftChanged; override;
  public
    property VScrollBar : TplStringGridBar read FVScrollBar;
    property HScrollBar : TplStringGridBar read FHScrollBar;
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
      AHeight: Integer); override;
    constructor Create(AOwner: TComponent); override;
  published
    property ScrollBars : TScrollStyle read FScrollBars write SetScrollBars;
  end;

procedure Register;

implementation

{ TplStringGrid }

//=============================================================================
//  コンポーネントのコンストラクタ (生成時) 処理
//=============================================================================
constructor TplStringGrid.Create(AOwner: TComponent);
begin
  inherited;

  ScrollBars  := ssNone;
  FScrollBars := ssBoth;
end;

//=============================================================================
//  SetParent メソッドの処理
//  TScrollBar の継承コンポーネントを生成
//
//  VScrollBar : 縦スクロールバー
//  HScrollBar : 横スクロールバー
//=============================================================================
procedure TplStringGrid.SetParent(AParent: TWinControl);
begin
  inherited;

  if not Assigned(FVScrollBar) then begin
    FVScrollBar := TplStringGridBar.Create(self);
    FVScrollBar.Parent := Parent;
    FVScrollBar.Kind   := sbVertical;

    FHScrollBar := TplStringGridBar.Create(Self);
    FHScrollBar.Parent := Parent;
    FHScrollBar.Kind   := sbHorizontal;

    FRightMargin  := FVScrollBar.Width;
    FBottomMargin := FHScrollBar.Height;

    ScrollBarsSetSizePos(Left, Top, Width, Height);
  end;
end;

//-----------------------------------------------------------------------------
//  ScrollBars プロパティの独自実装
//  ssNone 以外は常に表示となる
//  ex. ssVertical にすると縦スクロールバーだけが常に表示となる
//-----------------------------------------------------------------------------
procedure TplStringGrid.SetScrollBars(Value: TScrollStyle);
begin
  if not Assigned(FVScrollBar) then Exit;

  if Value <> FScrollBars then begin
    FScrollBars := Value;
    FVScrollBar.Visible := (Value = ssBoth) or (Value = ssVertical);
    FHScrollBar.Visible := (Value = ssBoth) or (Value = ssHorizontal);

    RecreateWnd;
    ScrollBarsSetSizePos(Left, Top, Width, Height);
  end;
end;

//-----------------------------------------------------------------------------
//  スクロールバーの位置を設定
//-----------------------------------------------------------------------------
procedure TplStringGrid.ScrollBarsSetSizePOs(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if Assigned(FVScrollBar) then begin
    FVScrollBar.Top    := ATop;
    FVScrollBar.Left   := ALeft + AWidth - FRightMargin;
    if FHScrollBar.Visible then begin
      FVScrollBar.Height := AHeight - FBottomMargin + 2;
    end else begin
      FVScrollBar.Height := AHeight;
    end;

    FHScrollBar.Top   := ATop + AHeight - FBottomMargin;
    FHScrollBar.Left  := ALeft;
    if FVScrollBar.Visible then begin
      FHScrollBar.Width := AWidth - FRightMargin + 2;
    end else begin
      FHScrollBar.Width := AWidth;
    end;
  end;
end;

//=============================================================================
//  このコンポの位置やサイズが変更された時の処理
//  スクロールバーの位置とサイズを設定し直す必要がある
//
//  SetBounds はコントロールの位置やサイズが変更された時に自動的に実行される
//  この後に自動的に Resize メソッドが実行される
//=============================================================================
procedure TplStringGrid.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;
  ScrollBarsSetSizePos(ALeft, ATop, AWidth, AHeight);
end;

//-----------------------------------------------------------------------------
//  列方向のスクロールのページサイズの計算
//  全ての列幅が同じと仮定した時に(ClientWidth - 固定列の合計ピクセル数)
//  に表示可能な列数をページサイズとする
//-----------------------------------------------------------------------------
function TplStringGrid.CalcHorzPageSize: Integer;
var
  LColWidth : Integer;
  LFixedW   : Integer;
  LDblWidth : Double;
  LWidth    : Integer;
  LIndex    : Integer;
begin
  LColWidth := 0;
  for LIndex := FixedCols to ColCount - 1 do begin
    if ColWidths[LIndex] > 0 then begin
      LColWidth := LColWidth + ColWidths[LIndex];
    end;
  end;
  LFixedW := 0;
  for LIndex := 0 to FixedCols - 1 do begin
    if ColWidths[LIndex] > 0 then begin
      LFixedW := LFixedW + ColWidths[LIndex];
    end;
  end;
  if ClientWidth > (LColWidth + LFixedW) then begin
    LWidth := LColWidth;
  end else begin
    LWidth := ClientWidth - LFixedW;
  end;

  LDblWidth := (ColCount - FixedCols) * LWidth / LColWidth;
  Result := Trunc(LDblWidth);
end;

//=============================================================================
//  TplStringGrid のサイズが変更された時の処理
//  スクロールバーのスクロールボックス(つまみ)のサイズとその位置を設定し直す
//  スクロールバーのサイズの設定は SetBounds メソッドで自動実行する
//  コンポのサイズ変更時は最初に SetBounds メソッドが実行される
//=============================================================================
procedure TplStringGrid.Resize;
var
  LOldVPos : Integer;
  LOldHPos : Integer;
begin
  inherited;
  if not Assigned(FVScrollBar) then Exit;

  LOldVPos := FVScrollBar.Position;
  LOldHPos := FHScrollBar.Position;

  //-----------------------------------
  //  垂直スクロールバー関係の設定
  //-----------------------------------
  FVScrollMax := RowCount - FixedRows;

  if (VisibleRowCount = FVScrollMax) or (FVScrollMax <= 1) then begin
    // 列数が少ない場合
    FVScrollBar.Enabled  := False;
    FVScrollBar.Position := 0;
  end else begin
    FVScrollBar.Enabled := True;

    // PageSizeを先に設定する
    FVPageSize := VisibleRowCount;

    // 0 ベースとしての設定
    FVScrollBar.PageSize    := FVPageSize;
    if (FVScrollMax < 3) or (FVPageSize < 2) then begin
      FVScrollBar.LargeChange := 1;
    end else begin
      FVScrollBar.LargeChange := FVPageSize - 1;
    end;
    FVScrollBar.SmallChange := 1;
    FVScrollBar.Min         := 0;
    FVScrollBar.Max         := FVScrollMax - 1;

    FVScrollBar.Position := LOldVPos;
  end;

  //-----------------------------------
  //  水平スクロールバー関係の設定
  //-----------------------------------
  FHScrollMax := ColCount - FixedCols;

  if (VisibleColCount = FHScrollMax) or (FHScrollMax <= 1) then begin
    // 列数が少ない場合
    FHScrollBar.Enabled  := False;
    FHScrollBar.Position := 0;
  end else begin
    FHScrollBar.Enabled := True;

    // PageSizeを先に設定する
    FHPageSize := CalcHorzPageSize;

    // 0 ベースとしての設定
    FHScrollBar.PageSize    := FHPageSize;
    if (FHScrollMax < 3) or (FHPageSize < 2) then begin
      FHScrollBar.LargeChange := 1;
    end else begin
      FHScrollBar.LargeChange := FHPageSize - 1;
    end;
    FHScrollBar.SmallChange := 1;
    FHScrollBar.Min         := 0;
    FHScrollBar.Max         := FHScrollMax - 1;

    FHScrollBar.Position := LOldHPos;
  end;
end;

//=============================================================================
//  行または列の数が変更された時の処理
//  スクロールバーのスクロールボックス(つまみ)のサイズとその位置を設定し直す
//=============================================================================
procedure TplStringGrid.SizeChanged(OldColCount, OldRowCount: Integer);
begin
  // 継承元のメソッドには何の処理もない
  inherited;
  Resize;
end;

//=============================================================================
//  行の高さが変更された時の処理
//  スクロールバーのスクロールボックス(つまみ)のサイズとその位置を設定し直す
//=============================================================================
procedure TplStringGrid.RowHeightsChanged;
begin
  inherited;
  Resize;
end;

//=============================================================================
//  列の幅が変更された時の処理
//  スクロールバーのスクロールボックス(つまみ)のサイズとその位置を設定し直す
//=============================================================================
procedure TplStringGrid.ColWidthsChanged;
begin
  inherited;
  Resize;
end;

//=============================================================================
//  Visible プロパティが変更された時の処理
//=============================================================================
procedure TplStringGrid.CMVisiblechanged(var Message: TMessage);
begin
  inherited;

  if Assigned(FVScrollBar) then begin
    FVScrollBar.Visible := Visible;
    FHScrollBar.Visible := Visible;
  end;
end;

//=============================================================================
//  Enabled プロパティが変更された時の処理
//=============================================================================
procedure TplStringGrid.CMEnabledchanged(var Message: TMessage);
begin
  inherited;

  if Assigned(FVScrollBar) then begin
    FVScrollBar.Enabled := Enabled;
    FHScrollBar.Enabled := Enabled;
  end;
end;

//=============================================================================
//  td-date または LeftCol が変更された時の処理
//=============================================================================
procedure TplStringGrid.TopLeftChanged;
begin
  inherited;

  FVScrollBar.Position := td-date - FixedRows;
  FHScrollBar.Position := LeftCol - FixedCols;
end;

//=============================================================================
//  DoMouseWheel メソッド (OnMouseWheel イベント相当) の処理
//
//  仕様を変更している
//  元の TStringGrid ではキー操作によるスクロールと同じ
//  クライアント領域内ではスクロールしない
//  本コンポでは直ちにスクロールする
//  スクロール量はシステムの設定値を使用
//=============================================================================
function TplStringGrid.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
var
  LDelta : Integer;
  LIndex : Integer;
begin
  SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @LDelta, 0);

  if WheelDelta < 0 then begin
    for LIndex := 0 to LDelta - 1 do begin
      Perform(WM_VSCROLL, MakeWord(SB_LINEDOWN, 0), 0);
    end;
    Result := True;
  end else begin
    for LIndex := 0 to LDelta - 1 do begin
      Perform(WM_VSCROLL, MakeWord(SB_LINEUP, 0), 0);
    end;
    Result := True;
  end;
end;

//-----------------------------------------------------------------------------
//  WM_NCCALCSIZE メッセージ処理
//  スクロールバー表示のスタイルを強制的に変更
//  以下のコードを実行すると元の ScrollBarsによる設定は無効になる
//  本コンポでは ScrollBars プロパティを独自仕様にしている
//-----------------------------------------------------------------------------
procedure TplStringGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  LStyle   : Integer;
  LBMargin : Integer;
  LRMargin : Integer;
  LRect    : TRect;
  LResRect : TRect;
begin
  if Visible then begin
    LStyle := GetWindowLong(Handle, GWL_STYLE);
    LStyle := LStyle and not WS_VSCROLL and not WS_HSCROLL;
    SetWindowLong(Handle, GWL_STYLE, LStyle);
  end;

  inherited;

  // クライアント領域の設定
  // スクロールバーを配置する非クライアント領域の設定
  // スクロールバーの位置とサイズは ScrollBars プロパティ設定メソッド内で実行
  if Assigned(FVScrollBar) then begin
    if Message.CalcValidRects then begin
      LRMargin := FRightMargin;
      LBMargin := FBottomMargin;
      if not FVScrollBar.Visible then LRMargin := 0;
      if not FHScrollBar.Visible then LBMargin := 0;

      // rgrc[0] : 移動またはサイズ変更後のウィンドウ値
      // rgrc[1] : 移動またはサイズ変更前のウィンドウ値
      // rgrc[2] : 移動またはサイズ変更前のクライアント領域の値
      // と MS Windows Dev Center にはあるのだが...
      LRect := message.CalcSize_Params.rgrc[0];
      LResRect := Rect(Left, Top, LRect.Right - LRMargin, LRect.Bottom - LBMargin);
      message.CalcSize_Params.rgrc[0] := LResRect;

      Message.Result := 0
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  WM_NCPAINT メッセージ処理
//  非クライアント領域の再描画が必要になった時に発生するメッセージ
//-----------------------------------------------------------------------------
procedure TplStringGrid.WMNCPaint(var Message: TWMNCPaint);
var
  LhHDC   : HDC;
  LCanvas : TCanvas;
begin
  inherited;

  LCanvas := TCanvas.Create;
  LhHDC   := GetWindowDC(Handle);
  try
    LCanvas.Handle := LhHDC;
    // ClipRect でを塗り潰してクライアント領域を再描画
    LCanvas.FillRect(LCanvas.ClipRect);
    Invalidate;
  finally
    ReleaseDC(Handle, LhHDC);
    FreeAndNil(LCanvas);
  end;
  Message.Result := 0;
end;

{ TplStringGridBar }

//=============================================================================
//  コンポーネントのコンストラクタ (生成時) 処理
//  スクロールバー (TScrollBar の継承クラス)
//=============================================================================
constructor TplStringGridBar.Create(AOwner: TComponent);
begin
  inherited;
  FStrGrid := TplStringGrid(AOwner);
end;

//-----------------------------------------------------------------------------
//  CN_CTLCOLORSCROLLBAR メッセージ処理
//  Color プロパティの実装用
//-----------------------------------------------------------------------------
procedure TplStringGridBar.CNCtlcolorscrollbar(var Message: TMessage);
begin
  DefaultHandler(Message)
end;

//=============================================================================
//  Change メソッドの処理
//  外部から Postion プロパティの値を設定した場合の処理
//  td-date, LeftCol が変わるので TStringGrid で自動的に処理してくれる
//=============================================================================
procedure TplStringGridBar.Change;
begin
  inherited;

  if Self.Kind = sbVertical then begin
    FStrGrid. td-date := Position + FStrGrid.FixedRows;
  end else
  if Self.Kind = sbHorizontal then begin
    FStrGrid. LeftCol := Position + FStrGrid.FixedCols;
  end;
end;

//=============================================================================
//  スクロール時の処理
//  このメソッド(イベント) では TScrollBar 操作によるスクロールだけを処理
//  Position プロパティによる設定は処理しない
//  トラッキングが ON と同じスクロールなので大量のデータで難があるかも知れない
//
//  TScrollBar は下端または右端まで移動して操を続けると Position の値が増加する
// Position の値の増加が不要になったら引数の ScrollPos に戻す値を渡す
//=============================================================================
procedure TplStringGridBar.Scroll(ScrollCode: TScrollCode;
  var ScrollPos: Integer);
var
  LScrollPos : Integer;
  LCellPos   : Integer;
  LRowPos    : Integer;
  LLastCol   : Integer;
  LLastRow   : Integer;
begin
  inherited;
  if ScrollCode = scPosition then Exit;

  LScrollPos := ScrollPos;

  if Self.Kind = sbVertical then begin
    LRowPos := LScrollPos + FStrGrid.FixedRows;
    LLastRow := LRowPos + FStrGrid.VisibleRowCount - FStrGrid.FixedRows;
    if LLastRow > (FStrGrid.RowCount - FStrGrid.FixedRows) then begin
      LRowPos := FStrGrid.RowCount - FStrGrid.VisibleRowCount - FStrGrid.FixedRows;
      Position := LRowPos;
      // 変更した値を引数に返す
      ScrollPos := Position;
    end else begin
      if LRowPos <= FStrGrid.FixedRows then begin
        FStrGrid.td-date := FStrGrid.FixedRows;
      end else begin
        FStrGrid.td-date := LRowPos;
      end;
    end;
  end;

  if Self.Kind = sbHorizontal then begin
    LCellPos := LScrollPos + FStrGrid.FixedCols;
    LLastCol := LCellPos + FStrGrid.VisibleColCount - FStrGrid.FixedCols;
    if LLastCol > (FStrGrid.ColCount - FStrGrid.FixedCols) then begin
      LCellPos := FStrGrid.ColCount - FStrGrid.VisibleColCount - FStrGrid.FixedCols;
      Position := LCellPos;
      // 変更した値を引数に返す
      ScrollPos := Position;
    end else begin
      if LCellPos <= FStrGrid.FixedCols then begin
        FStrGrid.LeftCol := FStrGrid.FixedCols;
      end else begin
        FStrGrid.LeftCol := LCellPos;
      end;
    end;
  end;
end;

//=============================================================================
//  コンポーネント登録情報
//  コンポーネントパレットの[plXRAY]というタブに登録
//  指定したタブがない場合は，自動的に作成される
//=============================================================================
procedure Register;
begin
  RegisterComponents('plXRAY', [TplStringGrid]);
end;

end.



05_TStringGrid のスクロールバーを常に非表示


これまでのサンプルとは逆に，スクロールバーを非表示にするには，TStringGrid.ScrollBars プロパティの値で指定します．ssNone にすると垂直と水平スクロールバー共に表示しません．
ssHorizontal は水平スクロールバーだけを表示する設定です．ssVertical は垂直スクロールバーだけを表示する設定です． 



  StringGrid1.ScrollBars := ssNone;
  StringGrid1.ScrollBars := ssVertical;
  StringGrid1.ScrollBars := ssHorizontal;
  StringGrid1.ScrollBars := ssBoth;


本ページの最初のサンプルと同じ方法も使えます．
WM_NCCALCSIZE メッセージ処理内で，LStyle or WS_VSCROLL の部分を LStyle and not WS_VSCROLL とすると，垂直スクロールバーを常に表示しないようにできます．この設定をすると，ScrollBars プロパティの値を ssBoth あるいは ssVertical にしても垂直スクロールバーは表示できません．




図11
スクロールバーが非表示の状態


リスト5
TStringGrid の垂直スクロールバーを表示しないようにするには，and not 演算にする		 
procedure TplStringGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  LStyle : Integer;
begin
  LStyle := GetWindowLong(Handle, GWL_STYLE);
  SetWindowLong(Handle, GWL_STYLE, LStyle and not WS_VSCROLL);

  inherited;
end;



06_TStringGrid のスクロールのトラッキング


スクロールのトラッキング (追従) 機能の動作確認用サンプルです．
Button1 クリックでトラッキングの ON, OFF を切り換えます．

スクロールバーのスクロールボックスをドラッグすると，スクロールボタンを放すまで，グリッドはスクロールしません．これが TStringGrid のデフォルトの設定です．
Options プロパティに goThumbTracking を含めると，スクロールボックスのドラッグと同時にグリッドもスクロールするようになります．
このスクロールのトラッキング (追従) を「滑らかなスクロール」と言うことがあるようです．




図12
Options に goThumbTracking がない場合
  • スクロールボックスを放すまでグリッドはスクロールしない

図13
Options に goThumbTracking がある場合
  • スクロールボックスのドラッグと同時にグリッドもスクロールする

リスト6
TStringGrid のスクロールのトラッキングの動作確認用サンプル		 
//=============================================================================
//  TStringGrid.Optionsの設定
//  OptionsプロパティにgoThumbTracking要素を追加または削除する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGridOptions : TGridOptions;
begin
  LGridOptions := StringGrid1.Options;

  //goThumbTrackingが含まれていれば削除
  //goThumbTrackingが含まれいなければ追加
  if goThumbTracking in LGridOptions then begin
    System.Exclude(LGridOptions, goThumbTracking);
  end else begin
    System.Include(LGridOptions, goThumbTracking);
  end;
  StringGrid1.Options := LGridOptions;
end;



07_Options プロパティ ( 集合型プロパティ ) の集合値の取得


上のサンプルで，TStringGrid の Options プロパティの設定をしています．この Options プロパティにはどんな要素があるかを，実行時に確認してみます．
TGridOption という列挙型があります．この末尾に複数形を意味する s を付けて，列挙型の要素を複数選択形式とした TGridOptions という集合型が Options プロパティの型です．Options プロパティは，オブジェクトインスペクタでも確認できる，列挙型の要素の組み合わせです．



TGridOption 列挙型と TGridOptions 集合型 
  TGridOption = (goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
    goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goRowMoving,
    goColMoving, goEditing, goTabs, goRowSelect, goAlwaysShowEditor,
    goThumbTracking, goFixedColClick, goFixedRowClick, goFixedHotTrack);
  TGridOptions = set of TGridOption;


TypInfo ユニットあるルーチンや型を使用すると，列挙型の要素の列挙や，集合型の要素を調べることができます．
Button1 クリックでは，TGridOption 列挙型の全ての要素名を列挙します．
Button2 クリックでは，この TGridOption のセット，つまり，設定されている Options プロパティの要素名のリストを取得して表示します．



実行時に，集合型のプロパティの集合に値を追加したり，集合に値を削除する方法は，以下の記事で確認してください．




図14
Options プロパティで設定可能な値のリスト
  • オブジェクトインスペクタで確認可能

図15
現在有効になっている Options プロパティの値

リスト7
Options プロパティ (集合型プロパティ) の集合値の取得		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls,
  Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  TypInfo;

{$R *.dfm}

//=============================================================================
//  フォームのOnCreateイベント処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //フォントの設定
  Memo1.Font.Charset := ANSI_CHARSET;
  Memo1.Font.Name    := 'Courier New';
  Memo1.Font.Size    := 9;
end;

//=============================================================================
//  TStringGrid.Optionsで設定可能な値を取得
//  TStringGrid.Optionsの要素はTGridOption列挙型として定義されている
//
//  usesにTypInfoが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  pInfo : PTypeInfo;
  pData : PTypeData;
  i     : Integer;
begin
  Memo1.Lines.Clear;

  pInfo := TypeInfo(TGridOption);

  //列挙型であれば調査
  if pInfo^.Kind = tkEnumeration then begin
    pData := GetTypeData(pInfo);
    for i := pData^.MinValue to pData^.MaxValue do begin
      Memo1.Lines.Add(GetEnumName(pInfo, i));
    end;
  end;
end;

//=============================================================================
//  TStringGrid.Optionsで設定した要素のリストを取得
//  新規にTStringGridを生成しているのでデフォルトの設定値ということになる
//
//  usesにTypInfoが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGrid     : TStringGrid;
  LPropName : String;
  LSL       : TStringList;
  i         : Integer;
begin
  Memo1.Lines.Clear;

  LGrid := TStringGrid.Create(Self);
  try
    LPropName := 'Options';
    LSL := TStringList.Create;
    try
      LSL.CommaText := SetToString(GetPropInfo(LGrid.ClassInfo, LPropName),
                       GetOrdProp(LGrid, LPropName), False);
      for i := 0 to LSL.Count - 1 do begin
        Memo1.Lines.Add(LSL[i]);
      end;
    finally
      FreeAndNil(LSL);
    end;
  finally
    FreeAndNIl(LGrid);
  end;
end;

end.



08_TStringGrid のスクロールバーのコンテキストメニュー


TStringGrid のスクロールバー上で，マウスの右ボタンをクリックすると，下図のようなコンテキストメニューが現れます．このコンテキストメニューを表示しないようにする方法です．

コンテキストメニューが表示する際，WM_CONTEXTMENU メッセージが発生します．このメッセージ処理内で何もしなければコンテキストメニューは現れません．何もしないと，TStringGrid で TPopupMenue コンポーネント等を使用していると，そのポップアップメニューも表示しなくなってしまいます．
そこで，マウスクリックの位置が，TStringGrid のクライアント領域の時は，WM_CONTEXTMENU メッセージ本来の処理を実行するようにしています．また，このコードでは，固定行ではメニューの表示をしないようにしていますが，実際には，TPopupMenu を表示する際に制御できます．




図16
スクロールバーのコンテキストメニュー
  • このコンテキストメニューを表示しないようにする

リスト8
TStringGrid のスクロールバーのコンテキストメニューを表示しないようにする		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls,
  Vcl.ExtCtrls;

type
  TplStringGrid = class(TStringGrid)
  protected
    procedure WMContextMenu(var Message: TWMContextMenu);
      message WM_CONTEXTMENU;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    plStringGrid1 : TplStringGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.dfm}

//=============================================================================
//  フォームのOnCreateイベント処理
//  すぐにテストできるように，列数と列幅等を設定し，データをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  //フォーム作成時にコンポーネントの入れ替え
  plStringGrid1 := TplStringGrid(ChangeComponent(StringGrid1, TplStringGrid));

  plStringGrid1.Options := plStringGrid1.Options + [goDrawFocusSelected];
  plStringGrid1.Options := plStringGrid1.Options + [goThumbTracking];

  plStringGrid1.ScrollBars := ssVertical;

  plStringGrid1.ColCount        := 10;
  plStringGrid1.FixedCols       := 1;
  plStringGrid1.FixedRows       := 1;
  plStringGrid1.DefaultColWidth := 70;
  plStringGrid1.RowCount        := 20 + plStringGrid1.FixedRows;

  //左端の列幅設定
  plStringGrid1.ColWidths[0] := 30;
  //スクロールした状態を把握するために，左端の列に番号を表示しておく
  for i := 1 to plStringGrid1.RowCount - 1 do begin
    plStringGrid1.Cells[0, i] := IntToStr(i);
  end;
end;

{ TplStringGrid }

//=============================================================================
//  WM_CONTEXTMENUメッセージ処理
//  スクロールバーのコンテキストメニューを表示しないようにする
//=============================================================================
procedure TplStringGrid.WMContextMenu(var Message: TWMContextMenu);
var
  i      : Integer;
  LCellH : Integer;
  LPos   : TPoint;
  LRect  : TRect;
begin
  LCellH := 0;
  for i := 0 to FixedRows - 1 do begin
    LCellH := LCellH + RowHeights[i] + GridLineWidth;
  end;

  LPos  := ScreenToClient(Point(Message.XPos, Message.YPos));
  LRect := ClientRect;
  LRect.Top := LRect.Top + LCellH;
  if PtInRect(LRect, LPos) then begin
    inherited;
  end else begin
    Message.Result := 0;
  end;
end;

end.



09_ShowScrollBar 関数と SetScrollInfo 関数


ShowScrollBar 関数を使用すると，スクロールバーを表示したり非表示にすることがてぎます． 


//=============================================================================
//  横 (水平) スクロールバーと縦 (垂直) スクロールバーを非表示にする
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  ShowScrollBar(StringGrid1.Handle, SB_HORZ , False);
  ShowScrollBar(StringGrid1.Handle, SB_VERT , False);
end;

//=============================================================================
//  横 (水平) スクロールバーと縦 (垂直) スクロールバーを表示する
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
begin
  ShowScrollBar(StringGrid1.Handle, SB_HORZ , True);
  ShowScrollBar(StringGrid1.Handle, SB_VERT , True);
end;


SetScrollInfo 関数でも，レコード型の nMin と nMax メンバの値を共に 0 にすると，スクロールバーを非表示することができます．

ただし，以下のコードを，スクロールバーを持つコントロールを利用する側から実行しても非表示にはできません．レコード型のメンバ名から推測できるように，SetScrollInfo 関数はスクロールバーの情報を設定するための関数です．継承クラスを作成して，スクロールバー関係のメッセージ処理内で以下のコードを実行します．
例えば TDBGrid には UpdateScrollBar というメソッドがあります．このメソッド内で以下のコードを実行すると，縦 (垂直)) スクロールバーを非表示にできます． 


//=============================================================================
//  縦 (垂直) スクロールバーを非表示にする設定
//  このコードを実行しても非表示にはならない
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  LScrollInfo : TScrollInfo;
begin
  LScrollInfo.cbSize := sizeof(LScrollInfo);
  LScrollInfo.fMask  := SIF_RANGE;
  LScrollInfo.nMin   := 0;
  LScrollInfo.nMax   := 0;
  SetScrollInfo(StringGrid1.Handle, SB_VERT, LScrollInfo, True);
end;


ShowScrollBar 関数と SetScrollInfo 関数のどちらも，コントロールのスクロールバーが本来非表示になる状態の時はスクロールバーを表示することはできません．
TStringGrid では，クライアント領域にデータが全て表示されているときはスクロールバーを表示しません．この状態の時は，ShowScrollBar 関数でも SetScrollInfo 関数でもスクロールバーを表示することはできません．




10_ウィンドウスタイルの WS_VSCROLL と WS_HSCROLL


コントロールの生成時に，スタイルにスクロールバーを含めなければスクロールバーは表示できないことになります．
CreateParams メソッドでは生成するウィンドウのスタイルや拡張スタイルを変更することができるはずですが，TStringGrid, TDBGrid, TListBox 等のコントロールは，以下のコードを実行しても非表示とはなりません．スクロールバー関係のスタイル変更は自動で行われているようです． 


//=============================================================================
//  ウィントウのスタイルから横 (水平) と縦 (垂直) スクロールバーを除外する
//  このコードを実行しても スクロールバーは非表示にならない
//=============================================================================
procedure TplStringGrid.CreateParams(var Params: TCreateParams);
var
  LStyle : DWORD;
begin
  inherited CreateParams(Params);

  LStyle := Params.Style and not WS_VSCROLL and not WS_HSCROLL;
  Params.Style := LStyle;
end;


そこで，本ページのサンプルでは，実行時にウィンドウ (コントロール) のスタイルを強制的に変更しています．それにより，スクロールバーの常に表示，常に非表示の機能を実現しています．スタイルの変更は，WM_NCCALCSIZE メッセージ内で処理しています．
WM_NCCALCSIZE メッセージは，ウィンドウの生成，再生成，あるいは非クライアント領域のサイズ変更の際に発生するメッセージです．スクロールバーは非クライアント領域に描画されていますから，確実な方法と思われます．

WM_NCCALCSIZE メッセージ内でのウィンドウのスタイルの変更であれば，VCL スタイルの適用があってもスクロールバーの表示の制御が可能です．
次ページ以降の，TDBGrid, TListBox 等のコントロールのスクロールバーの表示制御も，この考え方でサンプルを作成しています．



[備考]
ウィンドウスタイルに WS_VSCROLL と WS_HSCROLL がないと，WM_VSCROLL, WM_HSCROLL メッセージは検出できません．これらのメッセージはコントロールの標準スクロールバーが発行しています．
マウスホイール操作によるスクロールの検出は可能です．





11_TScrollBar の背景色 - 継承クラスと WndProc とサブクラス化


TScrollBar を使用しているサンプルでは背景色のプロパティ Color を実装しています．
Color プロパティは TScrollBar の継承元の protected 部には実装されています (TControl.Color)．背景色の処理を行うのは CN_CTLCOLORSCROLLBAR メッセージですが，このメッセージは，デフォルトで自分自身の WndProc を実行するだけてす．これを DefaultHandler にすれば Color プロパティの設定が有効になります．

本項のサンプルは ZIP 書庫に添付していません．



[備考 1]
TStringGrid, TDBGrid, TListBox 等，スクロールバー付きのコントロールのスクロールバーは，背景色を変更することはできません．



図17
TScrollBar の Color プロパティを有効にする
  • TScrollBar の継承クラスを実行時に生成

図18
TScrollBar の Color プロパティを無効にする
  • DefaultColor の値を True にする
  • TScrollBar の継承クラスを実行時に生成
 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TplScrollBar = class(TScrollBar)
  private
    FDefaultColor : Boolean;
  protected
    procedure CNCtlcolorscrollbar(var Message: TMessage);
      message CN_CTLCOLORSCROLLBAR;
  public
    constructor Create(AOwner: TComponent); override;
    property Color;
    property DefaultColor : Boolean read FDefaultColor write FDefaultColor;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    plScrollBar1 : TplScrollBar;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Assigned(plScrollBar1) then begin
    plScrollBar1 := TplScrollBar.Create(Self);
    plScrollBar1.Parent := Self;

    plScrollBar1.Left  := 20;
    plScrollBar1.Top   := 50;
    plScrollBar1.Width := 250;
  end;

  plScrollBar1.Color := clGreen;
  plScrollBar1.DefaultColor := False;
end;

{ TplScrollBar }

constructor TplScrollBar.Create(AOwner: TComponent);
begin
  inherited;
  FDefaultColor := True;
end;

procedure TplScrollBar.CNCtlcolorscrollbar(var Message: TMessage);
begin
  if FDefaultColor then begin
    with Message do
      CallWindowProc(DefWndProc, Handle, Msg, WParam, LParam);
  end else begin
    DefaultHandler(Message);
  end;
end;

end.


CN_CTLCOLORSCROLLBAR メッセージの戻り値を HBRUSH にすると，そのブラシで背景色を描画します．
HBRUSH はブラシのハンドルです．Delphi では TBrush.Handle の値です．単色のブラシであれば，以下のコードのように CreateSolidBrush 関数で作成できます．




図19
ブラシで背景色を設定
  • TScrollBar の継承クラスを実行時に生成
 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TplScrollBar = class(TScrollBar)
  private
    FBrush : HBRUSH;
  protected
    procedure CNCtlcolorscrollbar(var Message: TMessage);
      message CN_CTLCOLORSCROLLBAR;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    plScrollBar1 : TplScrollBar;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Assigned(plScrollBar1) then begin
    plScrollBar1 := TplScrollBar.Create(Self);
    plScrollBar1.Parent := Self;

    plScrollBar1.Left := 20;
    plScrollBar1.Top := 50;
    plScrollBar1.Width := 250;
  end;
end;

{ TplScrollBar }

constructor TplScrollBar.Create(AOwner: TComponent);
begin
  inherited;
  FBrush := CreateSolidBrush(clRed);
end;

destructor TplScrollBar.Destroy;
begin
  DeleteObject(FBrush);
  inherited;
end;

procedure TplScrollBar.CNCtlcolorscrollbar(var Message: TMessage);
begin
  Message.Result := FBrush;
end;

end.


Delphi の TBrush ではビットマップが扱えます．以下は 16 x 16 のビットの 256 色のマップ画像ををブラシとして使用しています．




図20
TBrush.Bitmap を使用した TScrollBar の背景例
  • TScrollBar の継承クラスを実行時に生成
 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TplScrollBar = class(TScrollBar)
  private
    FBitmap : TBitmap;
  protected
    procedure CNCtlcolorscrollbar(var Message: TMessage);
      message CN_CTLCOLORSCROLLBAR;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    plScrollBar1 : TplScrollBar;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Assigned(plScrollBar1) then begin
    plScrollBar1 := TplScrollBar.Create(Self);
    plScrollBar1.Parent := Self;

    plScrollBar1.Left := 20;
    plScrollBar1.Top := 50;
    plScrollBar1.Width := 250;
  end;
end;

{ TplScrollBar }

constructor TplScrollBar.Create(AOwner: TComponent);
begin
  inherited;

  FBitmap := TBitmap.Create;
  FBitmap.LoadFromFile('EMOTION_SMILE.bmp');
end;

destructor TplScrollBar.Destroy;
begin
  FreeAndNil(FBitmap);

  inherited;
end;

procedure TplScrollBar.CNCtlcolorscrollbar(var Message: TMessage);
begin
  if not FBitmap.Empty then begin
    FBitmap.Canvas.Brush.Bitmap := FBitmap;
    Message.Result := FBitmap.Canvas.Brush.Handle;
  end;
end;

end.


CreatePatternBrush 関数を使用すると，ビットマップからブラシを作成することができます． 



constructor TplScrollBar.Create(AOwner: TComponent);
begin
  inherited;

  FBitmap := TBitmap.Create;
  FBitmap.LoadFromFile('EMOTION_SMILE.bmp');
  FBrush := CreatePatternBrush(FBitmap.Handle);
end;

destructor TplScrollBar.Destroy;
begin
  DeleteObject(FBrush);
  FreeAndNil(FBitmap);

  inherited;
end;

procedure TplScrollBar.CNCtlcolorscrollbar(var Message: TMessage);
begin
  if not FBitmap.Empty then begin
    Message.Result := FBrush;
  end;
end;


メッセージは，コントロール自身の WndProc メソッドでも処理できます．



図21
TScrollBar の WndProc によるメッセージ処理
  • TScrollBarの継承クラスを実行時に生成
 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TplScrollBar = class(TScrollBar)
  private
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    plScrollBar1 : TplScrollBar;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Assigned(plScrollBar1) then begin
    plScrollBar1 := TplScrollBar.Create(Self);
    plScrollBar1.Parent := Self;

    plScrollBar1.Left := 20;
    plScrollBar1.Top := 50;
    plScrollBar1.Width := 250;
  end;
end;

{ TplScrollBar }

procedure TplScrollBar.WndProc(var Message: TMessage);
begin
  if Message.Msg = CN_CTLCOLORSCROLLBAR then begin
    Color := clBlue;
    DefaultHandler(Message);
  end;

  // 元のWndPorcのメッセージ処理を行う
  // これがないと正常に動作しない
  inherited WndProc(Message);
end;

end.


ここまでは TScrollBar の継承クラスを作成して処理しています．以下は TScrollBar の継承クラスを作成しない方法です．
TScrollBar の WndProc を別のメソッドで置き換えます．これをサブクラス化と言います．書き換えたメソッド内でメッセージを処理します．元の WndProc を退避して最後に元に戻します．
サブクラス化すると，対象のコントロールのメッセージの処理が可能になります．protected 部のメソッドやプロパティが使用可能になるわけではありません．




図22
TScrollBar の サブクラス化メソッド WndProc によるメッセージ処理
  • TScrollBar は設計時にフォームに配置
 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ScrollBar1: TScrollBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    LOriginSCrollBarProc : TWndMethod;
    procedure ScrollBarSubClassProc(var message: TMessage);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // 元の WndProc を退避して別のメソッドを定義 (サブクラス化)
  LOriginSCrollBarProc  := ScrollBar1.WindowProc;
  ScrollBar1.WindowProc := ScrollBarSubClassProc;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // WndProc を元に戻す
  ScrollBar1.WindowProc := LOriginSCrollBarProc;
end;

procedure TForm1.ScrollBarSubClassProc(var message: TMessage);
begin
  if Message.Msg = CN_CTLCOLORSCROLLBAR then begin
    // Color プロパティは使用不可
    // TScrollBar.Color は protected のメンバ
    // ここで Color を設定するとフォームの背景色になる
    message.Result := CreateSolidBrush(clSkyBlue);
  end;

  // 元の WndProc を実行
  // 元の WndProc は CN_CTLCOLORSCROLLBAR を使用しないので
  // 最初に実行しても結果は同じ
  LOriginSCrollBarProc(message);
end;

end.


[備考 2]
CN_CTLCOLORSCROLLBAR は，TApplicationEvents コンポーネントの OnMessage イベントでは捕捉できません．CN_CTLCOLORSCROLLBAR に相当する Windows メッセージは WM_CTLCOLORSCROLLBAR ですが，これも捕捉できません．