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

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

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

各コンポーネントを配置し、オブジェクトインスペクタで次の設定をします。
2.TPanelを配置します。
  Panel1.Align := alTop;
3.TStringGridを配置します。
  StringGrid.Align := alClient;
4.TEditとTLabelを2つずつ配置します。
  Label1.Text := 'カウント数';
  Label2.Text := '合計金額';
5.TClientDataSetを配置します。
6.TDataSourceを配置します。
  DataSet := ClientDataSet1;
7.TBindScopeDB1を配置します。
  DataSource := DataSource1;
8.TBindingListを配置します。


Design1


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

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

Design2

Design3

Design4

Design5


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

Design6


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

  DataSource := BindScopeDB1;
  EditControl := Edit2;

Design7

Design8

Design9


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.

実行します。

Runtime


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

Runtime1

|

その他のカテゴリー

ADO | ADT | API | ArrayList | ASP.NET | BDE | BDP.NET | BdpConnection | Borland Developer Studio 2006 | CAPICOM | class | ClipBoard | CodeEditor | Convert.ToString | Custom component | DBExpress | Delphi 2005 | Delphi 2006 | Delphi 2007 | Delphi XE2 | Delphi7 | Delphi8 | Device Driver | Dialog | Docking | DocuWorks | Docuworks SDK | Drag&Drop | Evernote | EXCEL | Firebird | FireMonkey | Game | General | Generics | Google Earth COM API | Google Maps | Google SketchUp | Graphic | IDE | Imm | Indy | InstallAware Express6 | InterBase Admin | JWW | Microsoft SQL Server | MyBase | OnMouseDown | Oracle XE | Paradox | PreviewHandler | PrintDialog | PrintPreviewDialog | PropertyGrid | PSDファイル | Ribbon Controls | RichTextBox | Servers | SubClass | TAction | TActionList | TAnimate | TButton | TCategoryButtons | TClientDataSet | TComboBox | TComboBoxEx | TCustomEdit | TDBGrid | TDockTabSet | TDrawGrid | TEdit | TExcelApplication | TFont | TForm | third party | TImage | TLabel | TList | TListBox | TListView | TMemo | TOpenDialog | TOutlookApplication | TPageControl | TPanel | TRichEdit | TShellResources | TStringGrid | TTabControl | TToolBar | TToolButton | TTreeView | TWebBrowser | Update | VCL Styles | WinInet | XE2 | XPman | オープン配列パラメータ | グループ化 | トランスレーションマネージャー | ファイル処理 | ファイル名処理 | 動的配列 | 投票 | 文字列処理 | 日本語入力 | 暗号 | | 音声合成利用