TDBGridの描画が変！？(MyBase接続時)

TCustomDBGridから派生した自作コンポーネントの修正をしていたのですが、時々描画がおかしくなるときがあり、いろいろ調べてみるとTDBGrid自体の描画が変な時がありました。

その１
TDBGridは、標準機能としてMouseOverでColumnsが強調表示されます。標準のテーマではわかりにくかったので、VCL StyleのGolden Graphiteを使っています。

しかし次のように先頭レコードのインジゲーター部分も強調表示されています。（他のレコードでは表示されない）まあ、これは気にするほどのことではないです。

その２
編集時にマウスの移動によって、セルの描画がおかしくなります。文字部分は、InplaceEditorが扱っているので、問題ないですけど、場合によっては、インジゲーターのアイコンが表示されたりします。結果として、ADTを使わない場合、ClientDataSet1.ObjectViewをFalseにすると問題なく描画されるようになりました。ADTがある場合は、Falseに設定していたとしても自動的にTrueになるようで、解決できませんでした。

アンダーラインのようなもの？（カラムが描画されてるのかも）

フォーカス枠の残り？

描画のタイミングが悪い？

Delphi2007とDelphi2009でも試してみましたが、こちらでは全く問題なかったです。（まあグリッドの描画があれですけど）

試しにDefaultDrawingをFalseに設定して、試してみました。 マウスを動かすとカラムのタイトルやインジゲーターアイコンが表示されます。 上手くマウスを動かすとこんな描画になります(^-^)こんなものがDefaultDrawingを使わなくても描画されていたら、オーナードローでは解決できなさそうです。（InplaceEditor表示後に描画されているのが厄介です）

ならば、DrawCellを全く表示させないとどうなるかを試してみました。 やはりDrawCell以外の部分での描画が影響しているようですね。

  TDBGridTest = class(TDBGrid)
  protected
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
  end;

procedure TDBGridTest.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
begin
  Exit;
  inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // TStyleManager.TrySetStyle('Golden Graphite');
  with ClientDataSet1 do
  begin
    FieldDefs.Add('ID',ftAutoInc);
    FieldDefs.Add('ITEM',ftWideString,10);
    FieldDefs.Add('QTY',ftFloat);
    FieldDefs.Add('UNIT',ftWideString,4);
    FieldDefs.Add('PRICE',ftCurrency);
    CreateDataSet;

    Append;
    FieldByName('ITEM').AsString := 'PEN';
    FieldByName('QTY').AsInteger := 10;
    FieldByName('UNIT').AsString := '本';
    FieldByName('PRICE').AsString := '1000';
    Append;
    FieldByName('ITEM').AsString := 'Fan';
    FieldByName('QTY').AsInteger := 3;
    FieldByName('UNIT').AsString := '台';
    FieldByName('PRICE').AsString := '30000';
    Append;
    FieldByName('ITEM').AsString := 'PC';
    FieldByName('QTY').AsInteger := 1;
    FieldByName('UNIT').AsString := '台';
    FieldByName('PRICE').AsString := '180000';
    CheckBrowseMode;
  end;

  TestDBGrid:= TDBGridTest.Create(Self);
  TestDBGrid.Parent := self;
  TestDBGrid.align := alClient;
  DataSource1.DataSet := ClientDataSet1;
  TestDBGrid.DataSource := DataSource1;
end;

MyBaseを試してみる。(フィールド作成編)

私が過去に作ったソフトの中には、DBGridを使うためだけに、BDE(TTable)＋Paradoxを採用しているものがたくさんありました。TStringGridだとColumnsやPickListの実装が面倒ですし、TListViewも編集が伴う場合は、UIとしては今ひとつですしね。
特にParadoxではレコードを追加する場合 Insert、Append を使い分ければ、インデックスを設定することなくデータの順番も保持されるため、リスト構造を扱うような感覚で簡単にプログラムができました。Paradoxは、Windows7であっても下記のサイトを参考すれば、まだなんとか使えなくもない。しかしながら今後のことを考えるといつまでも甘えているわけにはいかない状況です。
というか、いまだに使ってるの？というレベルかも知れませんけど(^-^)

ＤＥＫＯのアヤシいお部屋。
今更ながら BDE (Borland Database Engine)

