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.

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.

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.

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.

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.

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 では TopRow の値は常に 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.

  DBGrid1.Options := DBGrid1.Options - [dgIndicator, dgTitles];

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.

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(tgFixedCellNormal);
      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(tgFixedCellNormal);
      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(tgFixedCellNormal);
      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.

  TplFixDBGrid = class(TplDBGrid)

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.

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