この発言は
#00715　謎の全知師      さんの固定セル設定可能なDBGrid
に対するコメントです



<固定列編集>>

謎の全知師氏の作られた固定セル設定可能なDBGrid「TFixDBGrid」をいぢって、
固定セルを編集可能にしてみたサンプルです。
固定セル状態で編集するのは難しいので、一時的に固定列を解除すると言う、
姑息な手段をとっています。

オリジナルの「TFixDBGrid」をお使いの方でもそのままインストール出来るよ
うに、クラス名を変更してあります。
以下のユニットを「DBGridFx.Pas」として保存し、パッケージに組み込んで下
さい。
動作確認は、Delphi3.1，Delphi4ですが、いずれも簡単なテストしかしており
ませんので、注意して使ってください。

{--------------- DBGridFx.pas ここから ---------------------}
unit DBGridFx;

interface

uses
  Windows, SysUtils, Classes, Grids, DBGrids;

type
  TDBGridFx = class(TDBGrid)
  private
    FFixedCols:Integer;
    FCurFixedCol : Integer;
    FFixedColsEdit:Boolean;
    FAsRowSelect:boolean;
  protected
{$IFDEF VER120}
    procedure DrawCell(ACol, ARow: Integer; ARect: TRect;
                                   AState: TGridDrawState); Override;
{$ENDIF}
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure LayoutChanged; override;
    procedure LinkActive(Value: Boolean); override;
    function  SelectCell(ACol, ARow: Longint): Boolean; override;
    function  HighlightCell(DataCol, DataRow: Integer; const Value: string;
      AState: TGridDrawState): Boolean; override;
    procedure SetCurFixedCol(Value : Integer); virtual;
    procedure SetFixedCols(Value : Integer); virtual;
    procedure SetAsRowSelect(Value:boolean);
  public
    Constructor Create(AOwner : TComponent); override;
    property LeftCol;

  published
    {固定列の設定}
    property FixedCols : Integer Read FCurFixedCol Write SetFixedCols
                                                                  Default 1;
    {固定列も編集したい！}
    property FixedColsEdit:boolean read FFixedColsEdit write FFixedColsEdit;
    {dgRowSelectのように見せかけてカーソルキーで横スクロールしたい！}
    property AsRowSelect:boolean read FAsRowSelect write SetAsRowSelect;
  end;

procedure Register;

implementation

constructor TDBGridFx.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FCurFixedCol := 1;
  FFixedCols   := 1;
end;

{$IFDEF VER120}
procedure TDBGridFx.DrawCell(ACol, ARow: Longint; ARect: TRect;
                                                AState: TGridDrawState);
var
   C : Integer;
   DrawFlg : Integer;
   Text : string;
   Column : TColumn;
begin
  C := ACol - Ord(dgIndicator in Options);

  if C >= 0 then
  begin
    if ((dgTitles in Options) and (ARow = 0)) or (C < FFixedCols) then
    begin
      Column := Columns[C];
      Canvas.Font := Column.Font;
      Canvas.Font := Column.Title.Font;
      Canvas.Brush.Color := Column.Title.Color;
      Canvas.FillRect(ARect);
      Text := Column.Title.Caption;
      case Column.Title.Alignment of
        taLeftJustify  : DrawFlg := DT_LEFT;
        taRightJustify : DrawFlg := DT_RIGHT;
        else             DrawFlg := DT_CENTER;
      end;
      DrawFlg := DrawFlg or DT_SINGLELINE;
      InflateRect(ARect, -2, -2);
      DrawText(Canvas.Handle, PChar(Text), -1 , ARect, DrawFlg);
      InflateRect(ARect, 2, 2);
      if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines]
      then begin
        DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
        DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
      end;
    end;
  end;
  inherited;
end;
{$ENDIF}

procedure TDBGridFx.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if not (ssCtrl in Shift) then begin
    case Key of
      VK_HOME :
        if Col > FCurFixedCol then begin
          Col := FCurFixedCol;
          Exit;
        end;
    end;
  end;
  inherited;
end;

function TDBGridFx.HighlightCell(DataCol, DataRow: Integer;
                const Value: string; AState: TGridDrawState): Boolean;
begin
  Result := inherited HighLightCell(DataCol,DataRow,Value,AState);
  if DataLink.Active and FAsRowSelect then
    Result:=Result or (DataLink.ActiveRecord=Row-Ord(dgTitles in Options));
end;

procedure TDBGridFx.SetAsRowSelect(Value:boolean);
begin
  if FAsRowSelect<>Value then begin
    FAsRowSelect:=Value;
    if Value then Options := Options - [dgEditing];
    LayoutChanged;
  end;
end;

procedure TDBGridFx.LayoutChanged;
begin
  try
    inherited;
    if (csLoading in ComponentState) then Exit;

    if (DataSource         <> Nil) and
       (DataSource.DataSet <> Nil) and
       (DataSource.DataSet.Active)
    then begin
      SetCurFixedCol(Ord(dgIndicator in Options));
      SetCurFixedCol(FFixedCols);
      inherited Scroll(0);
    end;
  except
    raise;
  end;
end;

procedure TDBGridFx.LinkActive(Value: Boolean);
var
   i : Integer;
begin
  inherited;
  if Value then begin
    inherited FixedCols := FCurFixedCol;
    for i := 0 to FCurFixedCol - 1 do TabStops[i] := False;
  end else begin
    inherited FixedCols := Ord(dgIndicator in Options);
  end;
  Invalidate;
end;

function TDBGridFx.SelectCell(ACol, ARow: Longint): Boolean;
begin
  Result := inherited SelectCell(ACol, ARow);
  if FFixedColsEdit then begin
    try
      if (ACol <= FFixedCols) then SetCurFixedCol(ACol)
      else
      if (FFixedCols<>FCurFixedCol) then SetCurFixedCol(FFixedCols);
      Result:=True;
    except
      Result := False;
    end;
  end else begin
    if (ACol < FCurFixedCol) then
      Result:=False;
  end;
end;

procedure TDBGridFx.SetFixedCols(Value : Integer);
begin
  if FFixedCols<>Value then begin
    FFixedCols:=Value;
    LayoutChanged;
  end;
end;

procedure TDBGridFx.SetCurFixedCol(Value : Integer);
var
   i, j, k, fVal : Integer;
begin
  k:=Ord(dgIndicator in Options);
  if Value < k then fVal:= k else fVal:=Value;
  if FCurFixedCol <> fVal then begin
    if (DataSource         <> Nil) and
       (DataSource.DataSet <> Nil) and
       (DataSource.DataSet.Active)
    then begin
      if (ColCount < FCurFixedCol) then j:=ColCount else j:=FCurFixedCol;
      for i := k to j - 1 do TabStops[i] := True;
      //データセットの切り替えでカラム数が変わったりするので
      //例外を発生させずに無理やり調整してみました。
         //固定カラム数が総カラム数より大きい場合
      if ColCount <= fVal then fVal:=ColCount-1;
         //固定カラムの数が' + IntToStr(k) + 'より小さい場合
      if fVal < k then fVal:=k;
      FCurFixedCol := fVal;
      inherited FixedCols := fVal;
      for i := 0 to FCurFixedCol - 1 do TabStops[i] := False;
    end else
      FCurFixedCol := fVal;

    Invalidate;
  end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TDBGridFx]);
end;

end.
{------------- DBGridFx.pas ここまで -----------------------------}

                              ... PBA03237 長閑（のどか）...

Original document by 長閑            氏 ID:(PBA03237)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。