教えて！goo
BDE初期化中にエラーが発生しました。$210D

データベースは必要ないものの、TDBGridで処理をしたい・・・そんな用途にはシンプルにMyBaseが便利かも知れません。ただ私は今までMyBaseを本格的に扱ったことがないので、いろいろ調べてみようと思います。今回は、実行時にフィールドを作成してみました。わざわざフィールドの定義・作成を取り上げたのは、ADT、計算項目、集合項目を使う場合の設定とかの情報があまりなさそうだったからです。あっ、ちなみに今回もいつものように試行錯誤の結果です(^-^)
各設定とそれを実行した場合のショットになっています。

---

procedure Test1(CDS: TClientDataSet);
var
  C: TCurrencyField;
  I: Integer;
begin
  InitCDS(CDS);
  CDS.FieldDefs.Add('ID',ftAutoInc);
  CDS.FieldDefs.Add('ITEM',ftWideString,10);
  CDS.FieldDefs.Add('QTY',ftFloat);
  CDS.FieldDefs.Add('UNIT',ftWideString,4);
  CDS.FieldDefs.Add('PRICE',ftCurrency);
  CDS.CreateDataSet;
end;

---

procedure Test2(CDS: TClientDataSet);
var
  I: Integer;
  Aggregate: TAggregate;
begin
  InitCDS(CDS);
  CDS.FieldDefs.Add('ID',ftAutoInc);
  CDS.FieldDefs.Add('ITEM',ftWideString,10);
  CDS.FieldDefs.Add('QTY',ftFloat);
  CDS.FieldDefs.Add('UNIT',ftWideString,4);
  CDS.FieldDefs.Add('PRICE',ftCurrency);
  CDS.CreateDataSet;
  CDS.Close;

  for I := 0 to CDS.FieldDefs.Count - 1 do
    CDS.FieldDefs[I].CreateField(CDS);

  // 計算フィールド
  with TCurrencyField.Create(CDS) do
  begin
    FieldName := 'AMOUNT';
    Visible:=True;
    FieldKind := fkInternalCalc;
    DataSet := CDS;
  end;

  // 集合項目
  Aggregate := TAggregate.Create(CDS.Aggregates, CDS);
  Aggregate.AggregateName := 'TOTAL';
  Aggregate.Expression := 'SUM(AMOUNT)';
  Aggregate.GroupingLevel := 0;
  Aggregate.Active := True;

  // 集合フィールド
  with TAggregateField.Create(CDS) do
  begin
    DisplayLabel := '合計';
    DisplayWidth := 10;
    DisplayFormat := '#,###,###,###';
    AlignMent := taRightJustify;
    FieldKind := fkAggregate;
    FieldName := 'TOTAL_F';
    ReadOnly := True;
    Expression := 'SUM(AMOUNT)';
    Active := True;
    DataSet := CDS;
  end;
  Form1.DBEdit1.DataField := 'TOTAL_F';
  CDS.AggregatesActive := True;
  CDS.Open;
end;

---

procedure Test3(CDS: TClientDataSet);
var
  I: Integer;
  Aggregate: TAggregate;
begin
  InitCDS(CDS);

  CDS.FieldDefs.Add('ID', ftAutoInc);
  with CDS.FieldDefs.AddFieldDef do
  begin
    Name := 'ITEM';
    DataType := ftADT;
    Size := 2;
    ChildDefs.Add('ITEM1', ftString, 10);
    ChildDefs.Add('ITEM2', ftString, 10);
  end;
  with CDS.FieldDefs.AddFieldDef do
  begin
    Name := 'ESTIMATE';
    DataType := ftADT;
    Size := 4;
    ChildDefs.Add('QTY'   , ftFloat);
    ChildDefs.Add('UNIT'  , ftString, 4);
    ChildDefs.Add('PRICE' , ftCurrency);
    ChildDefs.Add('AMOUNT' , ftCurrency);
  end;
  CDS.CreateDataSet;
  CDS.Close;

  for I := 0 to CDS.FieldDefs.Count - 1 do
    CDS.FieldDefs[I].CreateField(CDS);

  // 計算フィールド  fkInternalCalcではなぜか計算されない。
  // 内部計算項目(fkInternalCalc)でないと集合型で使えない。
  CDS.FieldByName('ESTIMATE.AMOUNT').FieldKind := fkCalculated;

  // 集合項目
  Aggregate := TAggregate.Create(CDS.Aggregates, CDS);
  Aggregate.AggregateName := 'TOTAL';
  Aggregate.Expression := 'SUM(ESTIMATE.QTY*ESTIMATE.PRICE)';
  Aggregate.Active := True;

  // 集合フィールド
  with TAggregateField.Create(CDS) do
  begin
    DisplayLabel := '合計';
    DisplayWidth := 10;
    DisplayFormat := '#,###,###,###';
    AlignMent := taRightJustify;
    FieldKind := fkAggregate;
    FieldName := 'TOTAL_F';
    ReadOnly := True;
    Expression := 'SUM(ESTIMATE.QTY*ESTIMATE.PRICE)';
    GroupingLevel := 0;
    IndexName := 'ID';
    Active := True;
    DataSet := CDS;
  end;
  Form1.DBEdit1.DataField := 'TOTAL_F';
  CDS.AggregatesActive := True;
  CDS.Open;
