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

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;

Test1

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;

Test2

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;

Test3

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

Test4

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;

Test5

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;

2011.09.11 TClientDataSet, XE2, ADT, MyBase | 固定リンク
Tweet

バックナンバー

お気に入り

AFsoft World
AFSoftさんのブログです。ホームページの方では、CADに必要な数学の解説からDelphiによる具体的な実装まで、豊富なサンプルと共に詳しく解説されています。又、JWW用の便利なソフトをたくさん公開しておられます。
Delphi Library [Mr.XRAY]
Excelの操作を始め、Delphiでのいろいろな処理を丁寧にわかりやすくまとめられておられます。又、Halbow資料館として、メーリングリストでもご活躍されたHalbowさんによるホームページ(Win32 API by Object Pascal of Delphi)を公開されておられます。
Embarcadero Blogs - Team Japan
Embarcaderoの日本人スタッフによるブログです。
Embarcadero日本語トップページ
ＤＥＫＯのアヤシいお部屋。
Unicodeに関する詳細な解説を始め「Delphi によるテクニック＆アルゴリズム」には、様々な情報が見やすくまとめられています。

@niftyが提供する
無料ブログはココログ！

Delphi-fan

カテゴリー

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

最近の記事

バックナンバー

お気に入り

Delphi-fan

SyntaxHighlighter.config.bloggerMode = true; SyntaxHighlighter.all();

カテゴリー

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

最近の記事

バックナンバー

お気に入り