Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年07月28日] [更新 2020年03月13日] Delphi サンプルプログラム集
   
060_TDBGrid のセルのカスタム描画と複数レコード選択
動作確認等 Windows 7 U64(SP1) + Delphi XE5(UP2) Pro VCL-32
BDE 5.2 + Paradox 7.0
060_DBGrid_MultiSelect.zip [38,504 KB] 2020年03月13日版(EXE同梱)







TDBGrid のセルのカスタム描画と複数レコード選択


TDBGrid は,SQL 文等の実行によって取得したデータベースのデータをリストのように表示するためのコントロールです.
本ページは,この TDBGrid のセルの背景色とテキスト (文字列) のカスタム描画のサンプルです.最後の方は複数レコードの選択 (複数行の選択) に関するサンプルとなっています.

TDBGrid にはカラムエディタがあり,下図のように,列単位で背景色やフォントが設定できます.本ページのサンプルは,これらの設定をコードで処理する例とも言えます.テーマが有効な場合,カラムエディタで設定したタイトル行の背景色,title.color プロパティの設定は無効になります.また,テキストを描画する際の縦方向のアライメントの設定機能はありません.それらは必然的にカスタム描画で処理することになります.

本ページのサンプルでは,継承クラスをコンポーネントとして登録しないで,添付の plChgCompo ユニットを使用して,実行時に TDBGrid コンポーネントを派生クラスに置き換えてテストしています.



図1
TDBGrid のカラムエディタのプロパティ
  • 列単位で各種のプロパティが設定できる
  • title.color は,テーマが有効な場合は無効
  • テキストの縦方向アライメントの設定はない

[備考 1]
サンプルのプロジェクトには,添付のユニットを使用しているプロジェクトがあります.該当するユニットファイルをライブラリパスの通ったフォルダにコピーして使用して下さい.plChgCompo は,ほとんどのサンプルで使用しています.


[備考 2]
本ページのサンプルでは,BDE と Paradox のサンプルデータを使用しています.
Delphi XE7 以降には BDE は実装されていません.必要であれば,BDE を別途入手するか,他のデータベースを利用してテストしてください.


[備考 3]
本ページのサンプルは,テーマが有効で DrawingStyle プロパティの値がデフォルトの gdsThemed の時のコードです.テーマが無効,あるいは DrawingStyle の gdsClassic, gdsGradient には対応していません.


[備考 4]
サンプルプログラムで使用している DrawColumnCell 等 は TDBGrid の protected 部のメソッドです.このメソッドは,カスタム描画に使用するイベントと同じように,TDBGrid のセルの描画が必要になった時に自動的に実行されます.
protected 部の宣言を継承クラスでも宣言して使用します.これを関数やメソッドのオーバライドと言います.

コーディングは,VCL のソースコード内の protected 部の宣言文をコピーするのではなく,IDE の入力支援の機能を使用して宣言文を作成します.そうすば,未定義のエラーが発生するのを防止できます.
オーバライドした関数やメソッドの末尾には override 指令があります.それらの関数やメソッドの使用方法はオンラインヘルプ等で調べます.それらの関数やメソッドには Sender: TObject という引数はありません.発生元は常に自分自身です.





01_TDBGrid の行と列と選択セルのデータ


TStringGrid のデータは TSgings 型の変数に格納され,そのデータが行単位で TStringGrid のセルに表示されます.TStrings は文字列のリストです.つまり,TStringGrid では全てのデータがセルに代入されているのと同じです.TStringGrid の行数はデータの数だけあります.

TDBGrid はデータベースから取得したデータを表示しますが,取得したデータをTStringGrid のようにセルの値として確保するわけではありません.表示しているグリッドの「セル」の位置にデータを文字列として描画するだけです. データセットのデータは,表示に必要なレコード数だけを TDBGrid に表示します.TDBGrid には TStringGrid のような「セルの値」はありません.protected 部に Row プロパティがありますが,この値は表示行数の値を超えることはありません.

以下はそのことを確認するためのサンプルです.
このサンプルプログラムは,TDBGrid 上でマウスの左ボタンをダブルクリックすると,そのマウスカーソル位置の行と列の番号を表示します.
サンプルプログラムを起動して,TDBGrid の左上のセルをダダブルクリックします.左上のセルはタイトル行 (固定行) のインジケータの列です.結果は 0 行 0 列となります.



図2
TDBGrid の左上の行と列の番号
  • セル上でダブルクリック
  • 0 行 0 列となる

データセルの最初の行の左端のカラムのセルをダブルクリックします.これは,先頭のレコードの最初の項目値が表示されているセルです.結果は 1 行 1 列となります.


図3
最初のレコードの最初の項目のセルをダブルクリック
  • 1 行 1 列となる

垂直方向にスクロールして最後のレコードを表示します.最後の項目が表示されるまで水平方向にスクロールして,最後のデータセルをダブルクリックします.結果は 11 行 13 列となっています.
テストに使用したデータセットのレコード数は 55 です.項目数は 13 あります.列数は項目数と同じですが,TDBGrid の行数は,最後のレコードの 55 番目であっても 表示行数の 11 となっていることが確認できます.


図4
最後のレコードの最後の項目のセルをダブルクリック
  • 11 行 13 列となる
  • サンプルのデータセットのレコード数は 55
  • 項目数は 13

リスト1
ダブルクリックした TDBGrid のセルの行と列の番号を取得するプログラム
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  plDBGrid1.Options := plDBGrid1.Options -[dgEditing];

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from customer.db');
  Query1.Open;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

//=============================================================================
//  TDBGrid 上でマウス左ボタンをダブルクリックした時の処理
//  ダブルクリックしたマウスカーソル位置のセルの行と列の位置を取得して表示
//
//  HitTest は protected 部のプロパティ
//=============================================================================
procedure TForm1.DBGrid1DblClick(Sender: TObject);
var
  LMousePos : TPoint;
  LGridPos  : TGridCoord;
  LText     : string;
begin
  // マウスカーソル位置の座標値を取得
  LMousePos := plDBGrid1.HitTest;
  // 座標値をグリッドの行と列の値に変換
  LGridPos  := plDBGrid1.MouseCoord(LMousePos.X, LMousePos.Y);

  LText := IntToStr(LGridPos.Y) + ' 行' + sLineBreak
         + IntToStr(LGridPos.X) + ' 列';
  MessageBox(Handle, PChar(LText), '行と列の位置', MB_ICONINFORMATION);
end;

//=============================================================================
//  選択中の TDBGrid のセルの行と列の位置を取得して表示
//
//  Row, Col は protected 部のプロパティ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LText : string;
begin
  LText := IntToStr(plDBGrid1.Row) + ' 行' + sLineBreak
         + IntToStr(plDBGrid1.Col) + ' 列';
  MessageBox(Handle, PChar(LText), '行と列の位置', MB_ICONINFORMATION);
  plDBGrid1.SetFocus;
end;

end.


TDBGrid の継承クラスを使用しない場合は TDBGrid.HitTest は使用できません.その場合,以下のようにマウスカーソルのスクリーン座標値から取得できます.TStringGridのように TCustomDrawGrid の継承クラスであれば,MouseToCell メソッドも使用できます.


//=============================================================================
//  TDBGrid 上でマウス左ボタンをダブルクリックした時の処理
//  ダブルクリックしたマウスカーソル位置のセルの行と列の位置を取得して表示
//=============================================================================
procedure TForm1.DBGrid1DblClick(Sender: TObject);
var
  LMousePos  : TPoint;
  LPosInGrid : TPoint;
  LGridPos   : TGridCoord;
  LText      : string;
begin
  // マウスカーソル位置を取得してコントロール内の座標に変換
  GetCursorPos(LMousePos);
  LPosInGrid := DBGrid1.ScreenToClient(LMousePos);

  // マウスカーソルの座標値から行と列の値を取得
  LGridPos := DBGrid1.MouseCoord(LPosInGrid.X, LPosInGrid.Y);

  // 結果を表示
  LText := IntToStr(LGridPos.Y) + ' 行' + sLineBreak
         + IntToStr(LGridPos.X) + ' 列';
  MessageBox(Handle, PChar(LText), '行と列の位置', MB_ICONINFORMATION);
end;


選択中のセルの値は次のように,TDBGrid の SelectedIndex, SelectedField プロパティ等を使用して取得することができます.
このコードはボタンのクリックコードですが,ダブルクリックすると,マウスカーソル下のセルが選択されますから,結果的には同じです.

項目値はデータベースに格納されている値です.表示値は TDBGrid 等,表示用コントロールに表示する時の値です.数値型や日付,時刻型等のテータは,表示書式を設定することができます.



図5
アクティブなレコードの項目データを取得

リスト2
選択中のセルの値 (アクティブレコードの項目の値) を取得
//=============================================================================
//  TDBGird のセルをダブルクリックした時の処理
//=============================================================================
procedure TForm1.DBGrid1DblClick(Sender: TObject);
begin
  Button1Click(nil);
end;

//=============================================================================
//  選択中の TDBGrid のセルの値を取得
//  実際にはアクティブレコードの項目 (フィールド) の値
//  継承クラスを使用しない場合
//  SelectedIndex, SelectedField プロパティを使用する
//
//  TDBGrid.SelectedIndex は 0 ベースの値
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LText :string;
begin
  LText := 'Col No : ' + IntToStr(DBGrid1.SelectedIndex) + sLineBreak
         + '項目名 : ' + DBGrid1.SelectedField.FieldName + sLineBreak
         + '項目値 : ' + DBGrid1.SelectedField.Text + sLineBreak
         + '表示値 : ' + DBGrid1.SelectedField.DisplayText;

  MessageBox(Handle, PChar(LText), 'セルの値', MB_ICONINFORMATION);

  plDBGrid1.SetFocus;
end;


OnCellClick イベントであれば,引数の Column を使用して,クリックしたセルに相当する項目値の値を取得することができます.  



図6
クリックしたセルのアクティブなレコードの項目データを取得

リスト3
クリックしたセルの値 (アクティブレコードの項目の値) を取得
//=============================================================================
//  OnCellClick イベントの処理
//  クリックしたセル値を取得
//  実際にはアクティブレコードの項目 (フィールド) の値
//=============================================================================
procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
  Label1.Caption := Column.Field.DisplayText;
end;


上のサンプルでは,データセットは Query1 (TQuery) ですから,次のコードでもアクティブレコードのデータが取得できます.しかし,この方法は汎用性がありません.
TQuery や TTable は BDE 用のコンポーネントです.BDE を使用しないアプリケーションでは使用することができません.


procedure TForm1.DBGrid1CellClick(Column: TColumn);
var
  LFieldName : string;
begin
  LFieldName := DBGrid1.SelectedField.FieldName;
  Label1.Caption := Query1.FieldByName(LFieldName).Text;
end;

汎用性という意味では,以下のように TDataset のプロパティを使用する方法の方が汎用性があると言えます.


procedure TForm1.DBGrid1CellClick(Column: TColumn);
var
  LFieldName : string;
begin
  LFieldName := DBGrid1.SelectedField.FieldName;
  Label1.Caption := DBGrid1.DataSource.DataSet.FieldByName(LFieldName).Text;
end;


TDBGrid には,TStringGrid のような「セルの値」はありません.取得するのはアクティブレコードの選択している列に相当する項目の値です.セルを選択すると,そのセルの行がアクティブレコードになります.TDataSet では,アクティブレコードのデータだけが取得できます.アクティブレコードは常に TDBGrid に表示されています.インジケータ (三角形の矢印) の位置がアクティブレコードです.アクティブレコードは常に 1 つだけです.

TDBGrid の Options の dgEditing を有効にして,TTable や TQuery のデータセットを更新可能な状態にすると,セルを編集可能にできます.
セルが編集状態になると,インプレイスエディタが起動して,そのインプレイスエディタにデータを入力できます.インプレスエディタに入力した値は,アクティブレコードにセットされます.TDBGrid は,その値を自身の Canvas に描画します.
TDBGrid には「セルの値」がありませんから,セルに値を代入するわけではありませんが,この操作のことを「セルの編集」とか「セルのデータの編集」と言うことがあります.

データベースのデータは,アクティブなレコードに対してだけデータの取得や編集が可能です.アクティブレコードは常に 1 つだけです.



[備考 1]
データベースのデータには,データ (レコード) を一意に識別するデータ番号とかレコード番号のような概念はありません.SQL 文の実行結果として取得した場合のレコード番号は,取得したレコードの一連番号です.レコードの追加や削除で変化します.


[備考 2]
筆者もそうですが,データセットの表示に TStringGrid を使用している方もいます.TStringGrid であれば,セル値としての操作も可能です.

TStringGrid を使用した場合,データセットのデータを読み込んで「セルの値」として代入する処理と,セルの値の編集後に,該当するレコードの項目の値を変更する処理が必要です.TStringGrid のセルの値は文字列ですから,各フィールの Text プロパティ等で取得できます.
項目名のリストは,TDataSet.FieldList等で取得できます.

TStringGrid では TDBGrid のように,選択したセルが自動的にアクティブレコードにはなりません.その処理も必要です.n 番目のレコードをアクティブレコートにするには TDataSet.RecNo プロパティにレコード番号の n を代入します.
このような,TDBGrid が自動で行う処理を自前で処理すれば,セル値としての操作が可能になり,セルや行単位,あるいは列のカスタム描画が便利になります.

TStringGrid は列の追加も容易です.追加した列にボタンを描画して,各々のレコードに対する操作用とすることもできます.





02_TDBGrid の指定列のデータセルの背景色を変更


TDBNGrid の指定列のデータセルの背景色を変更するサンプルです.データセルは,固定行であるタイトル行と,固定列であるインジケータ列の部分を除くセルのことです.
これは TDBGrid のカラムエディタで Color プロパティの値を設定することに相当します.

TDBGrid のカラムエディタで設定する場合は,各カラムに対応するデータセットの項目 (フィールド) を指定しますから,列の移動や削除があっても,該当するデータセットの項目がかわることはありません.コードで背景色を描画する場合は,そのことを考慮する必要があるかも知れません.

TDBGrid には,行番号を意味する Row プロパティがありますが,一般的なカスタム描画用のイベント,あるいはメソッドには,この行番号に相当する引数はありません.
Options プロパティに dgRowSelect があると,描画ルーチン内で,カラム単位,あるいはデータセットの項目 (フィールド) 単位の検出はできません.