end;

---

// DBGridのカラムの設定をしなくてもいいぐらい
// 細かく設定できます。
// オブジェクトインスペクタでも作成できますけど
// 今回のテーマは実行時に作成なので(^-^)
procedure Test4(CDS: TClientDataSet);
var
  Aggregate: TAggregate;
begin
  InitCDS(CDS);

  with TAutoIncField.Create(CDS) do
  begin
    DisplayLabel := 'ID';
    DisplayWidth := 5;
    AutoGenerateValue := arAutoInc;
    ReadOnly := True;
    FieldKind := fkData;
    FieldName := 'ID';
    DataSet := CDS;
  end;

  with TWideStringField.Create(CDS) do
  begin
    Alignment := taLeftJustify;
    DisplayLabel := '名称';
    DisplayWidth := 10;
    FieldKind := fkData;
    FieldName := 'ITEM';
    Size := 10;
    Name := 'CDS_ITEM';  // NAMEは省略しても動作します。
    // OnValidate := xxxx; イベントの割り当ても可
    DataSet := CDS;
  end;

  with TFloatField.Create(CDS) do
  begin
    Alignment := taRightJustify;
    DisplayLabel := '数量';
    DisplayWidth := 10;
    FieldKind := fkData;
    FieldName := 'QTY';
    Name :='CDS_QTY';
    DataSet := CDS;
  end;

  with TWideStringField.Create(CDS) do
  begin
    Alignment := taCenter;
    DisplayLabel := '単位';
    Alignment := taCenter;
    DisplayWidth := 4;
    FieldKind := fkData;
    FieldName := 'UNIT';
    Size := 4;
    Name := 'CDS_UNIT';
    DataSet := CDS;
  end;

  with TCurrencyField.Create(CDS) do
  begin
    Alignment := taRightJustify;
    DisplayFormat := '###,###,##0.##';
    DisplayLabel := '単価';
    DisplayWidth := 10;
    EditFormat := '########0.##';
    FieldKind := fkData;
    FieldName := 'PRICE';
    Name := 'CDS_PRICE';
    DataSet := CDS;
  end;

  with TCurrencyField.Create(CDS) do
  begin
    Alignment := taRightJustify;
    DisplayFormat := '#,###,###,##0.##';
    DisplayLabel := '金額';
    DisplayWidth := 11;
    EditFormat := '#########0.##';
    FieldKind := fkInternalCalc;
    FieldName := 'AMOUNT';
    //ReadOnly := True;
    Name := 'CDS_AMOUNT';
    DataSet := CDS;
  end;
  CDS.CreateDataSet;
  CDS.Close;

  // 集合項目
  Aggregate := TAggregate.Create(CDS.Aggregates, CDS);
  Aggregate.AggregateName := 'TOTAL';
  Aggregate.Expression := 'SUM(AMOUNT)';
  Aggregate.GroupingLevel := 0;
  Aggregate.Active := True;

  // 集合フィールド
  with TAggregateField.Create(CDS) do
  begin
    DisplayLabel := '合計';
    DisplayWidth := 10;
    DisplayFormat := '#,###,###,###';
    AlignMent := taRightJustify;
    FieldKind := fkAggregate;
    FieldName := 'TOTAL_F';
    ReadOnly := True;
    Expression := 'SUM(AMOUNT)';
    Active := True;
    DataSet := CDS;
  end;
  Form1.DBEdit1.DataField := 'TOTAL_F';

  CDS.AggregatesActive := True;
  CDS.Open;
