|
Delphi Programming / Object Pascal
[掲載 2015年07月26日] [更新 2020年02月10日] Delphi サンプルプログラム集 |
071_TDBGrid のスクロールバーの表示制御 |
動作確認等 |
Windows 7 U64(SP1) + Delphi XE5(UP2) Pro VCL-32
BDE 5.2 + Paradox 7.0 |
|
071_TDBGrid_ScrollBar.zip [8,371 KB] 2020年02月10日版 (EXE 同梱) |
TDBGrid のスクロールバーの設定関係のサンプルです.
TDBGrid の published 部には,TStringGrid や TRichEdit のような,ScrollBars プロパティはありません.protected 部にはありますが,このプロパティでは,TStringGrid と同じようなスクロールバーの表示制御はできないようです.
TDBGrid に表示するデータがない場合は,スクロールバーは表示されません.クライアント領域の幅に列方向のデータが表示できなくなると,水平スクロールバーが現れます.垂直スクロールバーは,筆者の環境では,表示レコード数が 2 つ以上あると現れます.
本ページのサンプルは,TDBGrid の継承クラスを作成し,これらのスクロールバーを強制的に表示したり,非表示にします.
本ページのサンプルでは,継承クラスをコンポーネントとして登録 (インストール) しないで,主に [派生元のコンポーネントと交換する方法] で説明しているユニットを使用しています.
|
[備考]
本ページのサンプルでは,BDE と Paradox のサンプルデータを使用しています.
Delphi XE7 以降には BDE は実装されていません.必要であれば,BDE を別途入手するか,他のデータベースを利用してテストしてください.
|
01_TDBGrid のスクロールバーの表示と非表示を切り換え |
TDBGrid の継承クラスを作成して,水平,垂直スクロールバーを常に表示または常に非表示するようにしたサンプルです.
Button1 のクリックで表示と非表示を切り換えるようにしています.
TDBGrid が生成または再生成されると RecreateWnd が実行されます.RecreateWnd は WM_NCCALCSIZE メッセージを発行します.このメッセージ処理内で表示スタイルを設定しています.
本サンプルでは,TDBGrid の継承クラスに HideScrollBars というプロパティを実装して,このプロパティの値を Button1 で切り換えるようにしています.
|
|
図1
設計時の画面 |
|
図2
実行開始画面
- 水平スクロールバー,垂直スクロールバーが共に表示されている
|
|
図3
Button1 をクリック
|
リスト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)
private
FHideScrollBars : Boolean;
procedure SetHideScrollBars(const Value: Boolean);
protected
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
public
property HideScrollBars : Boolean read FHideScrollBars write SetHideScrollBars;
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 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));
Query1.Close;
DataSource1.DataSet := Query1;
plDBGrid1.DataSource := DataSource1;
// データベースからデータを取得して表示
Query1.DatabaseName := 'DBDEMOS';
Query1.SQL.Clear;
Query1.SQL.Add('select CustNo, Company, City from customer.db where CustNo<=2000');
Query1.Open;
ActiveControl := plDBGrid1;
end;
//=============================================================================
// フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Query1.Close;
end;
//=============================================================================
// TDBGridの継承クラスに実装したHideScrollBarsプロパティをトグル操作
// HideScrollBarsがTrueだと水平,垂直スクロールバーは共に非表示(Hide)になる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
plDBGrid1.HideScrollBars := not plDBGrid1.HideScrollBars;
end;
{ TplDBGrid }
//-----------------------------------------------------------------------------
// TDBGridの継承クラスに実装したHideScrollBarsプロパティの設定メソッド
// 変更したらRecreateWndを実行する
// RecreateWndを実行するとWM_NCCALCSIZEメッセージが発生する
//-----------------------------------------------------------------------------
procedure TplDBGrid.SetHideScrollBars(const Value: Boolean);
begin
if FHideScrollBars <> Value then begin
FHideScrollBars := Value;
RecreateWnd;
end;
end;
//=============================================================================
// WM_NCCALCSIZEメッセージ処理
// スクロールバー表示のフラグを強制的に変更
//=============================================================================
procedure TplDBGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
var
LStyle : Integer;
begin
LStyle := GetWindowLong(Handle, GWL_STYLE);
if FHideScrollBars then begin
LStyle := LStyle and not WS_HSCROLL and not WS_VSCROLL;
end else begin
LStyle := LStyle or WS_HSCROLL or WS_VSCROLL;
end;
SetWindowLong(Handle, GWL_STYLE, LStyle);
inherited;
end;
end.
02_TDBGrid のスクロールバーを常に表示して無効化機能を追加 |
TDBGrid の継承クラスを作成して,WM_NCCALCSIZE メッセージ処理内で強制的にスタイルを変更して,スクロールバーを常に表示するようにしたサンプルです.
データが TDBGrid のクライアント領域に全て表示されている場合は,スクロールバーの表示を無効化状態にするコードを追加しています.
このサンプルには,スクロールのページサイズ (スクロールバーのボックス・つまみ) のサイズを設定する機能を追加していました.その機能にはかなり無理があるため,現在は削除しています.その変わりに,スクロールの制御に TScrollBar コンポーネントを実装した TDBGrid コンポーネントを提供しています.
|
|
図4
実行開始画面
- 列方向 (水平・横) スクロールバーが無効化の状態になっている
|
リスト2
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 WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure Resize; override;
procedure ColWidthsChanged; override;
procedure RowHeightsChanged; override;
procedure SizeChanged(OldColCount: Integer; OldRowCount: Integer); override;
public
procedure Available_Disable_ScrollBars;
end;
TForm1 = class(TForm)
DataSource1: TDataSource;
Panel1: TPanel;
Query1: TQuery;
Button1: TButton;
DBGrid1: TDBGrid;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
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));
Query1.Close;
DataSource1.DataSet := Query1;
plDBGrid1.DataSource := DataSource1;
// データベースからデータを取得して表示
Query1.DatabaseName := 'DBDEMOS';
Query1.SQL.Clear;
Query1.SQL.Add('select CustNo, Company, City from customer.db where CustNo<=3000');
Query1.Open;
ActiveControl := plDBGrid1;
plDBGrid1.Resize;
end;
//=============================================================================
// フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Query1.Close;
end;
//=============================================================================
// 表示データ数が少なくなった場合の確認用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
Query1.Close;
Query1.DatabaseName := 'DBDEMOS';
Query1.SQL.Clear;
Query1.SQL.Add('select CustNo, Company, City from customer.db where CustNo<=1500');
Query1.Open;
end;
{ TplDBGrid }
//-----------------------------------------------------------------------------
// スクロールバーの無効化の設定
// RecordCountが使用できない場合は制御できない
//-----------------------------------------------------------------------------
procedure TplDBGrid.Available_Disable_ScrollBars;
begin
if Parent = nil then Exit;
//Assignedとnilは違うので注意
if not Assigned(DataSource) then exit;
if DataSource.DataSet <> nil then begin
if not DataSource.DataSet.Active then exit;
end;
// 垂直スクロールバー関係の設定
if DataSource.DataSet.RecordCount = VisibleRowCount then begin
EnableScrollBar(Handle, SB_VERT, ESB_DISABLE_BOTH);
end else begin
EnableScrollBar(Handle, SB_VERT, ESB_ENABLE_BOTH);
end;
// 水平スクロールバー関係の設定
if (ColCount - FixedCols) = VisibleColCount then begin
EnableScrollBar(Handle, SB_HORZ, ESB_DISABLE_BOTH);
end else begin
EnableScrollBar(Handle, SB_HORZ, ESB_ENABLE_BOTH);
end;
end;
//=============================================================================
// Resizeメソッド
// コントロールがリサイズされると自動的に実行されるメソッド(OnResize相当)
//=============================================================================
procedure TplDBGrid.Resize;
begin
inherited;
Available_Disable_ScrollBars;
end;
//=============================================================================
// 行の高さを変更するメソッドのオーバライド
//=============================================================================
procedure TplDBGrid.RowHeightsChanged;
begin
inherited;
Available_Disable_ScrollBars;
end;
//=============================================================================
// カラム(列)の幅を変更するメソッドのオーバライド
//=============================================================================
procedure TplDBGrid.ColWidthsChanged;
begin
inherited;
Available_Disable_ScrollBars;
end;
//=============================================================================
// 行または列の数が変更された時の処理
// SizeChanged メソッドのオーバライド
//=============================================================================
procedure TplDBGrid.SizeChanged(OldColCount, OldRowCount: Integer);
begin
inherited;
Available_Disable_ScrollBars;
end;
//=============================================================================
// WM_NCCALCSIZEメッセージ処理
// スクロールバー表示のフラグを強制的に変更
//=============================================================================
procedure TplDBGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
var
LStyle : Integer;
begin
//スクロールバーの表示を強制的に変更
LStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, LStyle or WS_HSCROLL or WS_VSCROLL);
inherited;
end;
end.
スクロールのトラッキング (追従) 機能の設定サンプルです.Button1 クリックでトラッキングの ON, OFF を切り換えます.
スクロールバーのスクロールボックス (つまみ) をドラッグすると,スクロールボタン (つまみ) を放すまではスクロールしません.これが TDBGrid のデフォルトの仕様です.
スクロールボックス (つまみ) を操作した時のスクロールコードは SB_THUMBTRACK です.TDBGrid ではスクロールボックス (つまみ) を放すとスクロールコードが SB_THUMBPOSITION となり,実際のスクロールが行われます.
スクロールボックス (つまみ) をドラッグ中 (移動中) に強制的に SB_THUMBPOSITION にするようにしたのが本サンプルです.
スクロールバーを操作すると,WM_HSCROLL または WM_VSCROLL が発生します.このメッセージ内で処理を行います.Delphi では,このスクロールのメッセージの内容を TWMHScroll 型で受け取ることができます.MSDN の記事にあるような,一般的な WParam, LParam パラメータで受け取るには,引数の型を TMessage 型に変更します.
本サンプルでは,TDBGrid の継承クラスに ScrollTracking というプロパティを実装して,このプロパティの値を Button1 で切り換えるようにしています.
水平方向のスクロールは,列単位となるようです.
グリッドのスクロールそのものの動作仕様は 継承元の TDBGrid と同じです.カレントレコードの位置が一定の位置に移動するまでは,グリッドはスクロールしません.
|
[備考]
このスクロールのトラッキング (追従) を「滑らかなスクロール」と言うこともあります.本サンプルでは,水平方向は列単位でのスクロールです.滑らかと言えるかは疑問です.
|
|
図5
スクロールボックス (つまみ) をドラッグ
- スクロールボックス (つまみ) を放すまでグリッドはスクロールしない
|
|
図6
Button1 をクリック
- スクロールボックス (つまみ) のドラッグ (移動) と同時にグリッドもスクロールする
|
|
図7
水平スクロールの場合
|
リスト3
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)
private
FScrollTracking : Boolean;
protected
procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
public
property ScrollTracking : Boolean read FScrollTracking write FScrollTracking;
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 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));
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の継承クラスに実装したScrollTrackingプロパティをトグル操作
// ScrollTrackingがTrueだとスクロールボックスのドラッグに追従してスクロール
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
plDBGrid1.ScrollTracking := not plDBGrid1.ScrollTracking;
end;
{ TplDBGrid }
//=============================================================================
// TDBGridのWM_HSCROLLメッセージ処理
//=============================================================================
procedure TplDBGrid.WMHScroll(var Message: TWMHScroll);
begin
if FScrollTracking then begin
if Message.ScrollCode = SB_THUMBTRACK then begin
Message.ScrollCode := SB_THUMBPOSITION;
end;
end;
//inheritedは上の処理に後に実行する
inherited;
end;
//=============================================================================
// TDBGridのWM_VSCROLLメッセージ処理
//=============================================================================
procedure TplDBGrid.WMVScroll(var Message: TWMVScroll);
begin
if FScrollTracking then begin
if Message.ScrollCode = SB_THUMBTRACK then begin
Message.ScrollCode := SB_THUMBPOSITION;
end;
end;
//inheritedは上の処理に後に実行する
inherited;
end;
end.
04_TDBGrid のスクロールバーのコンテキストメニュー |
TDBGrid のスクロールバー上で,マウスの右ボタンをクリックすると,下図のようなコンテキストメニューが現れます.このコンテキストメニューを表示しないようにする方法です.
コンテキストメニューが表示する際,WM_CONTEXTMENU メッセージが発生します.このメッセージ処理内で何もしなければコンテキストメニューは現れません.何もしないと,TDBGrid で TPopupMenue コンポーネント等を使用していると,そのポップアップメニューも表示しなくなってしまいます.
そこで,マウスクリックの位置が,TDBGrid のクライアント領域の時は,WM_CONTEXTMENU メッセージ本来の処理を実行するようにしています.
|
|
図8
スクロールバーのコンテキストメニュー
|
リスト4
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 WMContextMenu(var Message: TWMContextMenu);
message WM_CONTEXTMENU;
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 where CustNo<=3000');
Query1.Open;
ActiveControl := plDBGrid1;
end;
//=============================================================================
// フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Query1.Close;
end;
{ TplDBGrid }
//=============================================================================
// WM_CONTEXTMENUメッセージ処理
// スクロールバーのコンテキストメニューを表示しないようにする
//=============================================================================
procedure TplDBGrid.WMContextMenu(var Message: TWMContextMenu);
var
LPos : TPoint;
begin
LPos := ScreenToClient(Point(Message.XPos, Message.YPos));
if PtInRect(ClientRect, LPos) then begin
inherited;
end else begin
Message.Result := 0;
end;
end;
end.
05_スクロール制御用に TScrollBar を実装した TDBGrid |
TDBGrid の垂直スクロールバーのボックスのサイズは実際のページサイズではありません.ページサイズとは,SQL 文で取得したレコード数に対する表示中のレコード数の割合のことです.SetScrollInfo 関数使用すればページサイズ等を設定できますが,スクロールすると元の TDBGrid の設定に戻されてしまいます.水平スクロールバーのボックスサイズは,列数に関係なく固定サイズです.
マウスホイールや [Page Up], [Page Down] キーによるスクロールは,選択レコードは移動しますが,選択レコードが上端または下端になるまでは表示内容はスクロールを開始しません.
それらの現象を回避するために,スクロール制御用に TScrollBar を実装した TDBGrid
コンポーネントを作成してみました.スクロールバーの背景色のプロパティも実装しています.
TDBGrid のスクロールは行単位,列単位です.ピクセル単位ではありません.
このコンポーネントは TDataSet.RecordCount でレコード数を取得しています.TDataSet.RecordCount の値が取得できない環境では利用できません.
|
[備考]
垂直スクロールバーのページサイズ,つまり,スクロールバーのボックス (つまみ) のサイズと位置は,行の高さが全て同じと仮定して計算しています.水平スクロールバーは,列の幅が全て同じと仮定した時のクライアント領域の表示幅に相当する列数をボックスのサイズとしています.この設定によって,全列幅のどの程度の範囲が表示されているかを確認できます.
スクロールは,トラッキングが ON の状態となります.そのため,大量のデータのスクロールでは問題が発生するかも知れません.
|
|
図9
テストプログラムの実行 |
TStringGrid は,全てのデータをグリッドのセルに代入して表示します.一方,TDBGrid は,SQL で取得したデータの全てをグリッドのセルに代入するわけではありません.レコード番号を指定すると,そのレコード番号の前後のレコードをセルに代入して表示します.TStringGrid のような行番号や列番号を指定したセルの選択ではなく,レコード番号で表示位置を指定します.TStringGrid では,td-date の値を設定することで縦方向にスクロールして,そのデータを表示できます.
TDBGrid の td-date の値は常に 0 です.Row の値は td-date からの相対値になり,表示中の行数を越えることはありません.
|
リスト5
スクロール制御用に TScrollBar を実装した 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, plDBGrid;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
Panel1: TPanel;
Query1: TQuery;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private 宣言 }
plDBGrid1 : TplDBGrid;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//=============================================================================
// フォーム生成時の処理
// コンポーネントは実行時生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
plDBGrid1 := TplDBGrid.Create(Self);
plDBGrid1.Parent := Self;
plDBGrid1.Align := alClient;
plDBGrid1.Options := plDBGrid1.Options - [dgMultiSelect, dgEditing];
Query1.Close;
DataSource1.DataSet := Query1;
plDBGrid1.DataSource := DataSource1;
Query1.Close;
DataSource1.DataSet := Query1;
plDBGrid1.DataSource := DataSource1;
Query1.DatabaseName := 'DBDEMOS';
Query1.SQL.Clear;
Query1.SQL.Add('select * from customer.db');
Query1.Open;
plDBGrid1.VScrollBarColor := clLime;
plDBGrid1.HScrollBarColor := clLime;
ActiveControl := plDBGrid1;
end;
//=============================================================================
// フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Query1.Close;
end;
end.
リスト6
スクロール制御用に TScrollBar を実装した TDBGrid コンポーネントのソースコード |
unit plDBGrid;
interface
uses
Winapi.Windows, Winapi.Messages, System.Classes, Vcl.Controls, Vcl.Forms,
Vcl.StdCtrls, System.UITypes, Vcl.Graphics, Vcl.Dialogs, System.SysUtils,
Data.DB, Vcl.Grids, Vcl.DBGrids;
type
TplDBGrid = class;
TplDBGridBar = class(TScrollBar)
private
FDBGrid : TplDBGrid;
protected
procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); override;
procedure CNCtlcolorscrollbar(var Message: TMessage);
message CN_CTLCOLORSCROLLBAR;
public
constructor Create(AOwner: TComponent); override;
property Color;
end;
TplDBGrid = class(TDBGrid)
private
FVScrollBarColor : TColor;
FHScrollBarColor : TColor;
FVScrollBar : TplDBGridBar;
FHScrollBar : TplDBGridBar;
FVPageSize : Integer;
FHPageSize : Integer;
FVScrollMax : Integer;
FHScrollMax : Integer;
FVCurrentPos : Integer;
FBottomMargin : Integer;
FRightMargin : Integer;
FScrollBars : System.UITypes.TScrollStyle;
procedure SetScrollBars(Value: TScrollStyle);
procedure ScrollBarsSetSizePos(ALeft, ATop, AWidth, AHeight: Integer);
function CalcHorzPageSize: Integer;
function IsDataSetActive: Boolean;
procedure SetHScrollBarColor(const Value: TColor);
procedure SetVScrollBarColor(const Value: TColor);
protected
procedure SetParent(AParent: TWinControl); override;
procedure Resize; override;
procedure SizeChanged(OldColCount: Integer; OldRowCount: Integer); override;
procedure ColWidthsChanged; override;
procedure RowHeightsChanged; override;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure CMVisiblechanged(var Message: TMessage);
message CM_VISIBLECHANGED;
procedure CMEnabledchanged(var Message: TMessage);
message CM_ENABLEDCHANGED;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
procedure TopLeftChanged; override;
procedure Scroll(Distance: Integer); override;
procedure SelectionMoved(const OldSel: TGridRect); override;
public
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
AHeight: Integer); override;
constructor Create(AOwner: TComponent); override;
property VScrollBarColor : TColor read FVScrollBarColor write SetVScrollBarColor;
property HScrollBarColor : TColor read FHScrollBarColor write SetHScrollBarColor;
published
property ScrollBars : TScrollStyle read FScrollBars write SetScrollBars;
end;
procedure Register;
implementation
{ TplDBGrid }
//=============================================================================
// コンポーネントのコンストラクタ (生成時) 処理
//=============================================================================
constructor TplDBGrid.Create(AOwner: TComponent);
begin
inherited;
ScrollBars := ssNone;
FScrollBars := ssBoth;
end;
//=============================================================================
// SetParent メソッドの処理
// TScrollBar の継承コンポーネントを生成
//
// VScrollBar : 縦スクロールバー
// HScrollBar : 横スクロールバー
//=============================================================================
procedure TplDBGrid.SetParent(AParent: TWinControl);
begin
inherited;
if not Assigned(FVScrollBar) then begin
FVScrollBar := TplDBGridBar.Create(self);
FVScrollBar.Parent := Parent;
FVScrollBar.Kind := sbVertical;
FHScrollBar := TplDBGridBar.Create(Self);
FHScrollBar.Parent := Parent;
FHScrollBar.Kind := sbHorizontal;
FRightMargin := FVScrollBar.Width;
FBottomMargin := FHScrollBar.Height;
ScrollBarsSetSizePos(Left, Top, Width, Height);
FVScrollBar.Enabled := False;
FHScrollBar.Enabled := False;
end;
end;
//-----------------------------------------------------------------------------
// ScrollBars プロパティの設定用メソッド
// ssNone 以外は常に表示となる
// ex. ssVertical にすると縦スクロールバーだけが常に表示となる
//-----------------------------------------------------------------------------
procedure TplDBGrid.SetScrollBars(Value: TScrollStyle);
begin
if not Assigned(FVScrollBar) then Exit;
if Value <> FScrollBars then begin
FScrollBars := Value;
FVScrollBar.Visible := (Value = ssBoth) or (Value = ssVertical);
FHScrollBar.Visible := (Value = ssBoth) or (Value = ssHorizontal);
RecreateWnd;
ScrollBarsSetSizePos(Left, Top, Width, Height);
end;
end;
//-----------------------------------------------------------------------------
// 垂直スクロールバーの背景色プロパティの設定用メソッド
//-----------------------------------------------------------------------------
procedure TplDBGrid.SetVScrollBarColor(const Value: TColor);
begin
if not Assigned(FVScrollBar) then Exit;
if FVScrollBarColor <> Value then begin
FVScrollBarColor := Value;
FVScrollBar.Color := FVScrollBarColor;
end;
end;
//-----------------------------------------------------------------------------
// 水平スクロールバーの背景色プロパティの設定用メソッド
//-----------------------------------------------------------------------------
procedure TplDBGrid.SetHScrollBarColor(const Value: TColor);
begin
if not Assigned(FHScrollBar) then Exit;
if FHScrollBarColor <> Value then begin
FHScrollBarColor := Value;
FHScrollBar.Color := FHScrollBarColor;
end;
end;
//-----------------------------------------------------------------------------
// データセットがアクティブかをチェック
//-----------------------------------------------------------------------------
function TplDBGrid.IsDataSetActive: Boolean;
begin
Result := False;
if not Assigned(FVScrollBar) then Exit;
if not (Assigned(DataLink) and DataLink.Active) then Exit;
Result := True;
end;
//-----------------------------------------------------------------------------
// スクロールバーの位置を設定
//-----------------------------------------------------------------------------
procedure TplDBGrid.ScrollBarsSetSizePos(ALeft, ATop, AWidth, AHeight: Integer);
begin
if Assigned(FVScrollBar) then begin
FVScrollBar.Top := ATop;
FVScrollBar.Left := ALeft + AWidth - FRightMargin;
if FHScrollBar.Visible then begin
FVScrollBar.Height := AHeight - FBottomMargin + 2;
end else begin
FVScrollBar.Height := AHeight;
end;
FHScrollBar.Top := ATop + AHeight - FBottomMargin;
FHScrollBar.Left := ALeft;
if FVScrollBar.Visible then begin
FHScrollBar.Width := AWidth - FRightMargin + 2;
end else begin
FHScrollBar.Width := AWidth;
end;
end;
end;
//=============================================================================
// このコンポの位置やサイズが変更された時の処理
// スクロールバーの位置とサイズを設定し直す必要がある
//
// SetBounds はコントロールの位置やサイズが変更された時に自動的に実行される
// この後に自動的に Resize メソッドが実行される
//=============================================================================
procedure TplDBGrid.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited;
ScrollBarsSetSizePos(ALeft, ATop, AWidth, AHeight);
end;
//-----------------------------------------------------------------------------
// 列方向のスクロールのページサイズの計算
// 全ての列幅が同じと仮定した時に(ClientWidth - 固定列の合計ピクセル数)
// に表示可能な列数をページサイズとする
//-----------------------------------------------------------------------------
function TplDBGrid.CalcHorzPageSize: Integer;
var
LColWidth : Integer;
LFixedW : Integer;
LWidth : Integer;
LIndex : Integer;
begin
LColWidth := 0;
for LIndex := FixedCols to ColCount - 1 do begin
if ColWidths[LIndex] > 0 then begin
LColWidth := LColWidth + ColWidths[LIndex];
end;
end;
LFixedW := 0;
for LIndex := 0 to FixedCols - 1 do begin
if ColWidths[LIndex] > 0 then begin
LFixedW := LFixedW + ColWidths[LIndex];
end;
end;
if ClientWidth > (LColWidth + LFixedW) then begin
LWidth := LColWidth;
end else begin
LWidth := ClientWidth - LFixedW;
end;
Result := Round((ColCount - FixedCols) * LWidth / LColWidth);
if Result < 1 then Result := 1;
end;
//=============================================================================
// このコントロールのサイズが変更された時の処理
// スクロールバーのスクロールボックス(つまみ)のサイズとその位置を設定し直す
// スクロールバーの位置とサイズの設定は SetBounds メソッドで自動実行する
// コンポのサイズ変更時は最初に SetBounds メソッドが実行される
//=============================================================================
procedure TplDBGrid.Resize;
var
LVisibleRows : Integer;
LOldVPos : Integer;
LOldHPos : Integer;
begin
inherited;
if not IsDataSetActive then Exit;
LOldVPos := FVScrollBar.Position;
LOldHPos := FHScrollBar.Position;
//-----------------------------------
// 垂直スクロールバー関係の設定
//-----------------------------------
FVScrollMax := DataSource.DataSet.RecordCount;
// クライアント領域の高さ未満のレコード数の時は VisibleRowCount の値が大きくなる
// (実際の値ではない)
// その対策コード
if FVScrollMax <= VisibleRowCount then begin
LVisibleRows := FVScrollMax;
end else begin
LVisibleRows := VisibleRowCount;
end;
if (LVisibleRows = FVScrollMax) or (FVScrollMax <= 1) then begin
// レコード数が少ない場合
FVScrollBar.Enabled := False;
FVScrollBar.Position := 0;
end else begin
FVScrollBar.Enabled := True;
// PageSizeを先に設定する
FVPageSize := LVisibleRows;
;
// 0 ベースとしての設定
FVScrollBar.PageSize := FVPageSize;
if (FVScrollMax < 3) or (FVPageSize < 2) then begin
FVScrollBar.LargeChange := 1
end else begin
FVScrollBar.LargeChange := FVPageSize - 1;
end;
FVScrollBar.SmallChange := 1;
FVScrollBar.Min := 0;
FVScrollBar.Max := FVScrollMax - 1;
FVScrollBar.Position := LOldVPos;
end;
//-----------------------------------
// 水平スクロールバー関係の設定
//-----------------------------------
FHScrollMax := ColCount - FixedCols;
if (VisibleColCount = FHScrollMax) or (FHScrollMax <= 1) then begin
// 列数が少ない場合
FHScrollBar.Enabled := False;
FHScrollBar.Position := 0;
end else begin
FHScrollBar.Enabled := True;
// PageSizeを先に設定する
FHPageSize := CalcHorzPageSize;
// 列の生成中はこの条件を満たさないことがある
// すると列数の範囲の例外が発生する
if FHPageSize < FHScrollMax then begin
// 0 ベースとしての設定
FHScrollBar.PageSize := FHPageSize;
if (FHScrollMax < 3) or (FHPageSize < 2) then begin
FHScrollBar.LargeChange := 1;
end else begin
FHScrollBar.LargeChange := FHPageSize - 1;
end;
FHScrollBar.SmallChange := 1;
FHScrollBar.Min := 0;
FHScrollBar.Max := FHScrollMax - 1;
FHScrollBar.Position := LOldHPos;
end;
end;
end;
//=============================================================================
// 行または列の数が変更された時の処理
// スクロールバーのスクロールボックス(つまみ)のサイズとその位置を設定し直す
//=============================================================================
procedure TplDBGrid.SizeChanged(OldColCount, OldRowCount: Integer);
begin
inherited;
Resize;
end;
//=============================================================================
// 行の高さが変更された時の処理
// スクロールバーのスクロールボックス(つまみ)のサイズとその位置を設定し直す
//=============================================================================
procedure TplDBGrid.RowHeightsChanged;
begin
inherited;
Resize;
end;
//=============================================================================
// 列の幅が変更された時の処理
// スクロールバーのスクロールボックス(つまみ)のサイズとその位置を設定し直す
//=============================================================================
procedure TplDBGrid.ColWidthsChanged;
begin
inherited;
Resize;
end;
//=============================================================================
// Visible プロパティが変更された時の処理
//=============================================================================
procedure TplDBGrid.CMVisiblechanged(var Message: TMessage);
begin
inherited;
if Assigned(FVScrollBar) then begin
FVScrollBar.Visible := Visible;
FHScrollBar.Visible := Visible;
end;
end;
//=============================================================================
// Enabled プロパティが変更された時の処理
//=============================================================================
procedure TplDBGrid.CMEnabledchanged(var Message: TMessage);
begin
inherited;
if Assigned(FVScrollBar) then begin
FVScrollBar.Enabled := Enabled;
FHScrollBar.Enabled := Enabled;
end;
end;
//=============================================================================
// SelectionMoved メソッドの処理
// アンドキュメントなメソッド
//
// 外部から TDataSet.RecNo を設定した時はこのメソッドでないと反応しない
// 外部から RecNo を指定した場合はアクティブなレコード番号の指定を意味する
// このメソッドではマウススクロールとキー操作では反応しない
//=============================================================================
procedure TplDBGrid.SelectionMoved(const OldSel: TGridRect);
begin
inherited;
if DataLink.Active then begin
Scroll(0);
end;
end;
//=============================================================================
// Scroll メソッドの処理
// スクロールによってレコード位置が変更されると発生するメソッド
// スクロールバーの Position の値はその時に決定できる
//
// このメソッドは外部から TDataSet.RecNo を設定しても実行されない
// このコード内の TDataSet.RecNo は現在アクティブなレコード番号
// Draw 系メソッド内では DataLink,AcriveRecord で取得できる
// Draw 系メソッド内の RecNo はレコードの一連番号
//=============================================================================
procedure TplDBGrid.Scroll(Distance: Integer);
begin
if Distance <> 0 then begin
inherited;
end;
FVScrollBar.Position := DataSource.DataSet.RecNo - (Row - FixedRows + 1);
FVCurrentPos := FVScrollBar.Position;
end;
//=============================================================================
// TopLeftChanged メソッドの処理
// セルの上端または左端が変更になった時に実行されるメソッド
// TDBGrid では td-date の値は常に 0
//=============================================================================
procedure TplDBGrid.TopLeftChanged;
begin
inherited;
FHScrollBar.Position := LeftCol - FixedCols;
end;
//=============================================================================
// KeyDown メソッドの処理 (OnKeyDown イベントに相当)
//=============================================================================
procedure TplDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
var
LIndex : Integer;
begin
if Key = VK_NEXT then begin
for LIndex := 0 to FVScrollBar.LargeChange - 1 do begin
Perform(WM_VSCROLL, MakeWParam(SB_LINEDOWN, 0), 0);
end;
Key := 0;
Exit;
end else
if Key = VK_PRIOR then begin
for LIndex := 0 to FVScrollBar.LargeChange - 1 do begin
Perform(WM_VSCROLL, MakeWParam(SB_LINEUP, 0), 0);
end;
Key := 0;
Exit;
end;
inherited;
end;
//=============================================================================
// DoMouseWheel メソッド (OnMouseWheel イベント相当) の処理
//
// 元の TDBGrid と仕様を変更している
// 元の TDBGrid ではキー操作によるスクロールと同じ
// クライアント領域内ではスクロールしない
// 本コンポでは直ちにスクロールする
// スクロール量はシステムの設定値を使用する
//=============================================================================
function TplDBGrid.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
var
LDelta : Integer;
LIndex : Integer;
begin
SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @LDelta, 0);
if WheelDelta < 0 then begin
for LIndex := 0 to LDelta - 1 do begin
Perform(WM_VSCROLL, MakeWord(SB_LINEDOWN, 0), 0);
end;
Result := True;
end else begin
for LIndex := 0 to LDelta - 1 do begin
Perform(WM_VSCROLL, MakeWord(SB_LINEUP, 0), 0);
end;
Result := True;
end;
end;
//-----------------------------------------------------------------------------
// TDBGird の WM_NCCALCSIZE メッセージ処理
// スクロールバー表示のスタイルを強制的に変更
// 以下のコードを実行すると元の ScrollBarsによる設定は無効になる
// 本コンポでは ScrollBars プロパティを独自仕様にしている
//-----------------------------------------------------------------------------
procedure TplDBGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
var
LStyle : Integer;
LBMargin : Integer;
LRMargin : Integer;
LRect : TRect;
LResRect : TRect;
begin
if Visible then begin
LStyle := GetWindowLong(Handle, GWL_STYLE);
LStyle := LStyle and not WS_VSCROLL and not WS_HSCROLL;
SetWindowLong(Handle, GWL_STYLE, LStyle);
end;
inherited;
// クライアント領域の設定
// スクロールバーを配置する非クライアント領域の設定
// スクロールバーの位置とサイズは ScrollBars プロパティ設定メソッド内で実行
if Assigned(FVScrollBar) then begin
if Message.CalcValidRects then begin
LRMargin := FRightMargin;
LBMargin := FBottomMargin;
if not FVScrollBar.Visible then LRMargin := 0;
if not FHScrollBar.Visible then LBMargin := 0;
// rgrc[0] : 移動またはサイズ変更後のウィンドウ値
// rgrc[1] : 移動またはサイズ変更前のウィンドウ値
// rgrc[2] : 移動またはサイズ変更前のクライアント領域の値
// と MS Windows Dev Center にはあるのだが...
LRect := message.CalcSize_Params.rgrc[0];
LResRect := Rect(Left, Top, LRect.Right - LRMargin, LRect.Bottom - LBMargin);
message.CalcSize_Params.rgrc[0] := LResRect;
Message.Result := 0
end;
end;
end;
//-----------------------------------------------------------------------------
// WM_NCPAINT メッセージ処理
// 非クライアント領域の再描画が必要になった時に発生するメッセージ
//-----------------------------------------------------------------------------
procedure TplDBGrid.WMNCPaint(var Message: TWMNCPaint);
var
LhHDC : HDC;
LCanvas : TCanvas;
begin
inherited;
LCanvas := TCanvas.Create;
LhHDC := GetWindowDC(Handle);
try
LCanvas.Handle := LhHDC;
// ClipRect で非クライアント領域を塗り潰してクライアント領域を再描画
LCanvas.FillRect(LCanvas.ClipRect);
Invalidate;
finally
ReleaseDC(Handle, LhHDC);
FreeAndNil(LCanvas);
end;
Message.Result := 0;
end;
{ TplDBGridBar }
//=============================================================================
// TScrollBox コンポーネントの派生クラスのコンストラクタ (生成時) 処理
//=============================================================================
constructor TplDBGridBar.Create(AOwner: TComponent);
begin
inherited;
FDBGrid := TplDBGrid(AOwner);
end;
//-----------------------------------------------------------------------------
// CN_CTLCOLORSCROLLBAR メッセージ処理
// Color プロパティの実装用
//-----------------------------------------------------------------------------
procedure TplDBGridBar.CNCtlcolorscrollbar(var Message: TMessage);
begin
DefaultHandler(Message)
end;
//=============================================================================
// スクロール時の処理
// このメソッド(イベント) では TScrollBar 操作によるスクロールだけを処理
// Position プロパティによる設定は処理しない
// トラッキングが ON と同じスクロールなので大量のデータで難があるかも知れない
//
// TScrollBar は下端または右端まで移動して操を続けると Position の値が増加する
// Position の値の増加が不要になったら引数の ScrollPos に戻す値を渡す
//=============================================================================
procedure TplDBGridBar.Scroll(ScrollCode: TScrollCode;
var ScrollPos: Integer);
var
LScrollPos : Integer;
LSBCode : DWORD;
LScrollCnt : Integer;
LTrackTop : Integer;
LCellPos : Integer;
LLastCol : Integer;
LIndex : Integer;
begin
inherited;
if not FDBGrid.IsDataSetActive then Exit;
if ScrollCode = scPosition then Exit;
LScrollPos := ScrollPos;
// 垂直(縦・行方向)スクロールバー
if Self.Kind = sbVertical then begin
LTrackTop := FDBGrid.FVScrollMax - FDBGrid.FVPageSize + 1;
LScrollCnt := LScrollPos - FDBGrid.FVCurrentPos;
if LScrollCnt >= 0 then begin
LSBCode := SB_LINEDOWN;
end else begin
LScrollCnt := -LScrollCnt;
LSBCode := SB_LINEUP;
if FDBGrid.FVCurrentPos = 0 then begin
LScrollCnt := 0;
end;
end;
for LIndex := 0 to LScrollCnt - 1 do begin
FDBGrid.Perform(WM_VSCROLL, MakeWParam(LSBCode, 0), 0);
end;
if LScrollPos <= 0 then begin
// 変更した値を引数に返す
ScrollPos := 0;
Position := 0;
end else
if LScrollPos >= LTrackTop then begin
// 変更した値を引数に返す
ScrollPos := LTrackTop;
Position := LTrackTop;
end else begin
Position := LScrollPos;
end;
FDBGrid.FVCurrentPos := Position;
end;
// 水平(横・列方向)スクロールバー
if Self.Kind = sbHorizontal then begin
LCellPos := LScrollPos + FDBGrid.FixedCols;
LLastCol := LCellPos + FDBGrid.VisibleColCount - FDBGrid.FixedCols;
if LLastCol > (FDBGrid.ColCount - FDBGrid.FixedCols) then begin
LCellPos := FDBGrid.ColCount - FDBGrid.VisibleColCount - FDBGrid.FixedCols;
Position := LCellPos;
// 変更した値を引数に返す
ScrollPos := Position;
end else begin
if LCellPos <= FDBGrid.FixedCols then begin
FDBGrid.LeftCol := FDBGrid.FixedCols;
end else begin
FDBGrid.LeftCol := LCellPos;
end;
end;
end;
end;
//=============================================================================
// コンポーネント登録情報
// コンポーネントパレットの[plXRAY]というタブに登録
// 指定したタブがない場合は,自動的に作成される
//=============================================================================
procedure Register;
begin
RegisterComponents('plXRAY', [TplDBGrid]);
end;
end.
06_固定列の設定機能付き TDBGrid コンポーネント |
TDBGrid の protected
部に固定列の列数を設定する FixedCols プロパティがありますが,この値を設定しても固定列の数は変化しません.そこで,以下の記事を参考にしてテーマに対応したコンポーネントを作成してみました.
TDBGrid のインジケータは固定列です.したがつて,固定列の列数は,このインジケータを含めた値で指定します.このテストプログラムでは SQL 文で取得した最初の項目を固定列として追加します.
固定列に設定した列のセルは選択できません.水平方向 (列方向) のスクロールでスクロールしません.常に左端に表示された状態となります.
|
|
図10
固定列の設定結果
|
下図はインジケータを非表示にした結果です.TDBGrid では,1 つ以上の固定列と 1 つ以上の固定行が必要です.FixedCols プロパティの値を 0 にすることはできません.
以下のように,Options で dgIndicator, dgTitles を除外すれば,インジケータの列と固定列であるタイトル行を非表示にすることは可能です.
|
DBGrid1.Options := DBGrid1.Options - [dgIndicator, dgTitles];
|
図11
インジケータを非表示 |
リスト7
固定列の設定が可能な 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, plFixDBGrid;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
Panel1: TPanel;
Query1: TQuery;
Button1: TButton;
DBGrid1: TDBGrid;
plFixDBGrid1: TplFixDBGrid;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//=============================================================================
// フォーム生成時の処理
// TplFixDBGrid をフォームに配置してテスト
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LItemList : string;
begin
// TDBGrid のオプションの設定
plFixDBGrid1.Options := plFixDBGrid1.Options - [dgMultiSelect];
plFixDBGrid1.Options := plFixDBGrid1.Options - [dgEditing];
Query1.Close;
// データベース関係コントロールの設定
DataSource1.DataSet := Query1;
plFixDBGrid1.DataSource := DataSource1;
// データベースからデータを取得して表示
Query1.DatabaseName := 'DBDEMOS';
Query1.SQL.Clear;
LItemList := 'Company, CustNo, Addr1, State, City, Zip, Phone';
Query1.SQL.Add('select ' + LItemList + ' from customer.db');
Query1.Open;
// 固定列の設定
// Company のフィールドが固定列となる
// インジケータは固定列なので固定列は 2 とする
// 本サンプルではオブジェクト・インスペクタで設定済み
// plFixDBGrid1.FixedCols := 2;
plFixDBGrid1.Columns[0].Title.Caption := '店舗名';
ActiveControl := plFixDBGrid1;
end;
//=============================================================================
// フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Query1.Close;
end;
//=============================================================================
// インジケータの表示・非表示の切り換え
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
if dgIndicator in plFixDBGrid1.Options then begin
plFixDBGrid1.Options := plFixDBGrid1.Options - [dgIndicator];
plFixDBGrid1.FixedCols := 1;
end else begin
plFixDBGrid1.Options := plFixDBGrid1.Options + [dgIndicator];
plFixDBGrid1.FixedCols := 2;
end;
ActiveControl := plFixDBGrid1;
end;
end.
リスト8
TDBGri.FixedCols プロパティの設定を有効にするコンポーネントのソースコード |
unit plFixDBGrid;
interface
uses
Winapi.Windows, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls,
Vcl.Dialogs, Data.DB, Vcl.Grids, Vcl.DBGrids;
type
TplFixDBGrid = class(TDBGrid)
private
{ Private 宣言 }
FFixedCols : Integer;
procedure SetFixedCols(const Value: Integer);
protected
procedure LayoutChanged; override;
procedure LinkActive(Value: Boolean); override;
function SelectCell(ACol: Integer; ARow: Integer): Boolean; override;
procedure DrawCell(ACol: Integer; ARow: Integer; ARect: TRect;
AState: TGridDrawState); override;
procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
Column: TColumn; State: TGridDrawState); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
constructor Create(AOwner: TComponent); override;
published
property FixedCols : Integer Read FFixedCols Write SetFixedCols Default 1;
end;
procedure Register;
implementation
uses
Themes;
{ TplFixDBGrid }
//=============================================================================
// コンポーネント (クラス) の生成処理
// 固定列の設定が可能な TDBGrid
//=============================================================================
constructor TplFixDBGrid.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
FFixedCols := 1;
end;
//-----------------------------------------------------------------------------
// FixedCols プロパティの設定用メソッド
// 固定カラムの数がカラム数より大きい時の処理は省略
//-----------------------------------------------------------------------------
procedure TplFixDBGrid.SetFixedCols(const Value: Integer);
begin
If FFixedCols <> Value then begin
FFixedCols := Value;
if FFixedCols <= 0 then FFixedCols := 1;
if Assigned(DataLink) and DataLink.Active then begin
Inherited FixedCols := FFixedCols;
end;
end;
end;
//=============================================================================
// LayoutChanged メソッドの処理
// 列のレイアウトに影響する変更があったときに自動的に呼び出されるメソッド
//=============================================================================
procedure TplFixDBGrid.LayoutChanged;
var
LSave : Integer;
LIndex : Integer;
begin
Inherited;
if (csLoading in ComponentState) then Exit;
LSave := FixedCols;
FixedCols := 1;
FixedCols := LSave;
if Assigned(DataLink) and DataLink.Active then begin
// スクロールはしない
// フォーカスは固定列以外の列に
Scroll(0);
// 固定列の右側に移動 (Col の値は 0 ベース)
Col := FFixedCols;
// TabStops [TAB] キーによる選択セル移動機能 ) の設定
// 状態が変化する LayoutChanged メソッド内で設定しないと有効にならない
for LIndex := 0 To FFixedCols - 1 do begin
TabStops[LIndex] := False;
end;
for LIndex := FFixedCols to ColCount - 1 do begin
TabStops[LIndex] := True;
end;
end;
end;
//=============================================================================
// LinkActive メソッドの処理
//
// データセットを開いた時や閉じる時にとき自動的実行されるメソッド
// この時に Columns プロパティの再計算が行われる
//=============================================================================
procedure TplFixDBGrid.LinkActive(Value: Boolean);
begin
Inherited;
if Value then begin
Inherited FixedCols := FFixedCols;
end else begin
if dgIndicator in Options then begin
Inherited FixedCols := 1;
end;
end;
Invalidate;
end;
//=============================================================================
// SelectCell メソッドの処理
// 固定列のセル選択不可にする
//=============================================================================
function TplFixDBGrid.SelectCell(ACol, ARow: Integer): Boolean;
begin
Result := Inherited SelectCell(ACol, ARow);
if ACol < FFixedCols then begin
Result := False;
end;
end;
//=============================================================================
// KeyDownl メソッドの処理
// 固定列のセルには移動しないようにする
// 矢印キーの操作では固定列に伊藤しない
//=============================================================================
procedure TplFixDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
if not (ssCtrl In Shift) then begin
if Key = VK_HOME then begin
If Col > FFixedCols then Begin
Col := FixedCols;
Exit;
end;
end;
end;
Inherited;
end;
//=============================================================================
// DrawCell メソッド処理
//
// 固定列のキャプションは自動では描画してくれない
// DrawColumnCell. DrawDataCell では固定列のタイトルは描画できない
// DrawCell に対応する外部イベントはない
//
// TDBGrid.DrawingStyle が gdsGradient の時の処理は省略 (手抜き)
//=============================================================================
procedure TplFixDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
var
LFixCol : Integer;
LColumn : TColumn;
LDrawFlag : Integer;
LColText : string;
LStyle : TCustomStyleServices;
LDetails : TThemedElementDetails;
LFormat : TTextFormat;
begin
if dgIndicator in Options then begin
LFixCol := ACol - 1;
end else begin
LFixCol := ACol;
end;
if LFixCol >= 0 then begin
LColumn := Columns[LFixCol];
end;
inherited;
// Options に dgIndicator がある時は ACol = 0 はインジケータの列
if LFixCol < 0 then Exit;
if (dgTitles in Options) and (ARow = 0) and (ACol < FFixedCols) then begin
// 背景を描画
if (ThemeServices.Enabled) and (DrawingStyle = gdsThemed) then begin
// テーマが有効な場合
// 状態によって種類を変更
LStyle := StyleServices;
if gdPressed in AState then begin
LDetails := LStyle.GetElementDetails(tgFixedCellPressed);
end else
if gdHotTrack in AState then begin
LDetails := LStyle.GetElementDetails(tgFixedCellHot);
end else begin
LDetails := LStyle.GetElementDetails(tgFixedtd-normal);
end;
InflateRect(ARect, 1, 1);
LStyle.DrawElement(Canvas.Handle, LDetails, ARect, nil);
InflateRect(ARect, -1, -1);
end else begin
// クラシックスタイルの場合
Canvas.Brush.Color := LColumn.Title.Color;
Canvas.FillRect(ARect);
end;
// カラムのタイトルを取得
Canvas.Font := LColumn.Title.Font;
LColText := LColumn.Title.Caption;
// テキスト描画ノアライメントを取得
case LColumn.Title.Alignment of
taLeftJustify : LFormat := [tfLeft];
taRightJustify : LFormat := [tfRight];
else
LFormat := [tfCenter];
end;
LFormat := LFormat + [tfVerticalCenter, tfSingleLine];
InflateRect(ARect, -2, -2);
if (ThemeServices.Enabled) and (DrawingStyle = gdsThemed) then begin
// テーマが有効な場合
LDetails := StyleServices.GetElementDetails(tgFixedtd-normal);
LStyle.DrawText(Canvas.Handle, LDetails, LColText, ARect, LFormat);
end else begin
// クラシックスタイルの場合
Canvas.TextRect(ARect, LColText, LFormat);
if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then begin
InflateRect(ARect, 2, 2);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
end;
end;
end;
end;
//=============================================================================
// DrawColumnCell メソッドの処理
// セルの描画が必要になったときに実行されるメソッド
// 固定行のデータを描画
//
// 固定列のデータは,テーマが有効な時は再描画をしない
// そのままだと重ね描画になってしまう (描画が乱れるという言い方もある)
// この処理は DrawDataCell メソッドでも可能
// DrawCell メソッドではデータが正常に取得できないのでこの処理は不可
//
// TDBGrid.DrawingStyle が gdsGradient の時の処理は省略 (手抜き)
//=============================================================================
procedure TplFixDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
Column: TColumn; State: TGridDrawState);
var
LStyle : TCustomStyleServices;
LDetails : TThemedElementDetails;
LRect : TRect;
begin
inherited;
if gdFixed in State then begin
// 領域を塗り潰す
// 塗り潰さないと前の描画内容が残されたままとなり重ね描画となる
LRect := Rect;
if (ThemeServices.Enabled) and (DrawingStyle = gdsThemed) then begin
InflateRect(LRect, 1, 1);
LStyle := StyleServices;
LDetails := LStyle.GetElementDetails(tgFixedtd-normal);
LStyle.DrawElement(Canvas.Handle, LDetails, LRect, nil);
end else begin
InflateRect(LRect, 1, 1);
Canvas.Brush.Color := FixedColor;
end;
// データを描画
DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
end;
//=============================================================================
// コンポーネント登録情報
// コンポーネントパレットの[plXRAY]というタブに登録
// 指定したタブがない場合は,自動的に作成される
//=============================================================================
procedure Register;
begin
RegisterComponents('plXRAY', [TplFixDBGrid]);
end;
end.
07_TDBGrid の固定列を使用したレコード番号の表示 |
作成した TplFixDBGrid
コンポーネントを利用して,TDBGrid の固定列にレコード番号を表示する例です.計算項目を追加してもいいのですが,本サンプルでは,項目の別名を作成してそこにレコード番号を表示するようにしています.そのために,plFixDBGrid.pas 内の DrawColumnCell メソッドのコードを書き換えてテストしています.
TplFixDBGrid では固定列を選択も編集できないようになっています.編集できなければインプレイスエディタが起動して元のデータを表示することはありません.計算項目でなくても,元のデータとは別の値をセルに描画したままにできます.
下図は,TplFixDBGrid の継承元を TDBGrid ではなく,上の方の記事に掲載している TplDBGrid として実行した結果です.
このサンプルは EXE だけを添付しています.
|
TplFixDBGrid = class(TplDBGrid)
レコード番号は,SQL 文の実行によって取得したデータ (レコード) の一連番号です.データベースに格納されているデータの番号ではありません.データベースにはレコードを一意に識別する値はありません.データベースのデータには,データの番号やレコード番号の概念はありません.
レコード番号の最初の値は常に 1 です. |
|
図12
固定列にレコード場号を表示 |
リスト9
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, plFixDBGrid;
type
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 宣言 }
public
{ Public 宣言 }
plFixDBGrid1 : TplFixDBGrid;
end;
var
Form1: TForm1;
implementation
uses
plChgCompo;
{$R *.DFM}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LItemList : string;
begin
// フ ォーム作成時にコンポーネントの入れ替え
plFixDBGrid1 := TplFixDBGrid(ChangeComponent(DBGrid1, TplFixDBGrid));
// TDBGrid のオプションの設定
plFixDBGrid1.Options := plFixDBGrid1.Options - [dgMultiSelect];
plFixDBGrid1.Options := plFixDBGrid1.Options - [dgEditing];
Query1.Close;
// データベース関係コントロールの設定
DataSource1.DataSet := Query1;
plFixDBGrid1.DataSource := DataSource1;
// データベースからデータを取得して表示
// フィールド CustNo の別名を追加
// ここにレコード番号を表示する
Query1.DatabaseName := 'DBDEMOS';
Query1.SQL.Clear;
LItemList := 'CustNo as RecNo, CustNo, Company, Addr1, State, City, Zip, Phone';
Query1.SQL.Add('select ' + LItemList + ' from customer.db');
Query1.Open;
// 固定列の設定
plFixDBGrid1.FixedCols := 2;
plFixDBGrid1.Columns[0].Title.Caption := '番号';
plFixDBGrid1.Columns[0].Width := 40;
plFixDBGrid1.VScrollBarColor := $00208FFF;
plFixDBGrid1.HScrollBarColor := $00208FFF;
ActiveControl := plFixDBGrid1;
end;
//=============================================================================
// フォームを閉じる時の処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Query1.Close;
end;
end.
TDBGrid の固定列にレコード番号を表示するために,plFixDBGrid.pas 内の
DrawColumnCell
メソッドのコードを,今回は以下のように変更しています.コードを変更しても,実行時に動作を確認するだけであれば,コンポーネントを登録したパッケージの再構築 (ビルド) は必要ありません.
レコード番号を取得する SQL の関数,ROWNUM や ROW_NUMBER が使用可能であれば,DrawColumnCell メソッドのコードを以下のように変更する必要はありません.
BDE +
Paradox では,それらの SQL の関数は使用できません.
|
//=============================================================================
// DrawColumnCell メソッドの処理
// 固定行のデータを描画
// 最初の固定列 (インジケータを除く) にレコード番号を描画する例
//=============================================================================
procedure TplFixDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
Column: TColumn; State: TGridDrawState);
var
LRect : TRect;
LDrawText : string;
LFormat : TTextFormat;
begin
inherited;
if (gdFixed in State) and (DataCol = 0) then begin
// 領域を塗り潰す
// 塗り潰さないと前の描画内容が残されたままとなり重ね描画となる
LRect := Rect;
InflateRect(LRect, 2, 2);
Canvas.Brush.Color := clSkyBlue;
Canvas.FillRect(LRect);
// データを描画
LRect.Right := LRect.Right - 5;
Canvas.Font := Column.Font;
LDrawText := IntToStr(DataSource.DataSet.RecNo);
LFormat := [tfRight, tfVerticalCenter, tfSingleLine];
Canvas.TextRect(LRect, LDrawText, LFormat);
end;
end;
|