最初は,継承元の DrawColumnCell メソッドをオーバライドして使用する例です.
背景色を変更するカラムは,引数の DataCol の値を使用しています.引数の DataCol は,列のインデックスです.これは 0 ペースの値ですから,3 は 4 番目の列となります.

背景の色として,TCanvas.Brush.Color の値を設定します.そして,DefaultDrawColumnCell メソッドを実行します.このメソッドは,現在の TCanvas.Brush.Color の値で領域を塗り潰した後,セルのテキストを描画します.



図7
指定列のデータセルの背景色を変更
  • DrawColumnCell メソッドで処理
  • 列の指定は引数の DataCol の値を使用
  • 色は TCanvas.Brush.Color を設定

リスト4
指定列のデータセルの背景色
DrawColumnCell メソッドを使用.列はメソッドの引数 DataCol で指定
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LItemList : string;
  LIndex    : Integer;
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  LItemList := 'Company, Addr1, CustNo, State, City, Zip, Phone';
  Query1.SQL.Add('select ' + LItemList + ' from customer.db');
  Query1.Open;

  // テスト表示用にカラムの幅を変更して水平方向にスクロール
  // ColWidths, LeftCol は protected 部のプロパティ
  for LIndex := 3 to 6 do begin
    plDBGrid1.ColWidths[LIndex] := 70;
  end;
  plDBGrid1.LeftCol := 3;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  DrawColumnCell メソッドの処理
//  指定列のセル背景を指定した色で塗り潰す
//
//  DrawColumnCell  では固定列,固定行のセルの描画はできない
//=============================================================================
procedure TplDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
var
  LColor : TColor;
  LRect  : TRect;
begin
  inherited;

  if (DataCol >= 3) and (DataCol <= 5) then begin
    // 背景の色の指定
    case DataCol of
      3: LColor := $007171FF;
      4: LColor := $0000D900;
      5 :LColor := $00FFAAAA;
    else
      LColor := Color;
    end;

    // 塗り潰しの矩形領域
    LRect := Rect;
    // 塗り潰しの色 (TBrush.Color で指定する)
    Canvas.Brush.Color := LColor;
    // 描画ルーチンを実行
    DefaultDrawColumnCell(LRect, DataCol, Column, State);
  end;
end;

end.


上と同じく,継承元の DrawColumnCell メソッドをオーバライドして,背景色を変更するカラムの指定に引数の DataCol の値を使用しますが,背景色をグラデーションにする例です.
グラデーションにすると雰囲気が変わります.

このように,背景を単色ではない色にした場合は,DefaultDrawColumnCell メソッドを実行する前に,TCanvas.Brush.Style (ブラシのスタイル) の値を bsClear にします.そうしないと,現在のブラシでセルの背景が描画されてしまいます.

グラデーションの終端色を決めるのに,添付のユニット内の関数を使用しています.



図8
図5 指定列のデータセルの背景色を変更
  • グラデーションにしてみる

リスト5
指定列のデータセルの背景色.グラデーションにしてみる
//=============================================================================
//  DrawColumnCell メソッドの処理
//  指定列のセル背景を指定した色で塗り潰す
//  グラデーションにする例
//
//  DrawColumnCell  では固定列,固定行のセルの描画はできない
//
//  uses に GraphUtil と plCalcGradColor (添付のユニット) が必要
//=============================================================================
procedure TplDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
var
  LStartColor : TColor;
  LEndColor   : TColor;
  LRect       : TRect;
begin
  inherited;

  if (DataCol >= 3) and (DataCol <= 5) then begin
    // 背景の色の指定
    if DataCol = 3 then begin
      LStartColor := $007171FF;
      LEndColor   := CalcGradEndColor(LStartColor, 70);
    end else
    if DataCol = 4 then begin
      LStartColor := $0000D900;
      LEndColor   := CalcGradEndColor(LStartColor, 70);;
    end else
    if DataCol = 5 then begin
      LStartColor := $00FFAAAA;
      LEndColor   := CalcGradEndColor(LStartColor, 70);;
    end else begin
      LStartColor := Color;
      LEndColor   := Color;
    end;

    // 背景の塗り潰し
    LRect := Rect;
    // グラデーションで塗り潰し (uses に GraphUtil が必要)
    SetBkMode(Canvas.Handle, TRANSPARENT);
    GradientFillCanvas(Canvas, LStartColor, LEndColor, LRect, gdVertical);

    // カラム間の線
    Canvas.Pen.Color := clSilver;
    Canvas.MoveTo(LRect.Left, LRect.Top + 1);
    Canvas.LineTo(LRect.Left, LRect.Bottom - 1);

    // Brush を透明にして描画ルーチンを実行
    Canvas.Brush.Style := bsClear;
    DefaultDrawColumnCell(LRect, DataCol, Column, State);
  end;
end;

継承元の DrawDataCell メソッドをオーバライドして使用する例です.
背景色を変更するカラムは,Field.Index の値を使用しています.Field は TField 型の変数で,メソッドの引数です.


図9
図5 指定列のデータセルの背景色を変更
  • DrawDataCell メソッドで処理
  • 列の指定は Field.Index の値を使用
  • 色は TCanvas.Brush.Color を設定

リスト6
指定列のデータセルの背景色
DrawDataCell メソッドを使用.列の指定は Field.Index の値を使用
//=============================================================================
//  DrawDataCell メソッドの処理
//  指定列のセル背景を指定した色で塗り潰す
//
//  DrawDataCell では固定列,固定行のセルの描画はできない
//=============================================================================
procedure TplDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
var
  LColor : TColor;
  LRect  : TRect;
begin
  inherited;

  if (Field.Index >= 3) and (Field.Index <= 5) then begin
    // 背景の色の指定
    case Field.Index of
      3 :LColor := clWebPink;
      4: LColor := clWebPaleGreen;
      5: LColor := clWebAquamarine;
    else
      LColor := Color;
    end;

    // 塗り潰しの矩形領域
    LRect := Rect;
    // 塗り潰しの色 (TBrush.Color で指定する)
    Canvas.Brush.Color := LColor;
    // 描画ルーチンを実行
   DefaultDrawDataCell(LRect, Field, State);
  end;
end;


OnDrawColumnCell イベントを使用する例です.
背景色を変更するカラムは,引数の DataCol の値を使用しています.引数の DataCol は,列のインデックスです.これは 0 ペースの値ですから,3 は 4 番目の列となります.
イベントを使用す得る場合は,DBGrid1.Canvas のように,対象の Canvas を明示的に指定します.指定しないと,親コントロールのフォームの Canvas が描画対象になってしまいます.


図10
図5 指定列のデータセルの背景色を変更
  • OnDrawColumnCell イベントで処理
  • 列の指定はイベントの引数 DataCol の値を使用
  • 色は TCanvas.Brush.Color を設定

リスト7
指定列のデータセルの背景色
OnDrawColumnCell イベントを使用.列はイベントの引数 DataCol の値で指定
//=============================================================================
//  TDBGrid.OnDrawColumnCell イベントのコード
//  指定列のセル背景を指定した色で塗り潰す
//
//  OnDrawColumnCell イベントでは固定列,固定行のセルの描画はできない
//=============================================================================
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  LColor : TColor;
  LRect  : TRect;
begin
  if (DataCol >= 3) and (DataCol <= 5) then begin
    // 背景の色の指定
    case DataCol of
      3: LColor := clWebAquamarine;
      4 :LColor := clWebLime;
      5: LColor := clWebBurlywood;
    else
      LColor := Color;
    end;

    // 塗り潰しの矩形領域
    LRect := Rect;
    // 塗り潰しの色 (TBrush.Color で指定する)
    plDBGrid1.Canvas.Brush.Color := LColor;
    // 描画ルーチンを実行
    plDBGrid1.DefaultDrawColumnCell(LRect, DataCol, Column, State);
  end;
end;


OnDrawColumnCell イベントを使用する例です.
背景色を変更するカラムは,Column.Field.FieldNo の値を使用しています.Column は TColumn 型の変数で,イベントの引数です.
イベントを使用す得る場合は,DBGrid1.Canvas のように,対象の Canvas を明示的に指定します.指定しないと,親コントロールのフォームの Canvas が描画対象になってしまいます.


図11
指定列のデータセルの背景色を変更
  • OnDrawColumnCell イベントで処理
  • 列の指定は Column.Field.FieldNo の値を使用
  • 色は TCanvas.Brush.Color を設定

列の指定に Column.Field.FieldNo の値を使用すると,例の移動で背景色も移動します.
DrawDataCell メソッド,あるいは OnDrawDataCell イベントで Field.FieldNo の値で列を指定した場合も同じです.

TDBGrid は,その表示機能の構造から,行の移動の機能はありません.派生元に TCustomGrid.MoveRow がありますが,このメソッドは TDBGrid では機能しません.



図12
指定列のデータセルの背景色を変更
  • 列の移動で背景色も移動する

リスト8
指定列のデータセルの背景色
OnDrawColumnCell イベントを使用.列の指定は Column.Field.FieldNo の値を使用
//=============================================================================
//  列を移動
//  MoveColumn は protected 部のメソッド
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  plDBGrid1.MoveColumn(4, 5);
  plDBGrid1.SetFocus;
end;

//=============================================================================
//  TDBGrid.DrawColumnCell イベントのコード
//  指定列のセル背景を指定した色で塗り潰す
//
//  OnDrawColumnCell イベントでは固定列,固定行のセルの描画はできない
//=============================================================================
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  LColor   : TColor;
  LRect    : TRect;
  LFieldNo : Integer;
begin
  LFieldNo := Column.Field.FieldNo;
  if (LFieldNo >= 4) and (LFieldNo <= 6) then begin
    // 背景の色の指定
    case LFieldNo of
      4: LColor := $0000D900;
      5 :LColor := $00FFAAAA;
      6: LColor := $007171FF;
    else
      LColor := Color;
    end;

    // 塗り潰しの矩形領域
    LRect := Rect;
    // 塗り潰しの色 (TBrush.Color で指定する)
    plDBGrid1.Canvas.Brush.Color := LColor;
    // 描画ルーチンを実行
    plDBGrid1.DefaultDrawColumnCell(LRect, DataCol, Column, State);
  end;
end;


OnDrawColumnCell イベントを使用する例です.
背景色を変更するカラムは,Column.FieldName の値を使用しています.Column は TColumn 型の変数で,イベントの引数です.
イベントを使用す得る場合は,DBGrid1.Canvas のように,対象の Canvas を明示的に指定します.指定しないと,親コントロールのフォームの Canvas が描画対象になってしまいます.

列の指定に Column.FieldName の値を使用した場合も,例の移動で背景色も移動します.
DrawDataCell メソッド,あるいは OnDrawDataCell イベントで Field.FieldName の値で列を指定した場合も同じです.



図13
指定列のデータセルの背景色を変更
  • OnDrawColumnCel イベントで処理
  • 列の指定は Column.FieldName の値を使用
  • 色は TCanvas.Brush.Color を設定
  • 列を移動すると背景色も移動する

リスト9
指定列のデータセルの背景色
OnDrawColumnCel イベントを使用.列の指定は Column.FieldName の値を使用
//=============================================================================
//  TDBGrid.DrawColumnCell イベントのコード
//  指定列のセル背景を指定した色で塗り潰す
//
//  OnDrawColumnCell イベントでは固定列,固定行のセルの描画はできない
//=============================================================================
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  LColor   : TColor;
  LRect    : TRect;
  LFldName : string;
begin
  // LFldName := Column.Field.FieldName; でも同じ
  LFldName := Column.FieldName;
  if (LFldName = 'State') or (LFldName = 'City') or (LFldName = 'Zip') then begin
    // 背景の色の指定
    if LFldName = 'State' then LColor := $007171FF;
    if LFldName = 'City'  then LColor := $0000D900;
    if LFldName = 'Zip'   then LColor := $00FFAAAA;

    // 塗り潰しの矩形領域
    LRect := Rect;
    // 塗り潰しの色 (TBrush.Color で指定する)
    plDBGrid1.Canvas.Brush.Color := LColor;
    // 描画ルーチンを実行
    plDBGrid1.DefaultDrawColumnCell(LRect, DataCol, Column, State);
  end;
end;


OnDrawDataCell イベントを使用する例です.
背景色を変更するカラムは,Field.Index の値を使用しています.Field は TField 型の変数で,イベントの引数です.
イベントを使用す得る場合は,DBGrid1.Canvas のように,対象の Canvas を明示的に指定します.指定しないと,親コントロールのフォームの Canvas が描画対象になってしまいます.


図14
指定列のデータセルの背景色を変更
  • OnDrawDataCell イベントで処理
  • 列の指定は Field.Index の値を使用
  • 色は TCanvas.Brush.Color を設定

リスト10
指定列のデータセルの背景色
OnDrawDataCell イベントを使用.列の指定は Field.Index の値を使用
//=============================================================================
//  TDBGrid.OnDrawDataCell イベントのコード
//  指定列のセル背景を指定した色で塗り潰す
//
//  OnDataCell イベントでは固定列,固定行のセルの描画はできない
//=============================================================================
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
  Field: TField; State: TGridDrawState);
var
  LColor  : TColor;
  LRect   : TRect;
begin
  if (Field.Index >= 3) and (Field.Index <= 5) then begin
    // 背景の色の指定
    case Field.Index of
      3 :LColor := $00FFAAAA;
      4: LColor := $0000D900;
      5: LColor := $007171FF;
    else
      LColor := Color;
    end;

    // 塗り潰しの矩形領域
    LRect := Rect;
    // 塗り潰しの色 (TBrush.Color で指定する)
    plDBGrid1.Canvas.Brush.Color := LColor;
    // 描画ルーチンを実行
    plDBGrid1.DefaultDrawDataCell(LRect, Field, State);
  end;
end;


TCanvas.FillRect メソッドは,矩形領域の下端の 1 ピクセルと右端の 1 ピクセルは描画しません.その部分はグリッドの罫線の領域です.そのままでも構いませんが,塗り潰ししたいのであれば,以下のように矩形領域を変更することで対応できます.


図15
指定列のデータセルの背景色を変更
  • 塗り潰しの矩形領域を調整

リスト11
指定列のデータセルの背景色.塗り潰しの矩形領域の調整
//=============================================================================
//  DrawDataCell メソッドの処理
//  指定列のセル背景を指定した色で塗り潰す
//
//  OnDrawDataCell イベントでは固定列,固定行のセルの描画はできない
//=============================================================================
procedure TplDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
var
  LColor : TColor;
  LRect  : TRect;