end;

---

procedure Test5(CDS: TClientDataSet);
var
  S: String;
  ADT: TADTField;
  Aggregate: TAggregate;
begin
  InitCDS(CDS);

  // ID
  with TAutoIncField.Create(CDS) do
  begin
    DisplayLabel := 'ID';
    DisplayWidth := 5;
    AutoGenerateValue := arAutoInc;
    ReadOnly := True;
    FieldKind := fkData;
    FieldName := 'ID';
    DataSet := CDS;
  end;

  // 項目
  ADT := TADTField.Create(CDS);
  ADT.DisplayLabel := '名称';
  ADT.FieldName := 'ITEM';
  ADT.OnGetText := Form1.GetText;

  // 項目1
  with TWideStringField.Create(ADT) do
  begin
    DisplayLabel := '項目1';
    FieldName := 'ITEM1';
    Size := 10;
    Visible:=True;
    ParentField:=ADT;
  end;

  // 項目2
  with TWideStringField.Create(ADT) do
  begin
    DisplayLabel := '項目2';
    FieldName := 'ITEM2';
    Size := 10;
    Visible:=True;
    ParentField:=ADT;
  end;
  ADT.DataSet := CDS;

  // 見積
  ADT := TADTField.Create(CDS);
  ADT.DisplayLabel := '見積';
  ADT.FieldName := 'ESTIMATE';
  ADT.OnGetText := Form1.GetText;

  // 数量
  with TFloatField.Create(ADT) do
  begin
    DisplayLabel := '数量';
    FieldName :=  'QTY';
    Visible:=True;
    ParentField:=ADT;
  end;

  // 単位
  with TWideStringField.Create(ADT) do
  begin
    DisplayLabel := '単位';
    Alignment := taCenter;
    FieldName := 'UNIT';
    Size := 4;
    Visible:=True;
    ParentField:=ADT;
  end;

  // 単価
  with TCurrencyField.Create(ADT) do
  begin
    DisplayLabel := '単価';
    FieldName := 'PRICE';
    Visible:=True;
    ParentField:=ADT;
  end;

  // 金額
  with TCurrencyField.Create(ADT) do
  begin
    DisplayLabel := '金額';
    FieldName := 'AMOUNT';
    Visible:=True;
    //なぜかfkInternalCalcでは計算されない;
    FieldKind := fkCalculated;  
    ParentField:=ADT;
  end;
  ADT.DataSet := CDS;
  CDS.CreateDataSet;
  CDS.Close;

  // 集合項目
  Aggregate := TAggregate.Create(CDS.Aggregates, CDS);
  Aggregate.AggregateName := 'TOTAL';
  Aggregate.Expression := 'SUM(ESTIMATE.QTY*ESTIMATE.PRICE)';
  Aggregate.GroupingLevel := 0;
  Aggregate.Active := True;

  // 集合フィールド
  with TAggregateField.Create(CDS) do
  begin
    DisplayLabel := '合計';
    DisplayWidth := 10;
    DisplayFormat := '#,###,###,###';
    AlignMent := taRightJustify;
    FieldKind := fkAggregate;
    FieldName := 'TOTAL_F';
    ReadOnly := True;
    Expression := 'SUM(ESTIMATE.QTY*ESTIMATE.PRICE)';
    Active := True;
    DataSet := CDS;
    Name := S + FieldName;
  end;
  Form1.DBEdit1.DataField := 'TOTAL_F';
 CDS.AggregatesActive := True;
 CDS.Open;
end;

---

ADTを折りたたむとこんな感じです。そう言えば、折りたたみのためのアイコン(三角マーク)が表示されていないですね。折りたたむには、名称と見積の各セルの右側部分をクリックします。

// ADT項目の表示
procedure TForm1.GetText(Sender: TField; var Text: String;
  DisplayText: Boolean);
