MyBaseを試してみる。(グループ化 on FireMonkey)

VCLで試したMyBaseのグループ化をFireMonkeyでも試してみました。FireMonkeyでもVCLと同じようにMyBaseが使えそうですね。

１．メニューから新規作成->FireMonkey HD アプリケーションを選択します。

各コンポーネントを配置し、オブジェクトインスペクタで次の設定をします。

２．TPanelを配置します。
　　Panel1.Align := alTop;
３．TStringGridを配置します。
　　StringGrid.Align := alClient;
４．TEditとTLabelを２つずつ配置します。
　　Label1.Text := 'カウント数';
　　Label2.Text := '合計金額';
５．TClientDataSetを配置します。
６．TDataSourceを配置します。
　　DataSet := ClientDataSet1;
７．TBindScopeDB1を配置します。
　　DataSource := DataSource1;
８．TBindingListを配置します。

９．BindDBGridLink1を選択し、オブジェクトインスペクタで次の設定をします。
　　DataSource := BindScopeDB1;
　　GridControl := StringGrid1;

下図のようにBindingsListを右クリックして、TBindDBGridLinkを追加します。 (バインディングコンポーネントをクリックします)

図のようにBindDBGridLink1の設定をします。(DataSource&GridControl)

10．TBindDBEditLinkを２回追加し、オブジェクトインスペクタで次の設定をします。
　　DataSource := BindScopeDB1;
　　EditControl := Edit1;

　　DataSource := BindScopeDB1;
　　EditControl := Edit2;

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, Data.Bind.EngExt,
  Fmx.Bind.DBEngExt, Fmx.Bind.Editors, Data.Bind.Components, Data.Bind.DBScope,
  Data.Bind.DBLinks, Fmx.Bind.DBLinks, FMX.Layouts, FMX.Grid, Data.DB,
  Datasnap.DBClient, FMX.Edit;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StringGrid1: TStringGrid;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    ClientDataSet1: TClientDataSet;
    DataSource1: TDataSource;
    BindingsList1: TBindingsList;
    BindScopeDB1: TBindScopeDB;
    BindDBGridLink1: TBindDBGridLink;
    BindDBEditLink1: TBindDBEditLink;
    BindDBEditLink2: TBindDBEditLink;
    procedure FormCreate(Sender: TObject);
  private
    procedure KINDGetText(Sender: TField; var Text: string;
      DisplayText: Boolean);
    procedure ITEMGetText(Sender: TField; var Text: string;
      DisplayText: Boolean);
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

// サンプルデータを追加します。
procedure MakeSample(CDS: TClientDataSet);
var
  F: Boolean;
begin
  F := CDS.Active;
  if not F then
    CDS.Open;
  try
    // サンプルデータの追加
    with CDS do
    begin
      Appendrecord(['Delphi', 'ESD','Starter',18000]);
      Appendrecord(['Delphi', 'ESD','Professional',94000]);
      Appendrecord(['Delphi', 'ESD','Enterprise',236000]);
      Appendrecord(['Delphi', 'ESD','Ultimate',356000]);
      Appendrecord(['Delphi', 'ESD','Architect',416000]);
      Appendrecord(['RAD Studio', 'ESD','Professional',148000]);
      Appendrecord(['RAD Studio', 'ESD','Enterprise',336000]);
      Appendrecord(['RAD Studio', 'ESD','Ultimate',456000]);
      Appendrecord(['RAD Studio', 'ESD','Architect',516000]);
      Appendrecord(['Delphi', 'Package','Professional',98000]);
      Appendrecord(['Delphi', 'Package','Enterprise',240000]);
      Appendrecord(['Delphi', 'Package','Architect',420000]);
      Appendrecord(['RAD Studio', 'Package','Professional',152000]);
      Appendrecord(['RAD Studio', 'Package','Enterprise',340000]);
      Appendrecord(['RAD Studio', 'Package','Architect',520000]);
      CheckBrowseMode;
    end;
  finally
    if not F then
      CDS.Close;
  end;
end;

   // データベースの作成
procedure CreateDB(CDS: TClientDataSet);
var
  I: Integer;
begin
  // データベースの作成
  CDS.Close;
  CDS.FieldDefs.Add('ITEM',ftWideString,20);
  CDS.FieldDefs.Add('KIND',ftWideString,20);
  CDS.FieldDefs.Add('DETAIL',ftWideString,20);
  CDS.FieldDefs.Add('PRICE',ftCurrency);

  with CDS.IndexDefs.AddIndexDef do
  begin
    Name := 'IDX';
    Fields := 'ITEM;KIND';
    GroupingLevel := 2;
  end;
  CDS.CreateDataSet;
  CDS.Close;

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

  // 集合フィールド
  with TAggregateField.Create(CDS) do
  begin
    AlignMent := taRightJustify;
    FieldKind := fkAggregate;
    FieldName := 'COUNT';
    GroupingLevel := 2;
    IndexName := 'IDX';
    Expression := 'COUNT(PRICE)';
    Active := True;
    DataSet := CDS;
  end;

  with TAggregateField.Create(CDS) do
  begin
    AlignMent := taRightJustify;
    FieldKind := fkAggregate;
    FieldName := 'TOTAL_PRICE';
    GroupingLevel := 2;
    IndexName := 'IDX';
    Expression := 'SUM(PRICE)';
    Active := True;
    DataSet := CDS;
  end;
  CDS.AggregatesActive := True;

  // インデックスの設定
  CDS.IndexName := 'IDX';

  // 表示用にフィールド幅を設定 ※無視された(^-^)
  CDS.FieldByName('ITEM').DisplayWidth := 10;
  CDS.FieldByName('KIND').DisplayWidth := 10;
  CDS.FieldByName('DETAIL').DisplayWidth := 15;
  CDS.FieldByName('PRICE').DisplayWidth := 8;

  // グループ化されたフィールドの表示設定
  CDS.FieldByName('ITEM').OnGetText := Form1.ITEMGetText;
  CDS.FieldByName('KIND').OnGetText := Form1.KINDGetText;

  // CDS.AggregatesActive := True;
  // DBEditの設定
  Form1.BindDBEditLink1.FieldName := 'COUNT';
  Form1.BindDBEditLink2.FieldName := 'TOTAL_PRICE';
  CDS.Open;

  // サンプルデータの作成
  MakeSample(CDS);
end;

// ITEM表示用
procedure TForm1.ITEMGetText(Sender: TField; var Text: string;
  DisplayText: Boolean);
begin
  // 同じITEMの場合、一番最初のみ表示
  if (gbFirst in ClientDataSet1.GetGroupState(1)) then
    Text := Sender.AsString
  else
    Text := '';
end;

procedure TForm1.KINDGetText(Sender: TField; var Text: string;
  DisplayText: Boolean);
begin
  // 同じKINDの場合、一番最初のみ表示
  if (gbFirst in ClientDataSet1.GetGroupState(2)) then
    Text := Sender.AsString
  else
    Text := '';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateDB(ClientDataSet1);
end;

end.

実行します。

StringGrid1のオブジェクトインスペクタでAlternatingRowBackgroundをTrueにするとこんな感じになります。