begin
  inherited;

  if (Field.Index >= 3) and (Field.Index <= 5) then begin
    // 背景の色の指定
    case Field.Index of
      3: LColor := $007171FF;
      4: LColor := $0000D900;
      5 :LColor := $00FFAAAA;
    else
      LColor := Color;
    end;

    // 塗り潰しの矩形領域
    LRect := Rect;
    // TCamvas.FillRect は下端と右端の 1 ピクセルは描画領域に含まれないので追加
    LRect.Right  := LRect.Right + 1;
    LRect.Bottom := LRect.Bottom + 1;

    // 塗り潰しの色 (TBrush.Color で指定する)
    Canvas.Brush.Color := LColor;

    // 描画ルーチンを実行
    // 必要なら自前で文字列も描画する
   DefaultDrawDataCell(LRect, Field, State);
  end;
end;


以上のように,カスタマイズした描画を行うには,Draw 系のイベントを使用して処理できることを確認しました.継承クラスを使用する場合も Draw 系のメソッドをオーバライドして処理できます.継承クラスを作成すると,protected 部のメソッドやプロパティが利用できて,より柔軟な処理が可能になります.

Delphi XE5 の時点では,カスタム描画用のイベントも,継承クラスでオーバライドして使用可能なメソッドも 2 つあります.引数が違うだけでどちらでも同じような処理が可能です.目的に合わせて使用することになります.

固定行であるタイトル行,固定列であるインジケータの列は,それらのイベントやメソッドでは処理できません.継承クラスを作成して,DrawCell メソッドをオーバライドして処理します.





03_TDBGrid の選択セルの背景色を変更


選択中のセルの背景食を設定する例です.セルはマウスの左ボタン押下で選択できます.
Options に dgRowSelect が含まれていると行全体の選択となります.dgRowSelect が含まれていない場合はセルの選択となります.

選択されているセルの行が TDBGrid のアクティブなレコードです.TDBGrid ではアクティブなレコードは常に 1 つです.アクティブなレコードは常に TDBGrid の可視領域に表示されます.アクティブなレコードは垂直方向にスクロールすると移動します.したがって,選択セルの位置も移動します.

背景色をグラデーションした場合は,指定列のデータセルの背景色の変更のサンプルの記事で述べたように,DefaultDrawColumnCell あるいは DefaultDrawDataCell を実行する前に,ブラシのスタイルの値を bsClear にします.



[備考]
TDBGrid には,列番号と行番号によるセル指定の機能はありません.
TDBGrid には,TStringGrid の Cells プロパティのような,セルの文字列を取得したり,セルに文字列代入したりする機能はありません.



図16
選択中のセルの背景色を変更
図17
スクロールするとアクティブレコード (選択行) は変わる

リスト12
TDBGrid のアクティブレコードの選択セルの背景色を変更
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    procedure DrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LItemList : string;
  LIndex    : Integer;
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  // Options に dgRowSelect が含まれている行の選択になる
  plDBGrid1.Options := plDBGrid1.Options - [dgRowSelect];

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  LItemList := 'Company, Addr1, CustNo, State, City, Zip, Phone';
  Query1.SQL.Add('select ' + LItemList + ' from customer.db');
  Query1.Open;

  // テスト用にカラムの幅を変更して水平方向にスクロール
  // ColWidths, LeftCol は protected 部のプロパティ
  for LIndex := 3 to 6 do begin
    plDBGrid1.ColWidths[LIndex] := 70;
  end;
  plDBGrid1.LeftCol := 3;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  DrawDataCell メソッドの処理
//  選択セルの背景を指定した色にする
//=============================================================================
procedure TplDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
  inherited;

  if (gdSelected in State) then begin
    // 塗り潰しの色 (TBrush.Color で指定する)
    Canvas.Brush.Color := clSkyBlue;
    // 描画ルーチンを実行
   DefaultDrawDataCell(Rect, Field, State);
  end;
end;

end.




04_TDBGrid の選択行 ( アクティブレコード ) の背景色を変更


アクティブレコードの行の背景色を設定する例です.行はマウスの左ボタン押下で選択できます.
このサンプルは,Options に dgRowSelect が含まれていないと行の選択にはなません.dgRowSelect が含まれていない場合はセルの選択となります.

選択されている行が TDBGrid のアクティブなレコードです.TDBGrid ではアクティブなレコードは常に 1 つです.アクティブなレコードは常に TDBGrid の可視領域に表示されます.アクティブなレコードは垂直方向にスクロールすると移動します.したがって,選択行の位置も移動します.

背景色をグラデーションした場合は,指定列のデータセルの背景色の変更のサンプルの記事で述べたように,DefaultDrawColumnCell あるいは DefaultDrawDataCell を実行する前に,ブラシのスタイルの値を bsClear にします.



図18
選択行の背景色を変更
  • Options プロパティに dgRowSelect が必要

リスト13
TDBGrid の選択行の背景色を変更
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    procedure DrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LItemList : string;
  LIndex    : Integer;
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  // Options に dgRowSelect が含まれていないと行の選択にならない
  plDBGrid1.Options := plDBGrid1.Options + [dgRowSelect];

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  LItemList := 'Company, Addr1, CustNo, State, City, Zip, Phone';
  Query1.SQL.Add('select ' + LItemList + ' from customer.db');
  Query1.Open;

  // テスト表示用にカラムの幅を変更して水平方向にスクロール
  // ColWidths, LeftCol は protected 部のプロパティ
  for LIndex := 3 to 6 do begin
    plDBGrid1.ColWidths[LIndex] := 70;
  end;
  plDBGrid1.LeftCol := 3;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  DrawDataCell メソッドの処理
//  選択行の背景を指定した色にする
//  Options に dgRowSelect が含まれている場合のみ有効
//=============================================================================
procedure TplDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
  inherited;

  if (gdSelected in State) then begin
    // 塗り潰しの色 (TBrush.Color で指定する)
    Canvas.Brush.Color := clSkyBlue;
    // 描画ルーチンを実行
   DefaultDrawDataCell(Rect, Field, State);
  end;
end;

end.


Options プロパティに dgRowSelect が含まれていなくても,アクティブレコードの行の背景色を変更するサンプルです.
アクティブなレコードの TDBGrid の上端の行からの相対位置が TDataLink.ActiveRecord で取得できることを利用しています.


図19
アクティブレコードの行の背景色を変更
  • アクティブなレコードの行の背景色を変更する方式
  • Options プロパティに dgRowSelect がなくても行全体の選択となる

リスト14
TDBGrid のアクティブレコード行の背景色を変更
Options に dgRowSelect が含まれていなくてもアクティブレコードの行の背景色を変更
//=============================================================================
//  DrawDataCell メソッドの処理
//  現在アクティブなレコードの背景を指定した色にする
//  Options に dgRowSelect が含まれていなくても機能する
//=============================================================================
procedure TplDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
  inherited;

  if (Row - FixedRows) = DataLink.ActiveRecord then begin
    // 塗り潰しの色 (TBrush.Color で指定する)
    Canvas.Brush.Color := clWebBurlywood;
    if [dgRowSelect] * Options = [] then begin
      if gdSelected in State then begin
        Canvas.Brush.Color := clWebAquamarine;
      end;
    end;

    // 描画ルーチンを実行
   DefaultDrawDataCell(Rect, Field, State);
  end;
end;




05_TDBGrid の選択レコードの背景色を変更


選択したレコード行の背景色を変更するサンプルです.TBookMarkList の機能を利用しています・
TBookMarkList (ブックマークリスト) の機能は Options に dgRowSelect と dgMultiSelect が含まれていないと利用できませんが,このサンプルのように自前で TBookMarkList を操作すれば利用できます. このサンプルでは,選択レコードとアクティブなレコードは異なります.レコードに対する操作を実行する場合には注意が必要です.

このサンプルは,Options プロパティに dgRowSelect と dgMultiSelect が含まれていても,1 つのレコードしか選択できません.

背景色をグラデーションした場合は,指定列のデータセルの背景色の変更のサンプルの記事で述べたように,DefaultDrawColumnCell あるいは DefaultDrawDataCell を実行する前に,ブラシのスタイルの値を bsClear にします.



図20
選択レコードの背景色を変更
  • TBookMarkList の機能を利用
図21
選択レコードの背景色を変更
  • 選択レコードが,スクロールして見えなくなった状態
  • インジケータが表示されている行が現在アクティブなレコード

リスト15
TBookMarkList の機能を利用して,TDBGrid の選択レコードの背景色を変更する
//=============================================================================
//  KeyDown メソッドの処理
//=============================================================================
procedure TplDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LBookMarkList : TBookmarkList;
begin
  inherited;
//
  if Button = mbLeft then begin
    // 現在のブックマークのリストを取得してクリア
    // クリアするのはマウス押下のレコード番号のレコードだけを選択するため
    // Options に dgMultiSelect があっても複数選択にならない
    LBookMarkList := SelectedRows;
    LBookMarkList.Clear;
    // マウス押下したレコード番号のレコードをブックマークに追加
    LBookMarkList.CurrentRowSelected := True;
  end;
end;

//=============================================================================
//  DrawDataCell メソッドの処理
//  ブックマークのリスト内のレコード番号の行の背景を指定した色にする
//=============================================================================
procedure TplDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
  inherited;

  if (SelectedRows.CurrentRowSelected) then begin
    // 塗り潰しの色 (TBrush.Color で指定する)
    Canvas.Brush.Color := clWebDarkSeaGreen;
    // 描画ルーチンを実行
   DefaultDrawDataCell(Rect, Field, State);
  end;
end;




06_TDBGrid の特定条件のセルの背景色を変更


特定条件のセルの背景色を変更する例です.
このサンプルでは,項目名 (フィールド名) が State の「東京都」という文字列のセルだけの背景色を変更します.

背景色をグラデーションした場合は,指定列のデータセルの背景色の変更のサンプルの記事で述べたように,DefaultDrawColumnCell あるいは DefaultDrawDataCell を実行する前に,ブラシのスタイルの値を bsClear にします.



[備考]
TDBGrid には,列番号と行番号によるセル指定の機能はありません.
TDBGrid には,TStringGrid の Cells プロパティのような,セルの文字列を取得したり,セルに文字列代入したりする機能はありません.



図22
特定条件のセルの背景色を変更

リスト16
TDBGrid の特定条件のセルの背景色を変更
描画ルーチン内の判定条件文で決める
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    procedure DrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LItemList : string;
  LIndex    : Integer;
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  LItemList := 'Company, Addr1, CustNo, State, City, Zip, Phone';
  Query1.SQL.Add('select ' + LItemList + ' from customer.db');
  Query1.Open;

  // テスト表示用にカラムの幅を変更して水平方向にスクロール
  // ColWidths, LeftCol は protected 部のプロパティ
  for LIndex := 3 to 6 do begin
    plDBGrid1.ColWidths[LIndex] := 70;
  end;
  plDBGrid1.LeftCol := 3;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  DrawDataCell メソッドの処理
//  指定条件列のセル背景を指定した色で塗り潰す
//=============================================================================
procedure TplDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
var
  LRect : TRect;
begin
  inherited;

  if (Field.FieldName = 'State') and (Field.AsString = '東京都') then begin
    // 塗り潰しの矩形領域
    LRect := Rect;
    // 塗り潰しの色 (TBrush.Color で指定する)
    Canvas.Brush.Color := $00FFAAAA;
    // 描画ルーチンを実行
   DefaultDrawDataCell(LRect, Field, State);
  end;
end;

end.




07_TDBGrid の行を 1 行おきに背景色を変更


1 行おきに背景色を変更するサンプルです.

背景色をグラデーションした場合は,指定列のデータセルの背景色の変更のサンプルの記事で述べたように,DefaultDrawColumnCell あるいは DefaultDrawDataCell を実行する前に,ブラシのスタイルの値を bsClear にします.



図23
1 行おきに背景色を変更

1 行おきに背景色を変更

リスト17
1 行おきに背景色を変更
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from customer.db');
  Query1.Open;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  DrawDataCell メソッドの処理
//  1 行おきに行の色を変更する
//=============================================================================
procedure TplDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
begin
  inherited;

  if (Column.Field.DataSet.RecNo Mod 2) = 0 then begin
    Canvas.Brush.Color := clSkyBlue;
    DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
end;

end.




08_TDBGrid のインプレイスエディタの背景色と列の編集禁止


セルのテキスト編集時のセルの背景色を変更する例です.
セルが編集状態になる時にはインプレイスエディタが起動します.インプレイスエディタが起動する時に CanEditShow メソッドが実行されます.このメソッド内で処理します.


図24
セルのテキスト編集時の背景色を変更

リスト18
TDBGrid のインプレイスエディタの背景色を変更
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    function CanEditShow: Boolean; override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LItemList : string;
  LIndex    : Integer;
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  LItemList := 'Company, Addr1, CustNo, State, City, Zip, Phone';
  Query1.SQL.Add('select ' + LItemList + ' from customer.db');
  Query1.Open;

  // テスト用にカラムの幅を変更して水平方向にスクロール
  // ColWidths, LeftCol は protected 部のプロパティ
  for LIndex := 3 to 6 do begin
    plDBGrid1.ColWidths[LIndex] := 70;
  end;
  plDBGrid1.LeftCol := 3;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  TStringGridのCanEditShowメソッド
//  インプレースエディタが起動する時に実行される
//=============================================================================
function TplDBGrid.CanEditShow: Boolean;
begin
  Result := inherited CanEditShow;

  if InplaceEditor <> nil then  begin
    // セルの背景色
    InplaceEditor.Brush.Color := clLime;
  end;
end;

end.


インプレイスエディタの起動時に実行される CanEditShow メソッドの戻り値を False にすると,インプレイスエディタは起動しません.つまり,セルのテキストは編集できなくなります.


リスト19
特定項目のセルの編集を禁止する
//=============================================================================
//  TStringGridのCanEditShowメソッド
//  インプレースエディタが起動する時に実行される
//=============================================================================
function TplDBGrid.CanEditShow: Boolean;
begin
  Result := inherited CanEditShow;

  // 項目 Zip は編集不可とする
  if Columns[Col - fixedcols].FieldName = 'Zip' then begin
    Result := False;
    Exit;
  end;

  if InplaceEditor <> nil then  begin
    // セルの背景色
    InplaceEditor.Brush.Color := clLime;
  end;