begin
  if Sender.FieldName = 'ITEM' then
    Text := ClientDataSet1.FieldByName('ITEM.ITEM1').AsString
        +'(' +
      ClientDataSet1.FieldByName('ITEM.ITEM2').AsString+')'
  else  if Sender.FieldName = 'ESTIMATE' then
    Text := ClientDataSet1.FieldByName('ESTIMATE.QTY').AsString
        + ' x ' +
      ClientDataSet1.FieldByName('ESTIMATE.PRICE').AsString
        + ' = ' +
      ClientDataSet1.FieldByName('ESTIMATE.AMOUNT').AsString;
end;

---

テスト以外のコード

// 初期化
procedure InitCDS(CDS: TClientDataSet);
begin
  CDS.Close;
  CDS.AggregatesActive := False;
  CDS.FieldDefs.Clear;
  CDS.AggFields.Clear;
  CDS.Fields.Clear;
  CDS.Aggregates.Clear;
  Form1.DBEdit1.DataField := '';
  Form1.Edit1.Text := '';
end;

// 合計の表示
procedure TForm1.ClientDataSet1AfterPost(DataSet: TDataSet);
var
  Total: TAggregate;
begin
  Total := TClientDataSet(DataSet).Aggregates.Find('TOTAL');
  if Assigned(Total) and (Total.Value <> null) then
    Edit1.Text := Total.Value
  else
    Edit1.Text := '';
end;

// 金額の計算
procedure TForm1.ClientDataSet1CalcFields(DataSet: TDataSet);
begin
  //if DataSet.State = dsInternalCalc then
  begin
    if DataSet.FindField('ESTIMATE.AMOUNT') <> nil then
    begin
      DataSet.FieldByName('ESTIMATE.AMOUNT').AsCurrency :=
        DataSet.FieldByName('ESTIMATE.QTY').AsFloat *
        DataSet.FieldByName('ESTIMATE.PRICE').AsCurrency;
    end
    else
      DataSet.FieldByName('AMOUNT').AsCurrency :=
        DataSet.FieldByName('QTY').AsFloat *
        DataSet.FieldByName('PRICE').AsCurrency;
  end;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  case RadioGroup1.ItemIndex of
    0 : Test1(ClientDataSet1);
    1 : Test2(ClientDataSet1);
    2 : Test3(ClientDataSet1);
    3 : Test4(ClientDataSet1);
    4 : Test5(ClientDataSet1);
  end;
  with ClientDataSet1 do
  begin
    if RadioGroup1.ItemIndex in [2,4] then
    begin
      Append;
      FieldByName('ITEM.ITEM1').AsString := 'PEN';
      FieldByName('ITEM.ITEM2').AsString := 'Blue';
      FieldByName('ESTIMATE.QTY').AsInteger := 10;
      FieldByName('ESTIMATE.UNIT').AsString := '本';
      FieldByName('ESTIMATE.PRICE').AsString := '1000';
      Append;
      FieldByName('ITEM.ITEM1').AsString := 'Fan';
      FieldByName('ITEM.ITEM2').AsString := 'no blade';
      FieldByName('ESTIMATE.QTY').AsInteger := 3;
      FieldByName('ESTIMATE.UNIT').AsString := '台';
      FieldByName('ESTIMATE.PRICE').AsString := '30000';
      Append;
      FieldByName('ITEM.ITEM1').AsString := 'PC';
      FieldByName('ITEM.ITEM2').AsString := 'FMV';
      FieldByName('ESTIMATE.QTY').AsInteger := 1;
      FieldByName('ESTIMATE.UNIT').AsString := '台';
      FieldByName('ESTIMATE.PRICE').AsString := '180000';
    end
    else
    begin
      Append;
      FieldByName('ITEM').AsString := 'PEN';
      FieldByName('QTY').AsInteger := 10;
      FieldByName('UNIT').AsString := '本';
      FieldByName('PRICE').AsString := '1000';
      Append;
      FieldByName('ITEM').AsString := 'Fan';
      FieldByName('QTY').AsInteger := 3;
      FieldByName('UNIT').AsString := '台';
      FieldByName('PRICE').AsString := '30000';
      Append;
      FieldByName('ITEM').AsString := 'PC';
      FieldByName('QTY').AsInteger := 1;
      FieldByName('UNIT').AsString := '台';
      FieldByName('PRICE').AsString := '180000';
    end;
    CheckBrowseMode;
  end;
end;