end;


SelectCell メソッドをオーバライドして以下のようなコードにすると,特定の列のセルの編集を禁止できます.
集合型のプロパティの設定は Include, Exclude を使用した方が効率がいいとされています.集合型のオプションを直接は操作できないので,変数に代入してから操作します.


リスト20
SelectCell メソッドを使用した特定項目のセルの編集禁止
//=============================================================================
//  SelectCell メソッドの処理
//
//  特定の列のセルを編集禁止にする
//  選択は可能だが編集状態にはできなくなる
//=============================================================================
function TplDBGrid.SelectCell(ACol, ARow: Integer): Boolean;
var
  LOptions : TDBGridOptions;
begin
  Result := inherited SelectCell(ACol, ARow);

  LOptions := Options;
  if Columns[ACol - fixedcols].FieldName = 'Zip' then begin
    System.Exclude(LOptions, dgEditing);
  end else begin
    System.Include(LOptions, dgEditing);
  end;
  Options := LOptions;
end;


SelectCell メソッドの戻り値を False にしても特定の列のセルの編集を禁止できます.この方法は,編集禁止したセルを選択できなくなり,[TAB] キーや矢印キーでセルの移動ができなくなります.


リスト21
SelectCell メソッドを使用した特定項目のセルの編集禁止
//=============================================================================
//  SelectCell メソッドの処理
//
//  特定の列のセルを編集禁止にする
//  編集禁止のセルは選択できなくなる
//  キー操作 ([TAB], 矢印) でセルの移動が不可になる
//=============================================================================
function TplDBGrid.SelectCell(ACol, ARow: Integer): Boolean;
begin
  Result := inherited SelectCell(ACol, ARow);

  if Columns[ACol - fixedcols].FieldName = 'Zip' then begin
    Result := False;
  end;
end;




09_TDBGrid のセルに描画するテキストのカスタマイズ


これまでのサンプルはセルの背景設定のサンプルでした.それらのサンプルでは以下のメソッドを使用しています.
  • DrawColumnCell (OnDrawColumnCell イベント) を使用した時は DefaultDrawColumnCell
  • DrawDataCell (OnDrawDataCell イベント) を使用した時はは DefaultDrawDataCell

これらのメソッドは,現在の TCanvas.Brush の設定でセルの背景を描画し,デフォルトの設定でセルのテキストを描画します.セルのテキストを自前でカスタム描画する場合は,これらのメソッドは使用しません.

以下は,項目 Zip の文字列の先頭に文字を追加し,セルの文字列を上下の中央に描画する例です.



[備考]
テキストを領域の上下中央に描画するには,TTextFormat に tfVerticalCenter, tfSingleLine が必要です.つまり,上下中央に描画する時は 1 行だけの描画となり,改行文字は無視されます.



図25
データセルのテキストのカスタム描画
  • 項目 Zip の値の先頭に文字を追加
  • 文字列をセルの上下の中央に描画

実行結果を確認するために,Button1 をクリックして行の高さを高くしてみます.
セリのテキストが,セルの上下中央に描画されていることが確認できます.


図26
データセルのテキストのカスタム描画
  • 行の高さを高くして結果を確認
  • 文字列が上下中央に描画されている

カスタム描画をしない場合は,下図のように,テキストはセルの左上を基準に描画されます.


図27
データセルのテキストのカスタム描画
  • デフォルトの描画の場合
  • 文字列は左上から描画される

リスト22
データセルのテキストのカスタム描画の例
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LItemList : string;
  LIndex    : Integer;
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  LItemList := 'Company, Addr1, CustNo, State, City, Zip, Phone';
  Query1.SQL.Add('select ' + LItemList + ' from customer.db');
  Query1.Open;

  // テスト用にカラムの幅を変更して水平方向にスクロール
  // ColWidths, LeftCol は protected 部のプロパティ
  for LIndex := 3 to 6 do begin
    plDBGrid1.ColWidths[LIndex] := 70;
  end;
  plDBGrid1.LeftCol := 3;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

//=============================================================================
//  行の高さを変更 (トグル)
//  DefaultRowHeight は protected 部のプロパティ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if plDBGrid1.DefaultRowHeight <> 16 then begin
    plDBGrid1.DefaultRowHeight := 16;
  end else begin
    plDBGrid1.DefaultRowHeight := 30;
  end;
  plDBGrid1.SetFocus;
end;

//=============================================================================
//  カスタム描画をする場合としない場合の違いの確認用
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  plDBGrid1.Invalidate;
  plDBGrid1.SetFocus;
end;

{ TplDBGrid }

//=============================================================================
//  DrawColumnCell メソッドの処理
//  以下の動作確認
//  (1) 選択されているセルの背景色を変更
//  (2) データを加工してセルに表示
//  (2) カスタム描画とデフォルトの場合のテキスト描画のアライメントの違い
//=============================================================================
procedure TplDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
var
  LRect     : TRect;
  LFormat   : TTextFormat;
  LCellText : string;
begin
  inherited;

  // 選択セルの背景色を変更
  if gdSelected in State then begin
    Canvas.Brush.Color := $0000FB00;
  end;

  // セル描画テキストを設定
  // 項目名が Zip の時は先頭に文字を追加
  LCellText := Column.Field.DisplayText;
  if Column.Field.FieldName = 'Zip' then begin
    LCellText := '〒' + LCellText;
  end;

  if Form1.CheckBox1.Checked then begin
    // テータの文字列をデフォルト描画(背景色は TCanvas.Brush.Color)
    DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end else begin
   // セルの背景を塗り潰す
   Canvas.FillRect(Rect);

    // セル描画フォントを設定
    Canvas.Font := Column.Font;

    // テキスト描画ノアライメントを取得
    case Column.Alignment of
      taLeftJustify  : LFormat := [tfLeft];
      taRightJustify : LFormat := [tfRight];
    else
      LFormat := [tfCenter];
    end;
    LFormat := LFormat + [tfVerticalCenter, tfSingleLine];

    // データをを描画
    LRect := Rect;
    InflateRect(LRect, -2, 0);
    Canvas.TextRect(LRect, LCellText, LFormat);
  end;
end;

end.


上のテストで TDBGrid の行の高さを変更していますが,TDBGrid の行の高さは RowHeights プロパティを使用して個別に設定可能です.


図28
行の高さの設定
  • タイトル行以外は全て同じ高さにした結果

リスト23
行の高さは個別に変更できる
//=============================================================================
//  行の高さは個別に設定可能
//  RowHeights,RowCount は protected 部のプロパティ
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Lindex : Integer;
begin
  // 固定行の高さ
  plDBGrid1.RowHeights[0] := 20;

  // 固定行以外の高さ
  for Lindex := 1 to  plDBGrid1.RowCount - 1 do begin
    plDBGrid1.RowHeights[Lindex] := 30;
  end;
  plDBGrid1.SetFocus;
end;


セルの表示テキストをカスタム描画する時はセルの背景も描画する必要があります.
カスタム描画用のメソッドやイベント内の処理は,実際にはデフォルトの描画への「上書き描画」です.セルの背景を描画しないとデフォルトの描画内容も表示された状態,重ね描画の状態となります.
上のサンプルコードでは,単色でセルの背景を塗り潰していますが,以下のメソッドを使用すればデフォルトの背景描画となります.

  • DrawCellHighlight メソッド
  • DrawCellBackground メソッド
これらのメソッドを使用すれば,TGridDrawState の値に応じた処理をしてくれます.以下は,これらのメソッドを使用する例です.


図29
データセルのテキストのカスタム描画
  • セルの背景を描画した場合
図30
データセルのテキストのカスタム描画
  • セルの背景を描画しない場合
  • 重ね描画の状態になる

リスト24
データセルのテキストのカスタム描画の例
セルの背景をデフォルトの描画にする例.セルの背景は必ず描画が必要
//=============================================================================
//  DrawColumnCell メソッドの処理
//  セルのテキスト (文字列) だけをカスタマイズ描画する場合
//  背景の描画も行う必要がある
//=============================================================================
procedure TplDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
var
  LRect     : TRect;
  LColor    : TColor;
  LFormat   : TTextFormat;
  LCellText : string;
begin
  inherited;

  // 背景の描画
  if not Form1.CheckBox1.Checked then begin
    // これを実行しないとテキストの描画が重なってしまう
    if (gdSelected in State) then begin
      DrawCellHighlight(Rect, State, DataCol, Row);
    end else begin
      // 第 2 引数は戻り値 ($00000001)
      DrawCellBackground(Rect, LColor, State, DataCol, Row);
    end;
  end;


  // セル描画テキストを設定
  // 項目名が Zip の時は先頭に文字を追加
  LCellText := Column.Field.DisplayText;
  if Column.Field.FieldName = 'Zip' then begin
    LCellText := '〒' + LCellText;
  end;

  // テキスト描画ノアライメントを取得
  // 全て縦方向は真ん中に
  case Column.Alignment of
    taLeftJustify  : LFormat := [tfLeft];
    taRightJustify : LFormat := [tfRight];
  else
    LFormat := [tfCenter];
  end;
  LFormat := LFormat + [tfVerticalCenter, tfSingleLine];


  // セル描画フォントを設定
  // 全て太文字にする
  Canvas.Font := Column.Font;
  if DataCol = 3 then Canvas.Font.Color := clGreen;
  if DataCol = 4 then Canvas.Font.Color := clRed;
  Canvas.Font.Style := [fsBold];

  // データをを描画
  LRect := Rect;
  InflateRect(LRect, -2, 0);
  Canvas.TextRect(LRect, LCellText, LFormat);
end;




10_TDBGrid のタイトル行の背景色を変更


TDBGrid のタイトル行は固定行です.固定行と固定列のカスタム描画は,データセルのカスタム描画用のメソッドやイベントではできません.オーバライドした DrawCell メソッドで処理します.DrawCell メソッドに相当するイベントはありません.テーマが有効な場合,タイトル行のカスタム描画は,継承クラスでないと処理できません.

TDBGrid のタイトル行のセルの背景は,下図のように状況に応じて変化します.本項のサンプルは,この状況に応じた変化に対応する処理はありません.



[備考 1]
タイトル行は,削除したり非表示にできませんか,行の高さを -1 にすれば,事実上非表示と同じとなります.タイトル行多の高さは,TDBGrid1.RowHeights[0] := 30; のように設定します.
RowHeights は protected 部のプロパティです.



図31
タイトル行のセルの背景
  • 通常の状態
図32
タイトル行のセルの背景
  • マウスカーバ (gdHotTrack) の状態
図33
タイトル行のセルの背景
  • マウスボタン押下 (gdPressed) の状態

実際にタイトル行のセルの背景色を変更する例です.
固定行と固定列を DrawCell メソッドでカスタム描画する場合は,テキストの描画も必要です.

DrawCell メソッド内ではデータセットのデータは正常に取得できません.ARow = 0 の条件が必要です.DrawCell メソッド内でデータセルの描画を行っても正常な結果とはなりません.



[備考 2]
テキストを領域の上下中央に描画するには,TTextFormat に tfVerticalCenter, tfSingleLine が必要です.つまり,上下中央に描画する時は 1 行だけの描画となり,改行文字は無視されます.



図34
タイトル行の背景色を変更

リスト25
TDBGrid のタイトル行の背景色を変更
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    procedure DrawCell(ACol: Integer; ARow: Integer; ARect: TRect;
      AState: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LItemList : string;
  LIndex    : Integer;
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  LItemList := 'Company, Addr1, CustNo, State, City, Zip, Phone';
  Query1.SQL.Add('select ' + LItemList + ' from customer.db');
  Query1.Open;

  // テスト表示用にカラムの幅を変更して水平方向にスクロール
  // ColWidths, LeftCol は protected 部のプロパティ  
  for LIndex := 3 to 6 do begin
    plDBGrid1.ColWidths[LIndex] := 70;
  end;
  plDBGrid1.LeftCol := 3;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  DrawCell メソッド処理
//  固定行 ( タイトル行 ) の背景色を変更
//
//  DrawColumnCell. DrawDataCell では固定列のタイトルは描画できない
//  DrawCell に対応する外部イベントはない
//
//  この DrawCell の段階ではデータの値は正常に取得できない
//  DrawCell でデータセルの背景やデータを描画すると正常に描画されない
//=============================================================================
procedure TplDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  LColor    : TColor;
  LRect     : TRect;
  LColumn   : TColumn;
  LColText  : string;
  LFormat   : TTextFormat;
begin
  inherited;

   // ACol = 0 はタイトル行
   // データ ACol は 1 から
  if (ACol >= 4) and (ACol <= 6) and (ARow = 0) then begin
    case ACol of
      4: LColor := $007171FF;
      5: LColor := $0000D900;
      6 :LColor := $00FFAAAA;
    else
      LColor := Color;
    end;

    // 背景の塗り潰し
    LRect := ARect;
    Canvas.Brush.Color := LColor;
    Canvas.FillRect(LRect);

    // カラム間の線
    Canvas.Pen.Color := clSilver;
    Canvas.MoveTo(LRect.Left, LRect.Top + 1);
    Canvas.LineTo(LRect.Left, LRect.Bottom - 1);   

    // タイトルのキャプションを描画
    // 上の塗り潰しの実行で文字列も塗り潰されている
    LColumn  := Columns[ACol];
    LColText := LColumn.Title.Caption;

    // テキスト描画ノアライメントを取得
    case LColumn.Title.Alignment of
      taLeftJustify  : LFormat := [tfLeft];
      taRightJustify : LFormat := [tfRight];
    else
      LFormat := [tfCenter];
    end;
    // テキストを描画
    LFormat := LFormat + [tfVerticalCenter, tfSingleLine];
    Canvas.TextRect(ARect, LColText, LFormat);
  end;
end;

end.

TDBGrid のタイトル行の背景色をグラデーションにする例です.
グラデーションの終端色を決めるのに,添付のユニット内の関数を使用しています.


図35
タイトル行の背景色を変更
  • グラデーションにした結果

リスト26
TDBGrid のタイトル行の背景色を変更.グラデーションにする例
//=============================================================================
//  DrawCell メソッド処理
//  固定行の背景色を変更
//  グラデーション描画にしてみる
//
//  DrawColumnCell. DrawDataCell では固定列のタイトルは描画できない
//  DrawCell に対応する外部イベントはない
//
//  この DrawCell の段階ではデータの値は正常に取得できない
//  DrawCell でデータセルの背景やデータを描画すると正常に描画されない
//
//  uses に GraphUtil と plCalcGradColor (添付のユニット) が必要
//=============================================================================
procedure TplDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  LStartColor : TColor;
  LEndColor   : TColor;
  LRect       : TRect;
  LColumn     : TColumn;
  LColText    : string;
  LFormat     : TTextFormat;
begin
  inherited;

   // ACp; = 0 は固定列
   // データ ACol は 1 から
  if (ACol >= 4) and (ACol <= 6) and (ARow = 0) then begin
    if ACol = 4 then begin
      LStartColor := $007171FF;
      LEndColor   := CalcGradEndColor(LStartColor, 60);
    end else
    if ACol = 5 then begin
      LStartColor := $0000D900;
      LEndColor   := CalcGradEndColor(LStartColor, 60);;
    end else
    if ACol = 6 then begin
      LStartColor := $00FFAAAA;
      LEndColor   := CalcGradEndColor(LStartColor, 60);
    end else begin
      LStartColor := FixedColor;
      LEndColor   := FixedColor;
    end;

    // 背景の塗り潰し
    LRect := ARect;
    // グラデーションで塗り潰し (uses に GraphUtil が必要)
    SetBkMode(Canvas.Handle, TRANSPARENT);
    GradientFillCanvas(Canvas, LStartColor, LEndColor, LRect, gdVertical);

    // カラム間の線
    Canvas.Pen.Color := clSilver;
    Canvas.MoveTo(LRect.Left, LRect.Top + 1);
    Canvas.LineTo(LRect.Left, LRect.Bottom - 1);

    // タイトルのキャプションを描画
    // 上の塗り潰しの実行で文字列も塗り潰されている
    LColumn  := Columns[ACol - 1];
    LColText := LColumn.Title.Caption;

    // テキスト描画ノアライメントを取得
    case LColumn.Title.Alignment of
      taLeftJustify  : LFormat := [tfLeft];
      taRightJustify : LFormat := [tfRight];
    else
      LFormat := [tfCenter];
    end;
    // テキストを描画
    InflateRect(LRect, -2, -2);
    LFormat := LFormat + [tfVerticalCenter, tfSingleLine];
    Canvas.TextRect(LRect, LColText, LFormat);
  end;
end;




11_TDBGrid のタイトル行のテキストのカスタマイズ


TDBGrid のタイトル行は固定行です.固定行と固定列のカスタム描画は,データセルのカスタム描画用のメソッドやイベントではできません.オーバライドした DrawCell メソッドで処理します.DrawCell メソッドに相当するイベントはありません.タイトル行のテキストのカスタム描画は,継承クラスでないと処理できません.

セルの表示テキストをカスタム描画する時はセルの背景も描画する必要があります.
カスタム描画用の処理は,実際にはデフォルトの描画への「上書き描画」です.セルの背景を描画しないとデフォルトの描画内容も表示された状態,重ね描画の状態となります.
以下のメソッドを使用すればデフォルトの背景描画となります.


  • DrawCellHighlight メソッド
  • DrawCellBackground メソッド

これらのメソッドを使用すれば,メソッドの引数 AState (TGridDrawState 型) の値に応じた処理を自動で処理してくれます.

DrawCell メソッド内ではデータセットのデータは正常に取得できません.ARow = 0 の条件が必要です.DrawCell メソッド内でデータセルの描画を行っても正常な結果とはなりません.



[備考]
テキストを領域の上下中央に描画するには,TTextFormat に tfVerticalCenter, tfSingleLine が必要です.つまり,上下中央に描画する時は 1 行だけの描画となり,改行文字は無視されます.



図36
タイトル行のテキストのカスタム描画
  • セルの背景の描画を実行した場合
図37
タイトル行のテキストのカスタム描画
  • セルの背景の描画実行しない場合
  • 重ね描画の状態になっている

リスト27
TDBGrid のタイトル行のテキストのカスタマイズ
//=============================================================================
//  DrawCell メソッド処理
//  固定行 (タイトル行) の描画を変更
//  テキスト (文字列) だけをカスタム描画する場合も背景の描画が必要
//=============================================================================
procedure TplDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  LRect    : TRect;
  LColor   : TColor;
  LColumn  : TColumn;
  LColText : string;
  LFormat  : TTextFormat;
begin
  inherited;

   // ACpl = 0 は固定列
   // データ ACol は 1 から
  if (ACol >= 4) and (ACol <= 6) and (ARow = 0) then begin

    // 背景の描画
    if not Form1.CheckBox1.Checked then begin
      // これを実行しないとテキストの描画が重なってしまう
      if (gdSelected in AState) then begin
        DrawCellHighlight(ARect, AState, ACol, Row);
      end else begin
        // 第 2 引数は戻り値 ($00000001)
        DrawCellBackground(ARect, LColor, AState, ACol, Row);
      end;
    end;


    // タイトルのキャプションを描画
    LColumn  := Columns[ACol - 1];
    LColText := LColumn.Title.Caption;

    // フォントの属性を変えてみる
    Canvas.Font := LColumn.Font;
    Canvas.Font.Color := clRed;

    // テキスト描画ノアライメントを取得
    case LColumn.Title.Alignment of
      taLeftJustify  : LFormat := [tfLeft];
      taRightJustify : LFormat := [tfRight];
    else
      LFormat := [tfCenter];
    end;

    LRect := ARect;

    // テキストを描画
    InflateRect(LRect, -2, -2);
    LFormat := LFormat + [tfVerticalCenter, tfSingleLine];
    Canvas.TextRect(LRect, LColText, LFormat);
  end;
end;




12_TDBGrid のインジケータの列の背景色を変更


TDBGrid のインジケータの列は固定列です.固定行と固定列のカスタム描画は,データセルのカスタム描画用のメソッドやイベントではできません.オーバライドした DrawCell メソッドで処理します.DrawCell メソッドに相当するイベントはありません.インジケータの列のカスタム描画は,継承クラスでないと処理できません.

TDBGrid のインジケータはビットマップ画像です.インジケータのセルの背景色を変更すると,このインジケータは表示されなくなります.このサンプルでは,代わりに文字 '■' を描画しています.
インジケータのスタイルは編集等の状態で変わります.それに対応した処理を追加する必要があるかも知れません.

DrawCell メソッド内ではデータセットのデータは正常に取得できません.ARow = 0 の条件が必要です.DrawCell メソッド内でデータセルの描画を行っても正常な結果とはなりません.



[備考 1]
TDBGrid のインジケータの列幅は変更できません.内部で固定の値に設定されています.Delphi XE では 11 となっています.


[備考 2]
TDBGrid のインジケータの列は削除はできませんが非表示にはできす. インジケータの列を非表示にするには,Options プロパティから dgIndicatorを除外します.オブジェクトインスペクタで設定する場合は Options プロパティの dgIndicator の値を False にします.



図38
インジケータ列の背景色変更
  • インジケータは文字 '■' を使用

リスト28
TDBGrid のインジケータの列の背景色を変更
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    procedure DrawCell(ACol: Integer; ARow: Integer; ARect: TRect;
      AState: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from customer.db');
  Query1.Open;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  DrawCell メソッド処理
//  固定列 (インジケータ) の背景色を変更
//
//  DrawColumnCell. DrawDataCell では固定列の描画はできない
//  DrawCell に対応する外部イベントはない
//
//  この DrawCell の段階ではデータの値は正常に取得できない
//  DrawCell でデータセルの背景やデータを描画すると正常に描画されない
//=============================================================================
procedure TplDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  LRect   : TRect;
  LFormat : TTextFormat;
  LText   : string;
begin
  inherited;

  if (gdFixed in AState) then begin
    if (dgIndicator in Options) and (ACol = 0) and (ARow > 0) then begin
      // 背景を塗り潰す
      LRect := ARect;
      Canvas.Brush.Color := clGreen;
      Canvas.FillRect(LRect);

      // インジケータの画像の代わりに文字を描画
      // 上の塗り潰しで三角形の矢印のビットマップ画像も塗り潰されている
      if (ARow - FixedRows) = DataLink.ActiveRecord then begin
        InflateRect(LRect, -2, -2);
        Canvas.Font.Color := clWhite;
        LText  := '■';
        LFormat := [tfCenter, tfVerticalCenter, tfSingleLine];
        Canvas.TextRect(LRect, LText, LFormat);
      end;
    end;
  end;
end;

end.


インジケータとして,三角形の矢印を描画する例です.


図39
インジケータ列の背景色変更
  • インジケータとして三角形の矢印を描画

リスト29
TDBGrid のインジケータの列の背景色を変更.インジケータとして三角形の矢印を描画する例
//=============================================================================
//  DrawCell メソッド処理
//  固定列 (インジケータ) の背景色を変更
//
//  三角形の矢印を描画
//  uses に GraphUtil が必要
//=============================================================================
procedure TplDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  LRect : TRect;
  LSize : Integer;
  LLeft : Integer;
  LTop  : Integer;
begin
  inherited;

  if (gdFixed in AState) then begin
    if (dgIndicator in Options) and (ACol = 0) and (ARow > 0) then begin
      // 背景を塗り潰す
      LRect := ARect;
      Canvas.Brush.Color := clSkyBlue;
      Canvas.FillRect(LRect);

      if (ARow - 1) = DataLink.ActiveRecord then begin
        // 三角形の矢印を描画  (uses に GraphUtil が必要)
        // 上の塗り潰しで三角形の矢印のビットマップ画像も塗り潰されている

        LRect := ARect;

        LSize := IndicatorWidth div 2;
        LLeft := ((LRect.Left + LRect.Right) - LSize) div 2;
        LTop  := (LRect.Top + LRect.Bottom) div 2 - LSize;

        Canvas.Pen.Color := clBlack;
        DrawArrow(Canvas, sdRight, Point(LLeft, LTop), LSize);
      end;
    end;
  end;
end;


インジケータとして,Themes の機能を使用して三角形の矢印を描画する例です.


//=============================================================================
//  DrawCell メソッド処理
//  固定列 (インジケータ) の背景色を変更
//
//  三角形の矢印を描画
//  uses に Themes が必要
//=============================================================================
procedure TplDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  LRect    : TRect;
  LSize    : Integer;
  LDetails : TThemedElementDetails;
begin
  inherited;

  if (gdFixed in AState) then begin
    if (dgIndicator in Options) and (ACol = 0) and (ARow > 0) then begin
      // 背景を塗り潰す
      LRect := ARect;
      Canvas.Brush.Color := clSkyBlue;
      Canvas.FillRect(LRect);

      if (ARow - 1) = DataLink.ActiveRecord then begin
        // 三角形の矢印を描画  (uses に Themes が必要)
        // 上の塗り潰しで三角形の矢印のビットマップ画像も塗り潰されている

        LRect := ARect;
        LRect.Left := LRect.Left - 3;
        LDetails := StyleServices.GetElementDetails(tspMoreProgramsArrowNormal);
        StyleServices.DrawElement(Canvas.Handle, LDetails, LRect, nil);
      end;
    end;
  end;
end;




13_TDBGrid の特定の列にボタンを描画


TDBGrid の特定の列にボタンを描画する例です.描画結果の画像は TButton と同じですが,TButton のインスタンス (実体) が生成されるわけではありません.

マウスクリックの検出には Click メソッド,CellClick メソッド (OnCellClick イベント) がありますが,Click メソッドは,マウスボタン押下だけでなく,[TAB] キーや矢印キーの操作,あるいはスクロール操作で別のセルが選択された時も発生します.ボタンを描画しているセルが選択されただけでボタンクリックとなっては都合が悪いことがあります.このサンプルコードでは CellClick メソッドを使用しています.

クリックの操作は MouseDonw, MouseUP ですから,MouseUp メソッドを使用した方が便利かも知れません.MouseUp であれば,引数からマウスカーソルの座標を取得できます.

このサンプルでは,画像を格納している項目の列にボタンを描画しています.
ボタンを描画したセルが編集状態になっても意味がありませんから,ボタンを配置した列のセルは編集禁止の処理をしています.
列の移動があっても動作するように,TField の FieldName プロパティで列を特定しています.

これらのボタンは,セルが編集状態になると非表示になります.そこで,SelectCell メソッド内で,ボタンを描画したセルの編集禁止の処理をしています.



図40
特定の列にボタンを描画
  • ボタンクリックでダイアログを表示

リスト30
TDBGrid の特定の列にボタンを描画
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    FSaveOptions : TDBGridOptions;
    function SelectCell(ACol: Integer; ARow: Integer): Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
    procedure CellClick(Column: TColumn); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo,
  Themes;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from biolife.db');
  Query1.Open;

  // テスト用の項目が見えるように右にスクロール
  plDBGrid1.LeftCol := 5;

  // 現在の Options プロパティの設定を退避
  plDBGrid1.FSaveOptions := plDBGrid1.Options;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  CellClick メソッド処理
//  ボタンを描画しているセルをクリックした時の処理
//  Click メソッドはセルを選択すると発生するので適切とは言えない
//
//  ボタンは画像としての描画であって,TButtpn のインスタンスではない
//  Click 等のイベントが使用できるわけではない
//=============================================================================
procedure TplDBGrid.CellClick(Column: TColumn);
var
  LMousePos : TPoint;
  LGridPos  : TGridCoord;
  LKey      : WORD;
begin
  inherited;

   LMousePos := HitTest;
  // 座標値をグリッドの行と列の値に変換
  LGridPos := MouseCoord(LMousePos.X, LMousePos.Y);

  // MouseDown でアクティブになったレコードが対象
  // それ以外の場所で MouseUp した場合は動作させない
  if (LGridPos.Y - FixedRows) = DataLink.ActiveRecord then begin
    if Columns[LGridPos.X - 1].FieldName = Column.FieldName then begin
      LKey := VK_RETURN;
      KeyDown(LKey, []);
    end;
  end;
end;

//=============================================================================
//  LeuDpwm メソッド処理
//  [Enter] キーでボタンクリックと同じ動作をさせる
//=============================================================================
procedure TplDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;

  if Key = VK_RETURN then begin
    if Columns[Col - 1].Field.FieldName = 'Graphic' then begin
      MessageBox(Handle, 'これは画像です', 'データ情報', MB_ICONINFORMATION);
      SetFocus;
    end;
  end;
end;

//=============================================================================
//  SelectCell メソッド処理
//  ボタンを描画した列のセルは編集禁止とする
//=============================================================================
function TplDBGrid.SelectCell(ACol, ARow: Integer): Boolean;
var
  LOptions : TDBGridOptions;
begin
  Result := inherited SelectCell(ACol, ARow);

  // 退避しておいた Options プロパティを操作用の変数に代入
  LOptions := FSaveOptions;
  if Columns[ACol - fixedcols].FieldName = 'Graphic' then begin
    System.Exclude(LOptions, dgEditing);
  end;
  Options := LOptions;
end;

//=============================================================================
//  DrawColumnCell メソッドの処理
//  特定の列にテーマ対応のボタンの画像を描画する
//
//  uses に Themes が必要
//=============================================================================
procedure TplDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
var
  LRect     : TRect;
  LBtnTheme : TThemedButton;
  LDetails  : TThemedElementDetails;
  LFormat   : TTextFormat;
  LText     : string;
begin
  inherited DrawColumnCell(Rect, DataCol, Column, State);

  if (Column.Field.FieldName = 'Graphic') then begin
    // 引数の State の値に応じてボタンの画像を変更
    LBtnTheme := tbPushButtonNormal;
    if gdPressed  in State then LBtnTheme := tbPushButtonPressed;
    if gdSelected in State then LBtnTheme := tbPushButtonDefaulted;
    if gdHotTrack in State then LBtnTheme := tbPushButtonHot;

    // ボタンを描画
    LRect := Rect;
    LDetails := StyleServices.GetElementDetails(LBtnTheme);
    StyleServices.DrawElement(Canvas.Handle, LDetails, LRect, nil);

    // 文字列を描画
    LFormat := [tfCenter, tfVerticalCenter, tfSingleLine];
    LRect := Rect;
    LText := '画像表示';
    Canvas.TextRect(LRect, LText, LFormat);
  end;
end;

end.


ボタンのテキストは,StyleServices を使用して次のように描画することもできます.



リスト31
StyleServices を使用したボタンの Caption の描画
    // 文字列を描画 (ボタンの Caption)
    LRect :=  Rect;
    StyleServices.DrawText(Canvas.Handle,
                           LDetails,
                           '画像表示',
                           LRect,
                           [tfCenter, tfVerticalCenter, tfSingleLine]);


セルの右端に矢印記号付きのボタンを描画し,そのボタン領域をクリックすると選択リストのウィンドウを表示する例です.

選択リスト用のウィンドウは,添付のポップアップ表示する TListBox を使用しています.セルを編集状態にするとボタンはインプレイスエディタに隠れて見えなくなります.そこで,SelectCell メソッド内で,ボタンを描画したセルの編集禁止の処理をしています.
したがって,リストから選択したデータ以外は入力させない,できない用途向きと言えます.



図41
ボタンクリックで選択リストを表示する例
図42
選択セルの背景色と TListBox の背景色を変更した例

リスト32
ボタンクリックで選択リストを表示する例.拙作の TplPopupListBox コンポーネントを使用
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls, plPopupListBox;

type
  TplDBGrid = class(TDBGrid)
  protected
    FPopUpListBox : TplPopupListBox;
    FBtnWidth : Integer;
    FSaveOptions : TDBGridOptions;
    FPopShowFlag : Boolean;
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
    function SelectCell(ACol: Integer; ARow: Integer): Boolean; override;
    procedure CellClick(Column: TColumn); override;
    procedure SetParent(AParent: TWinControl); override;
    procedure OnplPopupListBox1CloseUp(Sender: TObject);
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    Database1: TDatabase;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo,
  Themes,
  Types;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  // データベースの設定
  Query1.Close;
  Database1.Connected := False;
  Database1.DatabaseName := 'DBDEMOS';
  Database1.TransIsolation := tiDirtyRead;

  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;
  Query1.DatabaseName  := Database1.DatabaseName;

  // 更新可能にする
  Query1.RequestLive := True;

  // データベースからデータを取得して表示
  Query1.SQL.Clear;
  Query1.SQL.Add('select CustNo, Company, State, City from customer.db');
  Query1.Open;
  plDBGrid1.Columns[1].Width := 140;
  plDBGrid1.Columns[2].Width := 100;

  // トランザクション開始
  Database1.StartTransaction;

  // 現在の Options プロパティの設定を退避
  plDBGrid1.FSaveOptions := plDBGrid1.Options;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  // テストなのでコミット (更新) しない
  Database1.Rollback;

  // データベースを閉じる
  Query1.Close;
  Database1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  TplDBGrid のデコンストラクタ
//=============================================================================
destructor TplDBGrid.Destroy;
begin
  FreeAndNil(FPopUpListBox);
  inherited;
end;

//=============================================================================
//  TplDBGrid の SetParent メソッド処理
//  ポップアップ表示する TListBox のインスタンスを生成
//  拙作の TplPopupListBox コンポーネントを使用
//
//  選択リストの選択行の既定の値はおそらく以下の値
//    FPopUpListBox.SelBackColor := clHighlight;
//    FPopUpListBox.SelFontColor := clWhite;
//=============================================================================
procedure TplDBGrid.SetParent(AParent: TWinControl);
begin
  inherited;
  if AParent = nil then Exit;

  if not Assigned(FPopUpListBox) then begin
    // ポップアップ表示する TListBox の生成と設定
    FPopUpListBox := TplPopupListBox.Create(Self);
    FPopUpListBox.Parent := Self;

    FPopUpListBox.OnCloseUp    := OnplPopupListBox1CloseUp;
    FPopUpListBox.DefaultDraw  := False;
    FPopUpListBox.FocusRect    := False;

   // Style プロパティの値を lbOwnerDrawFixed にして ItemHeight の値を変更
    FPopUpListBox.Style := lbOwnerDrawFixed;
    FPopUpListBox.ItemHeight := 20;
  end;

  FBtnWidth := 17;
end;

//=============================================================================
//  KeyDown メソッド (OnKeyDown イベント相当) 処理
//  [Alt] + [↓] キーでポップアップ表示する TListBox のアイテムを作成してを表示
//=============================================================================
procedure TplDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
var
  LCellRect : TRect;
  LShowPos  : TPoint;
  LItemIdx  : Integer;
begin
  if SelectedField.FieldName = 'State' then begin
    // セルの編集モードのトグルは [Enter]
    //  ドロップダウン表示はセルの値の編集の位置で含める場合
    if ((Key = VK_DOWN) and (ssAlt in Shift)) or (Key = VK_RETURN) then begin

      with FPopUpListBox.Items do begin
        BeginUpdate;
        Clear;
        Add('富山県');
        Add('岩手県');
        Add('山形県');
        Add('長野県');
        Add('山梨県');
        Add('埼玉県');
        Add('群馬県');
        Add('新潟県');
        EndUpdate;
      end;

      // 行と列の値からセルの矩形領域 TRect の値を取得
      LCellRect := CellRect(Col, Row);

      FPopUpListBox.Width := LCellRect.Right - LCellRect.Left;
      FPopUpListBox.IntegralHeight := True;
      FPopUpListBox.DropDownRows   := 6;

      // 位置を指定してポップアップ TListBox を表示
      // TListBox を表示する時は Key の値を 0 にする
      LShowPos :=  ClientToScreen(Point(LCellRect.Left, LCellRect.Bottom));
      FPopUpListBox.ShowBeneath(LShowPos.X, LShowPos.y);
      Key := 0;

      // セルの表示と同じ文字列を選択状態にする
      LItemIdx := FPopUpListBox.Items.IndexOf(SelectedField.Text);
      if LItemIdx < 0 then LItemIdx := 0;
      FPopUpListBox.ItemIndex := LItemIdx;
    end;
  end;

  inherited KeyDown(Key, Shift);//
end;

//=============================================================================
//  CellClick メソッド (CellClick イベント相当) 処理
//  ボタンをクリックした時の処理
//  ポップアップ表示する TListBox のアイテムを作成して TListBox を表示する
//
//  Click メソッドはセルを選択すると発生するので適切とは言えない
//=============================================================================
procedure TplDBGrid.CellClick(Column: TColumn);
var
  LBtnRect : TRect;
  LKeyCode : WORD;
begin
  inherited;

  // TListBox が表示状態でクリックしたら TListBox が閉じるようにフラグを使用
  if FPopShowFlag then begin
    FPopShowFlag := False;
    Exit;
  end;
  FPopShowFlag := True;


  // MouseDown でアクティブになったレコードが対象
  // それ以外の場所で MouseUp した場合は動作させない
  if (Row - FixedRows) <> DataLink.ActiveRecord then Exit;
  if SelectedField.FieldName <> Column.FieldName then Exit;


  // FieldName は KeyDown で判定しているので,なくても動作可能
  if Column.FieldName = 'State' then begin
    // 行と列の値からセルの矩形領域 TRect の値を取得
    LBtnRect := CellRect(Col, Row);

    // ボタンの描画領域を取得
    LBtnRect.Left := LBtnRect.Right - FBtnWidth;

    // マウスカーソルの位置がボタンの矩形領域内かをチェック
    if LBtnRect.Contains(Point(HitTest.X, HitTest.Y)) then begin
      LKeyCode := VK_DOWN;
      KeyDown(LKeyCode, [ssAlt]);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  TplPopupListBoxコンポのOnCloseUpイベント処理
//  項目をクリックすると TListBox が非表示になり,このイベントが発生する
//  ここで選択した TListBox の項目を取得してレコードのデータを更新する
//-----------------------------------------------------------------------------
procedure TplDBGrid.OnplPopupListBox1CloseUp(Sender: TObject);
var
  LIndex : Integer;
begin
  SetFocus;

  LIndex := FPopUpListBox.ItemIndex;
  if LIndex < 0 then Exit;

  // 選択中のレコードのデータを更新
  if SelectedField.FieldName = 'State' then begin
    DataSource.DataSet.Edit;
    SelectedField.AsString := FPopUpListBox.Items[LIndex];
    DataSource.DataSet.Post;

    FPopShowFlag := False;
  end;
end;

//=============================================================================
//  SelectCell メソッド処理
//  ボタンを描画した列のセルは編集禁止とする
//  リストからの選択した値だけをデータとして使用する
//=============================================================================
function TplDBGrid.SelectCell(ACol, ARow: Integer): Boolean;
var
  LOptions : TDBGridOptions;
begin
  Result := inherited SelectCell(ACol, ARow);

  // 退避しておいた Options プロパティを操作用の変数に代入
  LOptions := FSaveOptions;
  if Columns[ACol - fixedcols].FieldName = 'State' then begin
    System.Exclude(LOptions, dgEditing);
  end;
  Options := LOptions;
end;

//=============================================================================
//  DrawColumnCell メソッドの処理
//  特定の列にボタンの画像を描画する
//
//  uses に Themes が必要
//=============================================================================
procedure TplDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
var
  LRect    : TRect;
  LDetails : TThemedElementDetails;
begin
  inherited DrawColumnCell(Rect, DataCol, Column, State);

  if (Column.Field.FieldName = 'State') then begin
    // ボタンを描画
    LRect := Rect;
    SetRect(LRect, Rect.Right - FBtnWidth, Rect.Top + 1, Rect.Right, Rect.Bottom - 1);
    LDetails := StyleServices.GetElementDetails(tcDropDownButtonNormal);
    StyleServices.DrawElement(Canvas.Handle, LDetails, LRect, nil);
  end;

  // TListBox の表示中もフォーカスの枠線を描画する処理
  // 必要なければ削除する
  if (gdSelected in State) and (FPopUpListBox.Visible) then begin
    LRect := Rect;
    InflateRect(LRect, - 1, -1);
    Canvas.DrawFocusRect(LRect);
  end;
end;

end.


ボタンを表示する条件を次のようにすると,アクティブレコードだけ,あるいは,ボタンを描画するセルを選択した時だけボタンを表示します.


  if (Column.Field.FieldName = 'State') then begin
    if (Row - 1) = DataLink.ActiveRecord then begin
      // アクティブレコードだけにボタンを描画
      //
    end;
  end;

  if (SelectedField.FieldName = 'State') then begin
    if ((Row - 1) = DataLink.ActiveRecord) then begin
      // セルを選択した時にボタンを描画

      //
    end;
  end;




14_TDBGrid の特定の列にチェックボックスを描画


TDBGrid の特定の列にチェックボックスを描画する例です.描画結果の画像は TCheckBox と同じですが,TCheckBox のインスタンス (実体) が生成されるわけではありません.
前項のボタン描画のサンプルと同じ理由で,マウスクリックの検出には CellClick メソッドを使用しています.

このサンプルでは,文字列データの項目である State に値,つまり文字列がある時はチェックボックスのチェックを描画し,空文字の時はチェックなしの画像を描画します.
チェックボックスは,本来は論理値型の値に対して使用すると思いますが,適当なサンプルデータが見つからなかったので,この動作にしています.

このサンプルでは,チェックボックスの領域の判定をしていません.クリックは,チェックボックスを描画しているセルのクリックのことです.
チェックボックスを描画したセルが編集状態になっても意味がありませんから,チェックボックスを配置した列のセルは編集禁止の処理をしています.
列の移動があっても動作するように,TField の FieldName プロパティで列を特定しています.



[備考 2]
このサンプルは 2020年02月28日 の更新で,SQL 文実行後にトランザクションを開始し,フォームを閉じる時にロールバックするようにしました.したがつて,操作中のデータは更新され,TDBGrid の表示も変わりますが,データベースのデータは更新しません.



図43
特定の列にチェックボックスを描画
  • チェックボックスをクリックすると
図44
項目 State の値が変わる
  • 文字列データがある時は空文字になる
  • 空文字の時は文字列がセットされる゛

リスト33
TDBGrid の特定の列にチェックボックスを描画
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    FSaveOptions : TDBGridOptions;
    function SelectCell(ACol: Integer; ARow: Integer): Boolean; override;
//    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
//      Y: Integer); override;
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
    procedure CellClick(Column: TColumn); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    Database1: TDatabase;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo,
  Themes;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LItemList : string;
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  // データベースの設定
  Database1.Connected := False;
  Database1.DatabaseName := 'DBDEMOS';
  Database1.TransIsolation := tiDirtyRead;

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;
  Query1.DatabaseName  := Database1.DatabaseName;

  // 更新可能にする
  Query1.RequestLive := True;

  // データベースからデータを取得して表示
  Query1.SQL.Clear;
  LItemList := 'CustNo as BOOL, CustNo, State, Company, Zip';
  Query1.SQL.Add('select ' + LItemList + ' from customer.db');
  Query1.Open;


  // トランザクション開始
  Database1.StartTransaction;

  // チェックボックスを描画する列の幅を設定
  Query1.FieldByName('BOOL').DisplayWidth := 5;

  // 現在の Options プロパティの設定を退避
  plDBGrid1.FSaveOptions := plDBGrid1.Options;

  // 編集禁止のセルに対する処理
  // チェックボックスの描画が 2 列目以降であれば不要
  plDBGrid1.SelectCell(plDBGrid1.FixedCols, 0);

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  // テストなのでコミット (更新) しない
  Database1.Rollback;

  // データベースを閉じる
  Query1.Close;
  Database1.Close;
end;

{ TplDBGrid }

//=============================================================================
//  CellClick メソッド処理
//  チェックボックスを描画しているセルをクリックした時の処理
//  Click メソッドはセルを選択すると発生するので適切とは言えない
//
//  チェックボックスは画像としての描画であって,TCheckBox のインスタンスではない
//  Click 等のイベントが使用できるわけではない
//=============================================================================
procedure TplDBGrid.CellClick(Column: TColumn);
var
  LMousePos : TPoint;
  LGridPos  : TGridCoord;
  LField    : TField;
  LValue    : string;
begin
  inherited;

  LMousePos := HitTest;
  // 座標値をグリッドした行と列の値に変換
  LGridPos := MouseCoord(LMousePos.X, LMousePos.y);

  // MouseDown でアクティブになったレコードが対象
  // それ以外の場所で MouseUp した場合は動作させない
  if (LGridPos.Y - FixedRows) = DataLink.ActiveRecord then begin
    if Columns[LGridPos.X - 1].FieldName = Column.FieldName then begin

      // 実際にはここで論理値型の項目データを編集する
      // 代わりに項目 State のデータを操作

      LField := DataSource.DataSet.FieldByName('State');

      DataSource.DataSet.Edit;
      LValue := LField.AsString;
      if Trim(LValue) = '' then begin
        LField.AsString := '日本国';
      end else begin
        LField.AsString := '';
      end;
      DataSource.DataSet.Post;
    end;
  end;
end;

//=============================================================================
//  SelectCell メソッド処理
//  チェックボックスを描画した列のセルは編集禁止とする
//=============================================================================
function TplDBGrid.SelectCell(ACol, ARow: Integer): Boolean;
var
  LOptions : TDBGridOptions;
begin
  Result := inherited SelectCell(ACol, ARow);

  // 退避しておいた Options プロパティを操作用の変数に代入
  LOptions := FSaveOptions;
  if Columns[ACol - fixedcols].FieldName = 'BOOL' then begin
    System.Exclude(LOptions, dgEditing);
  end;
  Options := LOptions;
end;

//=============================================================================
//  DrawColumnCell メソッドの処理
//  特定の列にテーマ対応チェックボックスの画像を描画する
//
//  uses に Themes が必要
//=============================================================================
procedure TplDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
var
  LValue    : string;
  LColor    : TColor;
  LRect     : TRect;
  LBtnTheme : TThemedButton;
  LDetails  : TThemedElementDetails;
begin
  inherited DrawColumnCell(Rect, DataCol, Column, State);

  if (Column.Field.FieldName = 'BOOL') then begin
    // セルの背景をデフォルトの設定で塗り潰す (セルの文字列が消える)
    if (gdSelected in State) then begin
      DrawCellHighlight(Rect, State, Col, Row);
    end else begin
      LColor := Canvas.Brush.Color;
      DrawCellBackground(Rect, LColor, State, Col, Row);
    end;

    // 操作対象の項目のデータを取得
    LValue := DataSource.DataSet.FieldByName('State').AsString;

    // 引数の State の値に応じてチェックボックスの画像を変更
    if Trim(LValue) <> '' then begin
      LBtnTheme := tbCheckBoxCheckedNormal;
      if gdPressed  in State then LBtnTheme := tbCheckBoxCheckedPressed;
      if gdSelected in State then LBtnTheme := tbCheckBoxCheckedHot;
      if gdHotTrack in State then LBtnTheme := tbCheckBoxCheckedHot;
    end else begin
      LBtnTheme := tbCheckBoxUncheckedNormal;
      if gdPressed  in State then LBtnTheme := tbCheckBoxCheckedPressed;
      if gdSelected in State then LBtnTheme := tbCheckBoxUncheckedHot;
      if gdHotTrack in State then LBtnTheme := tbCheckBoxUncheckedHot;
    end;

    // チェックボックスを描画
    LRect := Rect;
    LRect.Right := LRect.Right - 20;
    LDetails := StyleServices.GetElementDetails(LBtnTheme);
    StyleServices.DrawElement(Canvas.Handle, LDetails, LRect, nil);
  end;
end;

end.


チェックボックスのチェック状態を tbCheckBoxMixedNormal 等にすると,下図のようになります.



図45
別のチェックボックスのスタイル

リスト34
別のチェックボックスのスタイル
    // 引数の State の値に応じてチェックボックスの画像を変更
    if Trim(LValue) <> '' then begin
      LBtnTheme := tbCheckBoxMixedNormal;
      if gdPressed  in State then LBtnTheme := tbCheckBoxMixedPressed;
      if gdSelected in State then LBtnTheme := tbCheckBoxMixedHot;
      if gdHotTrack in State then LBtnTheme := tbCheckBoxMixedHot;
    end else begin
      LBtnTheme := tbCheckBoxUncheckedNormal;
      if gdPressed  in State then LBtnTheme := tbCheckBoxCheckedPressed;
      if gdSelected in State then LBtnTheme := tbCheckBoxUncheckedHot;
      if gdHotTrack in State then LBtnTheme := tbCheckBoxUncheckedHot;
    end;


チェックボックスを描画しているセルのクリックではないく,チェックボックス部分のクリック動作としたい場合は,チェックボックスのサイズを取得して,それを使用します.
例えば次のように処理できます.



//=============================================================================
//  CellClick メソッド処理
//  チェックボックスを描画しているセルをクリックした時の処理
//  Click メソッドはセルを選択すると発生するので適切とは言えない
//
//  チェックボックスの矩形領域内でクリックした時だけ動作させるコード例
//=============================================================================
procedure TplDBGrid.CellClick(Column: TColumn);
var
  LMousePos : TPoint;
  LGridPos  : TGridCoord;
  LField    : TField;
  LValue    : string;
  LCellRect : TRect;
  LDetails  : TThemedElementDetails;
  LBtnSize  : TSize;
  LTop      : Integer;
  LLeft     : Integer;
  LRect     : TRect;
begin
  inherited;

  // 座標値をグリッドした行と列の値に変換
  LMousePos := HitTest;
  LGridPos := MouseCoord(LMousePos.X, LMousePos.y);

  // MouseDown でアクティブになったレコードが対象
  // それ以外の場所で MouseUp した場合は動作させない
  if (LGridPos.Y - FixedRows) <> DataLink.ActiveRecord then Exit;
  if SelectedField.FieldName <> Column.FieldName then Exit;


  // 行と列の値からセルの矩形領域 TRect の値を取得
  LCellRect := CellRect(LGridPos.X, LGridPos.Y);

  // チェックボックスの描画サイズを取得
  // 取得結果は LBtnSize (TSize 型) の変数として取得
  LDetails := StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal);
  StyleServices.GetElementSize(Canvas.Handle, LDetails, esStretch, LBtnSize);

 // チェックボックスの上端と左端の値を計算して実際の描画領域を取得
  // 描画の時マージンを設定した場合はその補正が必要
  // デフォルトではセルの上下左右の中央に描画される
  LTop  := ((LCellRect.Top + LCellRect.Bottom) - LBtnSize.Height) div 2;
  LLeft := ((LCellRect.Left + LCellRect.Right) - LBtnSize.Width) div 2;
  SetRect(LRect, LLeft, LTop, LLeft + LBtnSize.Width, LTop + LBtnSize.Height);


  // マウスカーソルの位置が矩形領域内かをチェック
  if LRect.Contains(Point(LMousePos.X, LMousePos.Y)) then begin

    // 実際にはここで論理値型の項目データを編集する
    // 代わりに項目 State のデータを操作
    LField := DataSource.DataSet.FieldByName('State');

    DataSource.DataSet.Edit;
    LValue := LField.AsString;
    if Trim(LValue) = '' then begin
      LField.AsString := '日本国';
    end else begin
      LField.AsString := '';
    end;
    DataSource.DataSet.Post;
  end;
end;




15_TDBGrid のグリッド線の色を変更


TDBGrid のデータセルのグリッド線の色を変更する例です.
DrawColumnCell 等の TRect レコード型の引数は,セルの描画領域です.この領域の 1 ピクセル外側がグリッド線の描画部分です.InflateRect で矩形領域を 1 ピクセル外側にしてて,FrameRect で枠線を描画すればグリッド線の描画となります.FrameRect の色の指定は,TBrush.Color です.

以下は,TDBGrid.GridLineWidth プロパテティ (protected 部) の値が 1 の時の結果です.



図46
データセルのグリッド線の色を変更

TRect 型の引数の値を矩形領域として描画した場合は,セルの描画領域の矩形描画となります.


図47
セルの描画領域の枠線を描画

リスト35
TDBGrid のデータセルのグリッド線の色を変更
//=============================================================================
//  DrawColumnCell メソッドの処理
//  データセルのグリッド線の色を変更する例
//=============================================================================
procedure TplDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
var
  LColor : TColor;
  LRect  : TRect;
begin
  inherited;

  if (DataCol >= 3) and (DataCol <= 5) then begin
    // 背景の色の指定
    case DataCol of
      3: LColor := CalcGradEndColor(clRed,   65);
      4: LColor := CalcGradEndColor(clGreen, 65);
      5 :LColor := CalcGradEndColor(clBlue,  65);
    else
      LColor := Color;
    end;

    // 塗り潰しの矩形領域
    LRect := Rect;
    // 塗り潰しの色 (TBrush.Color で指定する)
    Canvas.Brush.Color := LColor;
    // 描画ルーチンを実行
    DefaultDrawColumnCell(LRect, DataCol, Column, State);
  end;


  // データセルのグリッド線の色を変更
  LRect := Rect;
  if Form1.CheckBox1.Checked then begin
    InflateRect(LRect, 1, 1);
  end;

  Canvas.Brush.Color := clGray;
  Canvas.FrameRect(LRect);
end;


DrawCell メソッドでは,データセットのデータの処理は正常にできませんが,グリッド線の描画であれば可能です.
以下は,固定行と固定列も含めたセルのグリッド線の色を変更する例です.



図48
固定行と固定列も含めたセルのグリッド線の色を変更

リスト36
TDBGrid のデータセルと固定行と固定列のセルのグリッド線の色を変更
//=============================================================================
//  DrawCell メソッドの処理
//  データセルと固定行と固定列のセルのグリッド線の色を変更する例
//=============================================================================
procedure TplDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  LRect : TRect;
begin
  inherited;

  // データセルと固定行と固定列のセルのグリッド線の色を変更
  LRect := ARect;
  InflateRect(LRect, 1, 1);

  Canvas.Brush.Color := clGray;
  Canvas.FrameRect(LRect);
end;




16_TDBGrid で 複数レコードを選択


TDBGrid の複数行選択と言う表現もありますが,TDBGrid で複数のレコードを選択する例です.
Options プロパティに dgRowSelect と dgMultiSelect を含める方法が TDBGrid の標準の方法です.全コードを掲載する必然性はありませんが,以下がテストに使用したコートです.

[Ctrl] キーを押した状態でマウスの左ボタンを押すと選択になります.再度左ボタンを押すと選択解除となります.キー操作でスクロールすると全ての選択が解除になります.インジケータは選択した全てのレコードに対して表示されます.
このサンプルでは,選択したレコードの背景色を変更しています.


図49
複数レコードを選択
  • Options に dgRowSelect と dgMultiSelect が必要
  • [Ctrl] + マウス左ボタンで選択・選択解除
  • キー操作のスクロールで選択解除になる
  • 選択レコードの全てにインジケータが表示される

リスト37
TDBGrid で 複数レコードを選択
Options に dgRowSelect と dgMultiSelect が必要
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    procedure DrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  オブジェクト・インスペクタで CheckBox1.Checked := True; にしている
//  (OnCreate ではフォームが不可視状態なので設定不可)
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  // 複数のレコードの選択を可能にする
  plDBGrid1.Options := plDBGrid1.Options + [dgRowSelect, dgMultiSelect];

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from customer.db');
  Query1.Open;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

//=============================================================================
//  複数レコード選択可能・不可の切換
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then begin
    plDBGrid1.Options := plDBGrid1.Options + [dgRowSelect, dgMultiSelect];
  end else begin
    plDBGrid1.Options := plDBGrid1.Options - [dgRowSelect, dgMultiSelect];
  end;

  plDBGrid1.Invalidate;
  plDBGrid1.SetFocus;
end;

{ TplDBGrid }

//=============================================================================
//  DrawDataCell メソッド処理
//  選択レコード (TBookMarkList にあるレコード) の背景色を変更
//=============================================================================
procedure TplDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
  inherited;

  if ([dgRowSelect, dgMultiSelect] * Options <> [])
    and (SelectedRows.CurrentRowSelected) then begin
    Canvas.Brush.Color := clWebLightBlue;
    DefaultDrawDataCell(Rect, Field, State);
  end;
end;

end.


集合型のプロパティの設定は Include, Exclude を使用した方が効率がいいとされています.集合型のオプションを直接は操作できないので,変数に代入してから操作します.

リスト38
集合型の Options プロパティの Include, Exclude を使用した設定
//=============================================================================
//  複数レコード選択可能・不可の切換
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
var
  LOptions : TDBGridOptions;
begin
  LOptions := plDBGrid1.Options;
  if CheckBox1.Checked then begin
    System.Include(LOptions, dgRowSelect);
    System.Include(LOptions, dgMultiSelect);
  end else begin
    System.Exclude(LOptions, dgRowSelect);
    System.Exclude(LOptions, dgMultiSelect);
  end;
  plDBGrid1.Options := LOptions;

  plDBGrid1.Invalidate;
  plDBGrid1.SetFocus;
end;


Options プロパティに dgRowSelect と dgMultiSelect がなくても複数のレコードを選択可能にするサンプルコードです.
上のサンプルプログラムでレコードを選択すると,その情報は TBookmarkList と言うブックマークリストに格納されます.それを自前で処理すれば,Options プロパティの内容に関係なく複数レコードの選択が可能です.このサンプルは,Options プロパティの dgRowSelect と dgMultiSelect の有無に関係なく複数レコードの選択操作ができるようにしています.
マウスの左ボタンの押下が選択・選択解除のトグル操作となっています.このサンプルでは,キー操作でスクロールしても選択解除とはなりません.選択解除の方法は,この後に掲載しています.インジケータはアクティブレコードだけの表示となります.
このサンプルは,選択操作専用仕様とも言えます.


図50
複数レコードを選択
  • Options に dgRowSelect と dgMultiSelect がなくても選択が可能
  • マウス左ボタンで選択・選択解
  • キー操作のスクロールでは選択解除にならない
  • インジケータの表示はアクティブレコードだけ
  • 選択作業専用の仕様と言える

リスト39
TDBGrid で 複数レコードを選択
Options に dgRowSelect と dgMultiSelect がなくても複数レコードの選択が可能
//=============================================================================
//  MouseDown メソッドの処理
//  レコードの選択操作
//
//  Options に dgRowSelect, dgMultiSelect があっても複数選択可能にするため
//  それらのメンバの有無をチェック
//  [Ctrl] キーの押下なしで選択可能にしている
//=============================================================================
procedure TplDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LBookMarkList : TBookmarkList;
begin
  inherited;

  if Button = mbLeft then begin
    if [dgMultiSelect] * Options = [] then begin
      LBookMarkList := SelectedRows;
      LBookMarkList.CurrentRowSelected := not LBookMarkList.CurrentRowSelected;

      // レコードの追加や削除があった場合は Refresh が必要
      LBookMarkList.Refresh;
    end;
  end;
end;

//=============================================================================
//  nKeyDown メソッドの処理
//  スペースキーを押したら選択/非選択を切り換える
//=============================================================================
procedure TplDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
var
  LBookMarkList : TBookmarkList;
begin
  inherited;

  if (Key = VK_SPACE) then begin
    if [dgMultiSelect] * Options = [] then begin
      LBookMarkList := SelectedRows;
      LBookMarkList.CurrentRowSelected := not LBookMarkList.CurrentRowSelected;
    end;
  end;
end;

//=============================================================================
//  DrawDataCell メソッド処理
//  選択レコード (TBookMarkList にあるレコード) の背景色を変更
//=============================================================================
procedure TplDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
  inherited;

  if (SelectedRows.CurrentRowSelected) then begin
    Canvas.Brush.Color := clWebTan;
    DefaultDrawDataCell(Rect, Field, State);
  end;
end;


[備考]
本項のサンプルには [SPACE] キーで選択,非選択のトグル操作のコードがあります.
筆者が業務アプリの開発を始めた頃は,ホストコンピュータの端末操作の経験者が使用することがありました.ホストコンピュータの端末にはマウスはありません.彼らは,アプリの操作を全てキー操作で行います.例えば入力位置の移動は [TAB] キー等を使用します.[SPACE] キーは,項目選択のトグル操作として用いられてきました.彼らはテンキーの [Num] ロックを解除して操作することもあります.

現在はマウス操作が主流です.エクセルで,となりのセルにに移動するにもマウスを使用する方が多くいます.このような,キー操作による機能は必要ないのかも知れません.





17_TDBGrid で 全レコードの選択と全レコードの選択解除


全レコードを選択状態にするコードと,全ての選択を解除するコードです.
ブックマークリストをクリアすれば全ての選択の解除となります.全レコードの選択は,選択状態にするレコードをアクティブなレコードにして TBookmarkList の CurrentRowSelected の値を True にするため,TDBGrid のスクロール動作が伴います.このコードでは,TDataSet の表示用コントロールの表示更新を停止してから処理を開始しています.

また,処理前のグリッドの先頭行のレコード番号とアクティブなレコード番号を退避して,処理終了後に,それらの値を使用して元の表示状態にするようにしています.



リスト40
全レコードの選択と全レコードの選択解除
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Bde.DBTables,
  Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TplDBGrid = class(TDBGrid)
  protected
    procedure DrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Panel1: TPanel;
    Query1: TQuery;
    Button1: TButton;
    DBGrid1: TDBGrid;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    plDBGrid1 : TplDBGrid;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plChgCompo;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  オブジェクト・インスペクタで CheckBox1.Checked := True; にしている
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム作成時にコンポーネントの入れ替え
  plDBGrid1 := TplDBGrid(ChangeComponent(DBGrid1, TplDBGrid));

  // 複数のレコードの選択を可能にする
  plDBGrid1.Options := plDBGrid1.Options + [dgRowSelect, dgMultiSelect];

  Query1.Close;
  DataSource1.DataSet  := Query1;
  plDBGrid1.DataSource := DataSource1;

  // データベースからデータを取得して表示
  Query1.DatabaseName := 'DBDEMOS';
  Query1.SQL.Clear;
  Query1.SQL.Add('select * from customer.db');
  Query1.Open;

  ActiveControl := plDBGrid1;
end;

//=============================================================================
//  フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Query1.Close;
end;

//=============================================================================
//  全てのレコードを選択
//
//  アクティブレコードの移動を行うので TDBGrid の表示もスクロールする
//  TDBGrid の先頭行のレコード番号とアクティブレコードの位置を退避しておく
//  処理後に元の表示状態に戻す
//  TDBGrid の表示更新を停止し,処理後に解除する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDataset      : TDataSet;
  LRowCount     : Integer;
  LTopRowRecNo  : Integer;
  LCurrentRowNo : Integer;
begin
  //TDBGridに表示しているデータセット取得
  LDataset := DBGrid1.DataSource.Dataset;

  // DBGridのスクロール状態を元に戻すための変数設定
  LCurrentRowNo := TplDBGrid(DBGrid1).Row - plDBGrid1.FixedRows;
  LTopRowRecNo  := LDataset.RecNo - LCurrentRowNo;

  // 表示更新を止める
  LDataset.DisableControls;


  // データセットのレコードを順番に操作
  LDataset.First;
  while (LDataset.Eof = False) do begin
    // カレント行レコードを選択 (ブックマークリストに追加)
    plDBGrid1.SelectedRows.CurrentRowSelected := True;
    LDataset.Next;
  end;


  // DBGridのスクロール状態を元に戻すための処理
  LRowCount      := plDBGrid1.VisibleRowCount;
  LDataset.RecNo := LTopRowRecNo;
  LDataset.MoveBy(LRowCount);

  while LDataset.BOF = False do begin
    if LDataset.RecNo = LTopRowRecNo then begin
      Break;
    end else begin
      LDataset.Prior;
    end;
  end;
  LDataset.MoveBy(LCurrentRowNo);

  // 表示更新再開
  LDataset.EnableControls;

  plDBGrid1.SetFocus;
end;

//=============================================================================
//  全ての選択を解除
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  plDBGrid1.SelectedRows.Clear;
  plDBGrid1.SetFocus;
end;

{ TplDBGrid }

//=============================================================================
//  DrawDataCell メソッド処理
//  選択レコード (TBookMarkList にあるレコード) の背景色を変更
//=============================================================================
procedure TplDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
begin
  inherited;

  if ([dgRowSelect, dgMultiSelect] * Options <> [])
    and (SelectedRows.CurrentRowSelected) then begin
    Canvas.Brush.Color := clWebLightBlue;
    DefaultDrawDataCell(Rect, Field, State);
  end;
end;

end.




18_TDBGrid で選択した複数レコードのデータの取得


レコードのテータの取得は,TDataSet のメソッドやプロパティを施用します.

選択した複数のレコードのデータの取得は,レコードのデータを取得するという意味では,アクティブなレコードのデータの取得と同じです.選択したレコードをアクティブなレコードにして,そのデータを取得します.
TDBGrid のアクティブレコードは常に 1 つだけあり,常に TDBGrid の可視領域にあります.複数のレコードを選択しても,アクティブなレコードは 1 つだけです.

そのアクティブなレコードのデータの取得例です.テータを文字列として取得しています.
このサンプルでは,SQL 文の実行後に,特定の項目に対して次のような書式設定を行っています.


  // TFloatField 型のデータの表示書式を設定してみる 
  TFloatField(Query1.FieldByName('CustNo')).DisplayFormat := 'No - 000000';


[備考]
カスタム描画したテキストは取得できません.カスタム描画は TDBGrid の Canvas に描画しているだけです.セルのデータ,あるいはデータセットのデータとなっているわけではありません.TDBGrid にはセルのデータは存在しません.



図51
アクティブなレコードのデータの取得例
  • 項目のデータを AsString で取得した結果
図52
アクティブなレコードのデータの取得例
  • DisplayText の値を取得した結果
  • 書式付ききのデータとなっている

リスト41
アクティブなレコードのデータの取得例
//=============================================================================
//  アクティブなレコードのデータを取得する例
//  TDataset.Fields[ ].AsString で取得する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDataset   : TDataSet;
  LFieldName : string;
  LFieldIdx  : Integer;
  LText      : string;
begin
  // TDBGridに表示しているデータセット取得
  LDataset := DBGrid1.DataSource.Dataset;

  LText := '';
  // 項目 (フィールド) 数だけループ
  for LFieldIdx := 0 to LDataset.FieldCount - 1 do begin
    // 特定の項目のデータだけを文字列として取得して表示
    LFieldName := LDataset.Fields[LFieldIdx].FieldName;
    if (LFieldName = 'CustNo') or (LFieldName = 'Company') then begin
      LText := LText + sLineBreak + LDataset.Fields[LFieldIdx].AsString;
    end;
  end;

  MessageBox(Handle, PChar(LText), 'データ取得', MB_ICONINFORMATION);

  plDBGrid1.SetFocus;
end;

//=============================================================================
//  アクティブなレコードのデータを取得
//  TDataSet.Fields[ ].DisplayText の値を取得する例
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDataset   : TDataSet;
  LFieldName : string;
  LFieldIdx  : Integer;
  LText      : string;
begin
  //TDBGridに表示しているデータセット取得
  LDataset := DBGrid1.DataSource.Dataset;

  LText := '';
  // 項目 (フィールド) 数だけループ
  for LFieldIdx := 0 to LDataset.FieldCount - 1 do begin
    // 特定の項目のデータだけを文字列として取得して表示
    LFieldName := LDataset.Fields[LFieldIdx].FieldName;
    if (LFieldName = 'CustNo') or (LFieldName = 'Company') then begin
      LText := LText + sLineBreak + LDataset.Fields[LFieldIdx].DisplayText;
    end;
  end;

  MessageBox(Handle, PChar(LText), 'データ取得', MB_ICONINFORMATION);

  plDBGrid1.SetFocus;
end;


選択した複数のレコードのデータの取得例です.
選択したレコードを順番にアクティブなレコードにして,そのレコードのデータを取得します.そのため,TDBGrid がスクロールすることになります.このコードでは,TDataSet の表示用コントロールの表示更新を停止してから処理を開始しています.

また,処理前のグリッドの先頭行のレコード番号とアクティブなレコード番号を退避して,処理終了後に,それらの値を使用して元の表示状態にするようにしています.

このサンプルもデータを文字列として取得するようにしています.取得したデータは,レコード単位でカンマ区切りの文字列として TStringList に格納し,CSV ファイルとして保存します.



図53
選択した複数レコードのデータの取得
  • Button1 クリックで,CSV データとして保存
図54
選択レコードを保存した CSV ファイルの内容
  • テキストエディタで表示した結果

リスト42
TDBGrid で選択した複数レコードのデータの取得
//=============================================================================
//  選択した複数のレコードのデータを取得する例
//  CSV (カンマ区切りのテキスト) テータとして取得
//
//  アクティブレコードの移動を行うので TDBGrid の表示もスクロールする
//  TDBGrid の先頭行のレコード番号とアクティブレコードの位置を退避しておく
//  処理後に元の表示状態に戻す
//  TDBGrid の表示更新を停止し,処理後に解除する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList      : TStringList;
  LValueList    : TStringList;
  LRowCount     : Integer;
  LRN           : Integer;
  LTopRowRecNo  : Integer;
  LCurrentRowNo : Integer;
  LDataset      : TDataSet;
  LBkMarkIdx    : integer;
  LFieldIdx     : Integer;
begin
  // TDBGridに表示しているデータセット取得
  LDataset := DBGrid1.DataSource.Dataset;

  // TDBGridのスクロール状態を元に戻すための変数設定
  LCurrentRowNo := TplDBGrid(DBGrid1).Row - plDBGrid1.FixedRows;
  LTopRowRecNo  := LDataset.RecNo - LCurrentRowNo;

  // 表示更新を止める
  LDataset.DisableControls;


  LStrList := TStringList.Create;
  LValueList := TStringList.Create;
  try
    LValueList.DelimitedText := ',';

    // 選択レコード分処理を行う
    for LBkMarkIdx := 0 to plDBGrid1.SelectedRows.Count - 1 do begin
      // ブックマーク位置のレコードに移動
      LDataset.BookMark := plDBGrid1.SelectedRows[LBkMarkIdx];


      // データ取得の例
      // データをデリミタ文字で区切ってリストに追加
      LValueList.Clear;
      for LFieldIdx := 0 to LDataset.FieldCount - 1 do begin
        LValueList.Add(LDataset.Fields[LFieldIdx].AsString);
      end;
      LStrList.Add(LValueList.DelimitedText);
    end;

    // CSV ファイルとして保存
    LStrList.SaveToFile('Data.csv');
  finally
    FreeAndNil(LStrList);
    FreeAndNil(LValueList);
  end;


  // TDBGridのスクロール状態を元に戻すための処理
  LRowCount      := plDBGrid1.VisibleRowCount;
  LDataset.RecNo := LTopRowRecNo;
  LDataset.MoveBy(LRowCount);

  while LDataset.BOF = False do begin
    if LDataset.RecNo = LTopRowRecNo then begin
      Break;
    end else begin
      LDataset.Prior;
    end;
  end;
  LDataset.MoveBy(LCurrentRowNo);

  // 表示更新再開
  LDataset.EnableControls;

  plDBGrid1.SetFocus;
end;