MyBaseを試してみる。(フィルター編)

TClientDataSetは、SQLが使えないもののFilterプロパティを設定することで、フィルター処理ができます。このFilterプロパティ・・・昔は、ヘルプの通り動作しなかった記憶がありますが、今では問題なく動作しています。

特にMyBaseの場合、今までOnFilterRecordでごちゃごちゃ書いていた処理も、計算フィールドと組み合わせるとシンプルな処理にできます。今回のサンプルも、いつもように「コテコテなコード」で「コテコテなフィルター条件」ですが、MyBaseの性質上、数万のレコードであっても瞬時にフィルター処理されます。

使えるフィルター条件式は、ヘルプを参照して下さい。


Embarcadero Product Documentation Wikis
DBClient.TClientDataSet.Filter
http://docwiki.embarcadero.com/VCL/ja/DBClient.TClientDataSet.Filter


 
procedure MakeSample(CDS: TClientDataSet);
var
  F: Boolean;
begin
  F := CDS.Active;
  if not F then
    CDS.Open;
  try
    // サンプルデータの追加
    with CDS do
    begin
      Appendrecord([ 1,'基礎 普通コンクリート',150]);
      Appendrecord([ 2,'躯体 普通コンクリート',800]);
      Appendrecord([ 3,'AW-1 引違窓',30]);
      Appendrecord([ 4,'AW-2 2連外倒し排煙窓',10]);
      Appendrecord([ 5,'床 モルタル金鏝押エ t=30',400]);
      Appendrecord([ 6,'床 コンクリート金鏝押エ',300]);
      Appendrecord([ 7,'壁 ビニールクロス貼',1500]);
      Appendrecord([ 8,'柱 ビニールクロス貼',100]);
      Appendrecord([ 9,'梁 クロス貼',50]);
      Appendrecord([10,'天井 ビニールクロス貼',500]);
      Appendrecord([11,'土間 モルタル鏝押エ',100]);
      CheckBrowseMode;
    end;
  finally
    if not F then
      CDS.Close;
  end;
end;

// データベースの作成
procedure CreateDB(CDS: TClientDataSet);
var
  I: Integer;
begin
  // データベースの作成
  CDS.Close;
  CDS.FieldDefs.Add('ORD' ,ftInteger);
  CDS.FieldDefs.Add('ITEM',ftWideString,20);
  CDS.FieldDefs.Add('QTY' ,ftInteger);
  CDS.IndexDefs.Add('ORD_IDX','ORD', [ixPrimary]);
  CDS.CreateDataSet;
  CDS.Close;

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

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

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

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

// 文字列の比較用文字列を作成します。
// アルファベットは全角大文字、
// 半角カタカナ、全角カタカナは、全角ひらがなとします。
function MakeHikakuMoji(S: String): String;

  // 文字の変換
  function MapString(const Source: string; Flag: Integer): string;
  var
    Chr: array [0..255] of Char;
  begin
    LCMapString(GetUserDefaultLCID(), Flag, PChar(Source),
      Length(Source) + 1, Chr, Sizeof(Chr));
    Result  :=  chr;
  end;

begin
  Result := AnsiUpperCase(MapString(S, LCMAP_FULLWIDTH or LCMAP_HIRAGANA));
end;

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

// 計算フィールド
procedure TForm1.ClientDataSet1CalcFields(DataSet: TDataSet);
begin
  if DataSet.Active then
  begin
    DataSet.FieldByName('STRFORFILTER').AsString :=
      MakeHikakuMoji(DataSet.FieldByName('ITEM').AsString);
  end;
end;

// フィルター
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);

  // フィルター用計算フィールド(STRFORFILTER)を使う場合
  function GetFilterStr(S: String): String;
  const
    M1 = 'STRFORFILTER LIKE ';
    L1 = 'NOT';
    L2 = 'OR';
  var
    SL: TStringList;
    I: Integer;
    S1,S2, S3: String;
  begin
    Result := '';
    // フィルター文字列の変換
    S := StringReplace(MakeHikakuMoji(S), ' ',' ', [rfReplaceAll]);

    SL := TStringList.Create;
    try
      SL.Delimiter := ' ';
      SL.StrictDelimiter := True;
      SL.DelimitedText := S;

      for I := 0 to SL.Count -1 do
      begin
        S1 := Trim(SL[I]);
        if S1 <> '' then
        begin
          if (S1 <> L1) and (S1 <> L2) then
          begin
            if S2 = L1 then
              S3 := Concat('( NOT (', M1, QuotedStr('%' + S1 +'%'), ')) ')
            else
              S3 := Concat('(', M1, QuotedStr('%' + S1 +'%'), ') ');

            if I = 0 then
              Result := S3
            else if (S2 = L2) then
              Result := Result + ' OR ' + S3
            else
              Result := Result + ' AND ' + S3;
            S2 := '';
          end
          else
            S2 := S1;
        end;
      end;
    finally
      SL.Free;
    end;
  end;

var
  S: String;
begin
  if Key = VK_RETURN then
  begin
    if CheckBox1.Checked then
      S := Edit1.Text
    else
      S := GetFilterStr(Trim(Edit1.Text));

    // フィルター処理をします。
    ClientDataSet1.Filter := S;
    ClientDataSet1.Filtered :=True;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ClientDataSet1.Filtered := False;
end;


起動時

1



QTYフィールドで、フィルター処理

2



ITEMフィールドでフィルター処理

3



フィルター用に作成した計算フィールドでフィルター処理

4


5


6

.

7

|

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

|

MyBaseを試してみる。(BLOBフィールドで画像の読み書き)

とりあえずDB.TBlobFieldのヘルプを読んでみると・・・
TBlobField は,BLOB 項目の間でのデータのストリームをサポートするメソッドや,
BLOB 項目とバイナリファイルとの間でのバイナリデータのコピーをサポートする
メソッドを新しく導入します。また,データセットの CreateBlobStream
 メソッドによって返されるストリームを使用して,BLOB 項目によって管理される
データを読み書きすることもできます。 

ということで、次のようなコードを書いてみました。
// データベースの作成
procedure CreateDB(CDS: TClientDataSet);
begin
  CDS.Close;
  CDS.FieldDefs.Add('FileName', ftWideString, 100);
  CDS.FieldDefs.Add('IMG', ftBlob, 100);
  CDS.CreateDataSet;
  CDS.Close;
end;

// Jpegの追加
procedure cdsAddJPEGImage(CDS: TClientDataSet; FieldName: String;
  Jpeg: String);
var
  JPG:  TJPEGImage;
  Stream: TStream;
begin
  JPG := TJPEGImage.Create;
  try
    JPG.LoadFromFile(Jpeg);
    CDS.Append;
    Stream := CDS.CreateBlobStream(CDS.FieldByName(FieldName), bmReadWrite);
    try
      JPG.SaveToStream(Stream);
    finally
      Stream.Free;
    end;
  finally
    JPG.Free;
  end;
end;

// Jpegの取り出し
procedure cdsGetJPEGImage(CDS: TClientDataSet; FieldName: String;
  Jpeg: String);
var
  Stream: TStream;
  JPG:  TJPEGImage;
begin
  JPG := TJPEGImage.Create;
  try
    Stream := CDS.CreateBlobStream(CDS.FieldByName(FieldName), bmRead);
    try
      Stream.Position := 0;
      JPG.LoadFromStream(Stream);
      JPG.SaveToFile(Jpeg);
    finally
      Stream.Free;
    end;
  finally
    JPG.Free;
  end;
end;

これらを使って次のような処理で、読み書きは確かにできます。
// Save
procedure TForm1.Button1Click(Sender: TObject);
begin
  CreateDB(ClientDataSet1);
  ClientDataSet1.Open;
  cdsAddJPEGImage(ClientDataSet1,'IMG','D:\aaa.jpg');
  ClientDataSet1.SaveToFile('D:\Test.CDS');
end;

// Load
procedure TForm1.Button2Click(Sender: TObject);
begin
  ClientDataSet1.LoadFromFile('D:\Test.CDS');
  ClientDataSet1.Open;
  cdsGetJPEGImage(ClientDataSet1,'IMG','D:\Test\aaa.jpg');
end;

しかし、たくさんの画像形式があるときに、いちいちBitmap用とかPNG用とか作るのは大変ですよね。TPicture.Graphicに入れて、変換させると楽かなとか思いましたが、更にヘルプを調べてみますとTBlobField にはLoadFromFile, SaveToFile等という関数がありました。これは使えると思い、早速試してみたところ、ファイル形式に関係なくとても簡単に扱えるようになりました。
// Save
procedure TForm1.Button3Click(Sender: TObject);
begin
  CreateDB(ClientDataSet1);
  ClientDataSet1.Open;
  ClientDataSet1.Append;
  (ClientDataset1.FieldByName('IMG') as TBlobField).LoadFromFile('D:\aaa.jpg');
  ClientDataSet1.Append;
  (ClientDataset1.FieldByName('IMG') as TBlobField).LoadFromFile('D:\aaa.png');
  ClientDataSet1.Append;
  (ClientDataset1.FieldByName('IMG') as TBlobField).LoadFromFile('D:\aaa.bmp');
  ClientDataSet1.Append;
  (ClientDataset1.FieldByName('IMG') as TBlobField).LoadFromFile('D:\aaa.xlsx');
  ClientDataSet1.CheckBrowseMode;
  ClientDataSet1.SaveToFile('D:\Test.CDS');
end;

// Load
procedure TForm1.Button4Click(Sender: TObject);
var
  MS: TMemoryStream;
begin
  MS:= TMemoryStream.Create;
  try
    ClientDataSet1.LoadFromFile('D:\Test.CDS');
    ClientDataSet1.Open;

    (ClientDataset1.FieldByName('IMG') as TBlobField).SaveToFile('D:\Test\aaa.jpg');
    ClientDataSet1.Next;

    (ClientDataset1.FieldByName('IMG') as TBlobField).SaveToFile('D:\Test\aaa.png');
    ClientDataSet1.Next;

    (ClientDataset1.FieldByName('IMG') as TBlobField).SaveToFile('D:\Test\aaa.bmp');

    // ファイルに保存ではなくTImageに表示したい場合
    (ClientDataset1.FieldByName('IMG') as TBlobField).SaveToStream(MS);
    MS.Position := 0;
    Image1.Picture.Bitmap.LoadFromStream(MS);

    ClientDataSet1.Next;
    (ClientDataset1.FieldByName('IMG') as TBlobField).SaveToFile('D:\Test\aaa.xlsx');
  finally
    MS.Free;
  end;
end;

|

MyBaseを試してみる。(インデックスを使わずに、行の追加、挿入、削除編) REVENGE(^o^)

前回、MyBaseを試してみる。(インデックスを使わずに、行の追加、挿入、削除編) の処理では、フィルターが使えなかったのですが、次の処理をフィルター前、挿入処理前に入れることにより、フィルターも可能になりました。でも、全く論理的ではない処理のため、使っている間に不具合が出るかも知れませんけどね(^-^)
// 挿入時、レコード位置を保持するための処理
procedure cdsUpdate(CDS: TClientDataSet);
var
  I: Integer;
  Data: OleVariant;
begin
  SaveUndoPoint(CDS);
  I := CDS.RecNo;
  Data := CDS.Data;
  CDS.Data := Data;
  CDS.RecNo := I;
end;

前回の処理では、一度レコードを挿入してから、フィルター処理・解除をすると、それ以降挿入したレコードは、最後に追加されてしまいました。例えスクリーン上で、正しく表示されていたとしても、正しくファイルに書き込むことができませんでした。今回の処理では、二度目以降のフィルター処理後も正しく表示されています。FilterプロパティでもOnFilterRecordでも問題ないようです。

とりあえずレコードを挿入します。

1


フィルター処理します。

2


フィルターを解除して、再びレコードを挿入します。

3


フィルター処理します。

4


フィルターを解除しても、レコードの並びは保持されています。(^o^)/

5


var
  RecNoList: TList<Integer> // Undoに使用
  SP: Integer = -1;          // Undoの処理に使用
  SN: Integer = 0;

// サンプルデータ
procedure MakeSample(DataSet: TDataSet);
var
  F: Boolean;
begin
  F := DataSet.Active;
  if not F then
    DataSet.Open;
  try
    // サンプルデータの追加
    with DataSet do
    begin
      Appendrecord(['iPod Touch']);
      Appendrecord(['Zaurus C-860']);
      Appendrecord(['Delphi 2009 Handbook']);
      Appendrecord(['GEORGIA BLACK']);
      CheckBrowseMode;
    end;
  finally
    if not F then
      DataSet.Close;
  end;
end;

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

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

  CDS.Open;
  MakeSample(CDS);
end;

// DataSetの有効/無効
procedure DataSetEnabled(DataSet: TDataSet; Value: Boolean);
begin
  if Value then
    DataSet.EnableControls
  else
    DataSet.DisableControls;
end;

// SaveToFile
procedure cdsSaveToFile(CDS: TClientDataSet;
  const FileName: String);
begin
  if CDS.ChangeCount > 0 then
    CDS.MergeChangeLog;
  CDS.SaveToFile(FileName, dfXMLUTF8);
end;

// LoadFromFile
procedure cdsLoadFromFile(CDS: TClientDataSet;
  const FileName: String);
begin
  CDS.LoadFromFile(FileName);
end;

// 通し番号を返します。別に要らない処理です。
function GetSN: String;
begin
  Inc(SN);
  Result := IntToStr(SN);
end;

// 現在の状態を保存
procedure SaveUndoPoint(CDS: TClientDataSet);
begin
  // 変更があれば更新させます。
  if CDS.ChangeCount > 0 then
    CDS.MergeChangeLog;
  SP := (CDS as TClientDataSet).SavePoint;
end;

// SavePointから元に戻す処理
procedure Undo(CDS: TClientDataSet);
begin
  if SP > -1 then
    CDS.SavePoint := SP;
  SP := -1;
end;

// 削除されたレコードを元に戻す処理 ※コテコテ(^-^)
procedure UndoDelete(CDS: TClientDataSet);
var
  I, RC, RecNo: Integer;
  Delta: TClientDataSet;
begin
  if (RecNoList.Count <> 0) and (CDS.ChangeCount > 0) then
  begin
    Delta := TClientDataSet.Create(nil);
    try
      Delta.Data := CDS.Delta;
      Delta.Open;
      Delta.Last;
      I := -1;
      RC := CDS.RecordCount;

      // Insertで戻す場合、最後に追加されることをあるため、この処理を行う。
      cdsUpdate(CDS);  //20110922 追記 procedure cdsUpdateを前に持ってきてね。

      // Deltaから順番に戻していきます。
      while not Delta.Bof do
      begin
        Inc(I);
        if I < RecNoList.Count then
        begin
          RecNo := RecNoList[I];
          if RecNo > RC then
          begin
            CDS.Append;
            Inc(RC);
          end
          else
          begin
            CDS.RecNo := RecNo;
            CDS.Insert;
            Inc(RC);
          end;
          CDS.FieldByName('Item').AsString :=
            Delta.FieldByName('Item').AsString;
        end;
        Delta.Prior;
      end;
      CDS.CheckBrowseMode;
      CDS.MergeChangeLog;
      RecNoList.Clear;
    finally
      Delta.Free;
    end;
  end;
end;

// Undo
procedure cdsUndoNoIndex(CDS: TClientDataSet);
begin
    if RecNoList.Count > 0 then
    UndoDelete(CDS)            // 削除
  else if (SP > -1)  then
    Undo(CDS)                  // 追加/挿入-SavePoint
  else if CDS.ChangeCount > 0 then
    CDS.UndoLastChange(True);  // 上記以外
end;

// 追加
procedure cdsAppendNoIndex(CDS: TClientDataSet;
  Count: Integer = 1);
var
  I: Integer;
begin
  SaveUndoPoint(CDS);
  DataSetEnabled(CDS, False);
  try
    // Count分空白行を追加します。
    for I := 0 to Count - 1 do
    begin
      // 追加します。
      CDS.Append;
      CDS.FieldByName('ITEM').AsString := '追加'+ GetSN;
    end;
    CDS.CheckBrowseMode;
    // 今回追加した空白行の先頭レコードに移動させます。
    CDS.MoveBy(1-Count);
  finally
    DataSetEnabled(CDS, True);
  end;
end;

// 挿入時、レコード位置を保持するための処理
procedure cdsUpdate(CDS: TClientDataSet);
var
  I: Integer;
  Data: OleVariant;
begin
  SaveUndoPoint(CDS);
  I := CDS.RecNo;
  Data := CDS.Data;
  CDS.Data := Data;
  CDS.RecNo := I;
end;

// 挿入
procedure cdsInsertNoIndex(CDS: TClientDataSet;
  Count: Integer = 1);
var
  I: Integer;
  Data: OleVariant;
begin
  DataSetEnabled(CDS, False);
  try
    cdsUpdate(CDS);
    for I := 0 to Count -1 do
    begin
      // 挿入します。
      CDS.Insert;
      CDS.FieldByName('ITEM').AsString := '挿入'+ GetSN;
    end;
      CDS.CheckBrowseMode;
  finally
    DataSetEnabled(CDS, True);
  end;
end;

// 削除
procedure cdsDeleteNoIndex(CDS: TClientDataSet;
  BMList: TBookmarkList = nil);
type
  TIntegerComparer = TComparer<Integer>;
var
  I: Integer;
begin
  if not Assigned(BMList) then Exit;

  RecNoList.Clear;
  SaveUndoPoint(CDS);
  DataSetEnabled(CDS, False);
  try
    if Assigned(BMList) and (BMList.Count > 0) then
    begin
     for I := BMList.Count -1 downto 0 do
      begin
        CDS.GotoBookmark(BMList[I]);
        RecNoList.Add(CDS.RecNo);
        CDS.Delete;
      end;
      BMList.Clear;
    end;

    // RecNoListのソート
    RecNoList.Sort(TComparer<Integer>.Default);
  finally
    DataSetEnabled(CDS, True);
  end;
end;

// Filter
procedure cdsFiltered(CDS: TClientDataSet);
begin
  cdsUpdate(CDS);
  CDS.Filtered := not CDS.Filtered;
end;

// OnFilterRecord - ClientDataSet1で作成しておきます。
procedure TForm1.ClientDataSet1FilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept :=
    AnsiPos(Edit2.Text, DataSet.FieldByName('ITEM').AsString) > 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Undo用
  RecNoList:= TList<Integer>.Create;
  // データベースの作成
  CreateDB(ClientDataSet1, False);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(RecNoList);
end;

// SaveToFile
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  FileName: String;
begin
  FileName := ExtractFilePath(Application.ExeName) + 'MyBase.cds';
  cdsSaveToFile(ClientDataSet1,FileName);
end;

// LoadFromFile
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  FileName: String;
begin
  FileName := ExtractFilePath(Application.ExeName) + 'MyBase.cds';
  if FileExists(FileName) then
    cdsLoadFromFile(ClientDataSet1, FileName);
end;

// 追加
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  cdsAppendNoIndex(ClientDataSet1, StrToIntDef(Edit1.Text,1));
end;

// 挿入
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  cdsInsertNoIndex(ClientDataSet1, StrToIntDef(Edit1.Text,1));
end;

// 削除
procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
  cdsDeleteNoIndex(ClientDataSet1, DBGrid1.SelectedRows);
end;

// Undo
procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
  cdsUndoNoIndex(ClientDataSet1);
end;

// Filter
procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
  cdsUpdate(ClientDataset1);
  if not ClientDataset1.Filtered then
  begin
    case RadioGroup1.ItemIndex of
      0: begin
           ClientDataset1.Filter := '';
           ClientDataSet1.OnFilterRecord := ClientDataSet1FilterRecord;
         end;
      1 : begin
            ClientDataSet1.OnFilterRecord := nil;
            ClientDataset1.filter := 'ITEM LIKE '+QuotedStr('%' +  Edit2.Text+'%');
         end;
    end;
  end;
  cdsFiltered(ClientDataSet1);
end;

|

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

TClientDataSetのグループ化については、Helpに解説がありますが、これが私にとって大変難解な文章です。図を見ていると、できることはわかるのですけど、では実際どうしたらいいのかがさっぱり理解できません。

Embarcadero Product Documentation Wikis
インデックスを使ってデータをグループ化する

とりあえず試してみました。まずグループ化を使わずに普通にプログラムするとこんな感じです。
// サンプルデータを追加します。
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';
  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';
    IndexName := 'IDX';
    Expression := 'COUNT(PRICE)';
    Active := True;
    DataSet := CDS;
  end;

  with TAggregateField.Create(CDS) do
  begin
    AlignMent := taRightJustify;
    FieldKind := fkAggregate;
    FieldName := 'TOTAL_PRICE';
    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.AggregatesActive := True;
  // DBEditの設定
  Form1.DBEdit1.DataField := 'COUNT';
  Form1.DBEdit2.DataField := 'TOTAL_PRICE';
  CDS.Open;

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

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

同じデータがある場合、普通に表示するとDBGridでは、次のように表示されます。

Nogrouping



グループ化すると同じデータは、一度だけ描画されるだけになり、見やすくなるということで、次のように修正しました。
// データベースの作成
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 := 1;
  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 := 1;
    IndexName := 'IDX';
    Expression := 'COUNT(PRICE)';
    Active := True;
    DataSet := CDS;
  end;

  with TAggregateField.Create(CDS) do
  begin
    AlignMent := taRightJustify;
    FieldKind := fkAggregate;
    FieldName := 'TOTAL_PRICE';
    GroupingLevel := 1;
    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;

  // DBEditの設定
  Form1.DBEdit1.DataField := 'COUNT';
  Form1.DBEdit2.DataField := 'TOTAL_PRICE';
  CDS.Open;

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

// ITEM表示用
procedure TForm1.ITEMGetText(Sender: TField; var Text: string;
  DisplayText: Boolean);
begin
  // GetGroupStateについて Helpより引用
  //
  // "AggregatesActive が false の場合,または現在の
  //  インデックスがグループ化をサポートしていない場合,
  //  GetGroupState は空のセットを返します。"

  // 同じITEMの場合、一番最初のみ表示
  if (gbFirst in ClientDataSet1.GetGroupState(1)) then
    Text := Sender.AsString
  else
    Text := '';
end;

各レコード毎に表示されていたITEMがすっきりとしています。 又、Delphiを選んだ場合、Rad Studioを選んだ場合と異なったアイテム数、合計金額が表示されます。このことから、同じITEMに対して処理がされていることがわかります。

Grouping1_1


Grouping1_2



KINDフィールドも同じものが並んでいるので、こちらもグループ化させるために次のようにプログラムを修正しました。
// データベースの作成
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.DBEdit1.DataField := 'COUNT';
  Form1.DBEdit2.DataField := 'TOTAL_PRICE';
  CDS.Open;

  // サンプルデータの作成
  MakeSample(CDS);
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;

これでKINDもグループ化された表示になりました。集合フィールドで設定したGroupingLevelによって、 ITEM数、合計金額についてもKINDに対して処理がされています。ここでようやくヘルプの「グループ化レベルは,インデックス内の項目順序に対応しています。 」の意味が理解できました(^-^)

Grouping2_1

Grouping2_2

|

MyBaseを試してみる。(PreviewHandlerで表示)

と書いていますが、今回は、MyBaseとは直接関係ないです(^-^)
以前、PreviewHandlerで自分のデータをExplorerで表示したいなと思って、下記サイトのサンプルをダウンロードし、試したことがありました。しかしながらDelphi2009のShlObjにはIPreviewHandlerが定義されておらず、コンパイルできませんでした。

今回、XE2を使ってMyBaseのデータをListViewで表示させてみました。サンプルのMyPreviewHandlerというユニットを次のものに入れ替えます。(MyBaseのファイルは、mbsという拡張子で保存しています。)

The Art of Delphi Programming
Windows 7 Previews – the Delphi Way

こんな感じで、表示することができます。

Mypreviewhandler


ただ項目部分をクリックすると次のようなエラーが表示されます。サンプルのまま、検証もせずに使っているので、今回は、OKとしておきますけど(^-^)

Error

unit MyPreviewHandler;

interface

uses
  PreviewHandler, System.Classes, Vcl.Controls, Vcl.StdCtrls,
  Vcl.ComCtrls, MidasLib, Datasnap.DBClient;

const
  CLASS_MyPreviewHandler: TGUID = '{9E4BFFE4-BA9C-449C-A6B5-4FF82B15FA91}';

type
  TMyPreviewHandler = class(TFilePreviewHandler)
  private
    FListView: TListView;
    FCDS: TClientDataSet;
  protected
  public
    constructor Create(AParent: TWinControl); override;
    procedure Unload; override;
    procedure DoPreview(const FilePath: string); override;
  end;

implementation

uses
  SysUtils;

constructor TMyPreviewHandler.Create(AParent: TWinControl);
var
  Col: TListColumn;
begin
  inherited;
   FCDS := TClientDataSet.Create(AParent);
   FListView:= TListView.Create(AParent);
   FListView.Parent := AParent;
   FListView.Align := alClient;
   FListView.Viewstyle:=vsReport;
   FListView.ReadOnly := True;

   Col := FListView.Columns.Add;
   Col.Caption := 'ORD';
   Col.Width := 40;

   Col := FListView.Columns.Add;
   Col.Caption := 'ITEM';
   Col.Width := 200;

   Col := FListView.Columns.Add;
   Col.Caption := 'QTY';
   Col.Alignment := taRightJustify;
   Col.Width := 80;

   Col := FListView.Columns.Add;
   Col.Caption := 'UNIT';
   Col.Alignment := taCenter;
   Col.Width := 50;

   Col := FListView.Columns.Add;
   Col.Caption := 'PRICE';
   Col.Alignment := taRightJustify;
   Col.Width := 80;

   Col := FListView.Columns.Add;
   Col.Caption := 'AMOUNT';
   Col.Alignment := taRightJustify;
   Col.Width := 80;

end;

procedure TMyPreviewHandler.DoPreview(const FilePath: string);
var
  LI: TListItem;
begin
  FCDS.FileName := FilePath;
  FCDS.Open;
  try
    FCDS.First;
    while not FCDS.EOF do
    begin
      LI := FListView.Items.add;
      LI.Caption := FCDS.FieldByName('ORD').AsString;
      LI.SubItems.Add(FCDS.FieldByName('ITEM').AsString);
      LI.SubItems.Add(FCDS.FieldByName('QTY').AsString);
      LI.SubItems.Add(FCDS.FieldByName('UNIT').AsString);
      LI.SubItems.Add(FormatCurr('#,',FCDS.FieldByName('PRICE').AsCurrency));
      LI.SubItems.Add(FormatCurr('#,',FCDS.FieldByName('QTY').AsFloat*
        FCDS.FieldByName('PRICE').AsCurrency));
      FCDS.Next;
    end;
  finally
   FCDS.Close;
  end;
end;

procedure TMyPreviewHandler.Unload;
begin
  FListView.Items.Clear;
  inherited;
end;

initialization
  TMyPreviewHandler.Register(CLASS_MyPreviewHandler, 'mbs', 'MyBase Preview Handler', '.mbs');
end.
 

コンパイルしてできたDLLをregsvr32を使って登録します。
regsvr32 d:\MyPreviewHandlerLib.dll

「ファイル名を指定して実行...」の場合

Resister2

「コマンドプロンプト」の場合

Regist

Regsvr32

削除する場合は、/u を使います。
regsvr32 /u d:\MyPreviewHandlerLib.dll

「ファイル名を指定して実行...」の場合

Unregister2

「コマンドプロンプト」の場合

Unregist



(参考)
MSDNマガジン

マネージ プレビュー ハンドラ フレームワークで独自の方法でデータを表示する

|

MyBaseを試してみる。(インデックスを使って、行の追加、挿入、削除編)

レコードの順番にインデックスを使って、行の編集をするバージョンです。言うまでもなく、インデックスは検索や目的に合ったレコードの並び替えをするために、取り扱うデータを分析し、その内容によっては、新規にカテゴリを作ってそのIDを割り当てたり、個別にコードを割り当てたりして作成されるべきものです。
しかしここでは、各レコードの順番を登録するフィールド(ここではORD)を用意し、そのインデックス(ここではORD_IDX)を利用してレコードの順番を保持します。そのため、場合によっては、一度に全レコードのORDフィールドを書き換えるという禁断の処理です(^-^)プロの方々から「データベースの使い方を知ってるのか?」と怒られそうですが、「レコードの並びは、ユーザーが決める」「レコード数はせいぜい数千から1万件程度」を前提条件としています。もちろん、このような場合、リスト+仮想ListView(or StringGrid)が最適なのは、知っていますが、UIとしてDBGridを使うための処理です(^-^)

Usingindex




// COMMON

// サンプルデータを追加します。
procedure MakeSample(CDS: TClientDataSet);
var
  No: Integer;
  F: Boolean;
begin
  F := CDS.Active;
  if not F then
    CDS.Open;
  try
    // サンプルデータの追加
    No := 0;
    with CDS do
    begin
      Inc(No);
      Appendrecord([No, 'Delphi XE2 Starter ESD',10,'本',18000]);
      Inc(No);
      Appendrecord([No, 'Delphi XE2 Professional ESD',5,'本',94000]);
      Inc(No);
      Appendrecord([No, 'Delphi XE2 Enterprise ESD',10,'本',236000]);
      Inc(No);
      Appendrecord([No, 'Delphi XE2 Ultimate ESD',3,'本',356000]);
      Inc(No);
      Appendrecord([No, 'Delphi XE2 Architect ESD',1,'本',416000]);
      CheckBrowseMode;
    end;
  finally
    if not F then
      CDS.Close;
  end;
end;

// データベースの作成
procedure CreateDB(CDS: TClientDataSet);
var
  I: Integer;
begin
  // データベースの作成
  CDS.Close;
  CDS.FieldDefs.Add('ORD',ftInteger);
  CDS.FieldDefs.Add('ITEM',ftWideString,30);
  CDS.FieldDefs.Add('QTY',ftFloat);
  CDS.FieldDefs.Add('UNIT',ftWideString,4);
  CDS.FieldDefs.Add('PRICE',ftCurrency);
  CDS.IndexDefs.Add('ORD_IDX','ORD', [ixPrimary]);
  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;

  // 集合フィールド
  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;
  CDS.AggregatesActive := True;

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

  // 表示用にフィールド幅を設定
  CDS.FieldByName('ORD').DisplayWidth := 3;
  CDS.FieldByName('ITEM').DisplayWidth := 25;
  CDS.FieldByName('QTY').DisplayWidth := 3;
  CDS.FieldByName('UNIT').DisplayWidth := 4;
  CDS.FieldByName('PRICE').DisplayWidth := 8;
  CDS.FieldByName('AMOUNT').DisplayWidth := 10;

  // 計算フィールドの設定
  CDS.OnCalcFields := Form1.CalcFields;

  // DBEditの設定
  Form1.DBEdit1.DataField := 'TOTAL_F';
  CDS.Open;

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

// DataSetの有効/無効
procedure DataSetEnabled(DataSet: TDataSet; Value: Boolean);
begin
  if Value then
    DataSet.EnableControls
  else
    DataSet.DisableControls;
end;

// Filteredの設定
procedure cdsSetFiltered(CDS: TClientDataSet; F: Boolean);
begin
  if F and (not CDS.Filtered) then
    CDS.Filtered := F
  else if (not F) and CDS.Filtered then
    CDS.Filtered := F;
end;

// Indexの設定
procedure cdsSetIndexFieldNames(CDS: TClientDataSet; S: String);
begin
  if (S <> '') then
    CDS.IndexFieldNames := S
  else
    CDS.IndexName := 'ORD_IDX';
end;

// 追加/挿入項目用の通し番号を返します。
var
  SN: Integer = 0;

function GetSN: String;
begin
  Inc(SN);
  Result := IntToStr(SN);
end;

// UNDO

var
  SP: Integer = -1;

// 現在の状態を保存
procedure SaveUndoPoint(CDS: TClientDataSet);
begin
  // 変更があれば更新させます。
  if CDS.ChangeCount > 0 then
    CDS.MergeChangeLog;
  SP := CDS.SavePoint;
end;

// Undo
procedure Undo(CDS: TClientDataSet);
begin
  if (SP > -1) then
    CDS.SavePoint := SP;
  SP := -1;
end;

// 追加/挿入/削除

// 追加
procedure cdsAppendUsingIndex(CDS: TClientDataSet; Count: Integer = 1);
var
  I, No: Integer;
begin
  //フィルター中と他のインデックスの場合は処理させません。
  if CDS.Filtered or (CDS.IndexName <> 'ORD_IDX') then Exit;

  SaveUndoPoint(CDS);
  DataSetEnabled(CDS, False);
  try
    No := CDS.RecordCount;
    for I := 0 to Count - 1 do
    begin
      Inc(No);

      // 追加します。
      CDS.Insert; // 10000回以下だとAppendより速かったから(^-^)

      // 空白のままだとレコードが追加されません。
      // CDS.FieldByName('ITEM').AsString := '' ←これはOK
      CDS.FieldByName('ITEM').AsString := '追加'+GetSN;
      CDS.FieldByName('ORD').AsInteger := No;
    end;
    CDS.CheckBrowseMode;

    // 今回追加した空白行の先頭レコードに移動させます。
    CDS.MoveBy(1-Count);
  finally
    DataSetEnabled(CDS, True);
  end;
end;

// 挿入
procedure cdsInsertUsingIndex(CDS: TClientDataSet; Count: Integer = 1);
var
  I: Integer;
  NowRec: Integer;
begin
  //フィルター中と他のインデックスの場合は処理させません。
  if CDS.Filtered or (CDS.IndexName <> 'ORD_IDX') then Exit;

  SaveUndoPoint(CDS);
  DataSetEnabled(CDS, False);
  try
    // 挿入位置以後のレコードのORDをCount分増やして更新させます。
    NowRec := CDS.RecNo;
    CDS.RecNo := NowRec;
    CDS.Last;
    while (not CDS.BOF) and (CDS.RecNo >= NowRec) do
    begin
      CDS.Edit;
      CDS.FieldByName('ORD').AsInteger :=
        CDS.FieldByName('ORD').AsInteger + Count;
      CDS.Prior;
    end;
    CDS.CheckBrowseMode;

    // 挿入
    CDS.RecNo := NowRec;
    for I := 0 to Count -1 do
    begin
      CDS.Insert;
      CDS.FieldByName('ITEM').AsString := '挿入'+GetSN;
      CDS.FieldByName('ORD').AsInteger := NowRec;
      Inc(NowRec);
    end;
    CDS.CheckBrowseMode;

    // カーソルを挿入位置に戻します。
    CDS.MoveBy(1-Count);
    //Form1.DBGrid1.SelectedRows.Clear;
  finally
    DataSetEnabled(CDS, True);
  end;
end;

// 削除
procedure cdsDeleteUsingIndex(CDS: TClientDataSet; BMList: TBookmarkList = nil);
var
  I: Integer;
  F: Boolean;
  S: String;
  J: Integer;
begin
  if CDS.RecordCount = 0 then Exit;

  SaveUndoPoint(CDS);
  DataSetEnabled(CDS, False);

  // 取り扱うデータ量によっては、高速化のため計算部分の処理をさせない。
  CDS.AggregatesActive := False;
  CDS.AutoCalcFields := False;
  try
    // 削除対象を削除します。
    // フィルターやインデックスに関係なく選択されたものを削除します。
    if (BMList = nil) or (BMList.Count = 0) then
    begin
      CDS.Delete;
      // レコードの位置
      if CDS.Eof then
        J := CDS.RecordCount
      else
        J := CDS.RecNo;
    end
    else if (BMList.Count = 1) and (not CDS.BookmarkValid(BMList[0])) then
    begin
      // 挿入した後、そのまま削除ボタンを押した時、
      //「レコードが見つかりません」というエラーが表示される時が
      // あるため、その対応です。
      // cdsInsertUsingIndex中でForm1.DBGrid1.SelectedRows.Clear;
      // をすれば、このエラーは発生しない。
      Exit;
    end
    else
    begin
      J := 0;
      for I := BMList.Count -1 downto 0 do
      begin

        CDS.GotoBookmark(BMList[I]);
        if I = BMList.Count -1 then
          J := CDS.FieldByName('ORD').AsInteger;
        CDS.Delete;
      end;
      // レコードの位置
      J := J - BMList.Count+1;
    end;

    // 選択されたままになるのでクリアしておきます。
    BMList.Clear;

    // ORDを通し番号に修正します。

    // フィルターは解除しておきます。
    F := CDS.Filtered;
    cdsSetFiltered(CDS, False);

    // ORD以外のインデックスの場合は、一度ORDに設定します。
    // 基本的に順番用インデックスの入れ替えはしないつもりだけど・・・
    S := CDS.IndexFieldNames;
    cdsSetIndexFieldNames(CDS, '');

    // 番号を揃えます。
    // 本当はBMList[0]のレコードまでを処理するのがいいかな。
    try
      CDS.First;
      while (not CDS.Eof) do
      begin
        if CDS.FieldByName('ORD').AsInteger <> CDS.RecNo then
        begin
          CDS.Edit;
          CDS.FieldByName('ORD').AsInteger := CDS.RecNo;
        end;
        CDS.Next;
      end;
      CDS.CheckBrowseMode;

      // レコード位置を移動させます。
      if J < CDS.RecordCount then
        CDS.RecNo := J
      else
        CDS.Last;
    finally
      cdsSetFiltered(CDS, F);
      cdsSetIndexFieldNames(CDS, S);
    end;
  finally
    CDS.AutoCalcFields := True;
    CDS.AggregatesActive := True;
    DataSetEnabled(CDS, True);
  end;
end;

// TForm1

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

// 計算フィールド
procedure TForm1.CalcFields(DataSet: TDataSet);
begin
  DataSet.FieldByName('AMOUNT').AsCurrency :=
    DataSet.FieldByName('QTY').AsFloat *
    DataSet.FieldByName('Price').AsCurrency;
end;

// 追加
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  cdsAppendUsingIndex(ClientDataSet1, StrToIntDef(Edit1.Text,1));
end;

// 挿入
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  cdsInsertUsingIndex(ClientDataSet1, StrToIntDef(Edit1.Text,1));
end;

// 削除
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  cdsDeleteUsingIndex(ClientDataSet1, DBGrid1.SelectedRows);
  ClientDataSet1.AggregatesActive := True;;
end;

// Undo
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
 if (SP > -1)  then
    Undo(ClientDataSet1)
  else if ClientDataSet1.ChangeCount > 0 then
    ClientDataSet1.UndoLastChange(True);
end;
レコードの順番を登録するフィールド(ここではORD)の番号を、10000毎にするとか、浮動小数点フィールドとかにして、挿入時には、その間の番号を設定すると、番号の打ち直しが減って、処理がより早くなるかも知れないですね。

|

MyBaseを試してみる。(Index、FilterでAggregateが変!?)

Index、Filterを設定するとAggregateの値がおかしくなります。どこか使い方が間違ってるのかな?よくわからないけど、Aggregateを使うときには、このことに注意が必要です。

起動時画面

Incorrect_total1

★Filterプロパティを使った場合
その1
1.[ITEMでソート]を押すと、ITEMでソートされて、合計金額は表示されません。
  ITEMでの並び替えは、合計金額の計算に影響はないでしょうって言いたく
  なりますが、表示されないなら別にいいけどー(^-^)

Incorrect_total11

2.[ORD_IDXでソート]を押すと、再度、合計金額が表示されます。

Incorrect_total12

3.フィルター[ON]を押すと、フィルター処理された合計金額が表示されます。

Incorrect_total13

4.ここで[ITEMでソート]を押すと、なんと合計金額は2倍になりました。

Incorrect_total14

5.驚いて[ORD_IDXでソート]を押すと、合計金額は3倍になりました。

Incorrect_total15

6.これはいけないと思い、フィルター[OFF]を押すと元に戻りました。

Incorrect_total16



その2
1.フィルター[ON]を押して、フィルター処理後の合計金額が正しいことを確認します。

Incorrect_total21

2.フィルター[OFF]を押して、合計金額が正しいことを確認します。

Incorrect_total22

3.[ITEMでソート]を押すと、なんと合計金額は2倍になりました。

Incorrect_total23

4.驚いて[ORD_IDXでソート]を押すと、合計金額は3倍になりました。

Incorrect_total24

5.再び[ITEMでソート]を押すと、なんと合計金額は、4倍になりました。

Incorrect_total25

6.もう一度[ORD_IDXでソート]を押すと、なんと合計金額は、5倍になりました。

Incorrect_total26

[ITEMでソート]、[ORD_IDXでソート]を交互に押すと、合計金額はとどまるところを
知らないようです。(^-^)


★OnFilterRecordを使った場合
その1
1.[ITEMでソート]を押すと・・・ITEMでソートされて、合計金額は表示されません。
2.[ORD_IDXでソート]を押すと・・・再度、合計金額が表示されます。
3.フィルター[ON]を押すと・・・合計金額が表示されません。

Incorrect_total331_2

  しかしここで、次のレコードに移動させるとフィルター処理前の合計金額が
  表示されています。

Incorrect_total332_2

4.ここで[ITEMでソート]を押すと・・・合計金額は表示されません。
5.驚いて[ORD_IDX]を押すと・・・合計金額は表示されません。
6.これはいけないと思い、フィルター[OFF]を押すと・・・合計金額は表示されません。


その2
1.フィルター[ON]を押すと・・・合計金額が表示されません。
  しかしここで、次のレコードに移動させるとフィルター処理前の合計金額が
  表示されました。
2.フィルター[OFF]を押して、合計金額が正しいことを確認します。
  合計金額は正しく表示されました。

Incorrect_total421

  と思ったけど、フィルター処理されたレコードに移動させると、
  合計金額が消えてしまいました。

Incorrect_total422

3.[ITEMでソート]を押すと・・・合計金額は表示されません。
4.驚いて[ORD_IDX]を押すと・・・合計金額は表示されません。
5.[ITEMでソート]を押すと・・・合計金額は表示されません。
6.[ORD_IDXでソート]を押すと・・・合計金額は表示されません。
7.[ITEMでソート]、[ORD_IDXでソート]を交互に押すと・・・
  合計金額は表示されません。


いろいろ試した結果、インデックスを入れ替えず、Filterプロパティでフィルター処理すれば正常な動作をしているようです。フィルター時には、フィルター処理後の合計金額が表示されますし、解除後は、正しい合計金額が表示されました。しかしOnFilterRecordでフィルター処理した場合は、正しく表示されませんでした。
// COMMON

// サンプルデータを追加します。
procedure MakeSample(CDS: TClientDataSet);
var
  No: Integer;
  F: Boolean;
begin
  F := CDS.Active;
  if not F then
    CDS.Open;
  try
    // サンプルデータの追加
    No := 0;
    with CDS do
    begin
      Inc(No);
      Appendrecord([No, 'Delphi XE2 Starter ESD',10,'本',18000]);
      Inc(No);
      Appendrecord([No, 'Delphi XE2 Professional ESD',5,'本',94000]);
      Inc(No);
      Appendrecord([No, 'Delphi XE2 Enterprise ESD',10,'本',236000]);
      Inc(No);
      Appendrecord([No, 'Delphi XE2 Ultimate ESD',3,'本',356000]);
      Inc(No);
      Appendrecord([No, 'Delphi XE2 Architect ESD',1,'本',416000]);
      CheckBrowseMode;
    end;
  finally
    if not F then
      CDS.Close;
  end;
end;

// データベースの作成
procedure CreateDB(CDS: TClientDataSet);
var
  I: Integer;
begin
  // データベースの作成
  CDS.Close;
  CDS.FieldDefs.Add('ORD',ftInteger);
  CDS.FieldDefs.Add('ITEM',ftWideString,30);
  CDS.FieldDefs.Add('QTY',ftFloat);
  CDS.FieldDefs.Add('UNIT',ftWideString,4);
  CDS.FieldDefs.Add('PRICE',ftCurrency);
  CDS.IndexDefs.Add('ORD_IDX','ORD', [ixPrimary]);
  //CDS.IndexDefs.Add('ITEM_IDX','ITEM', []);
  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;

  // 集合フィールド
  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;
  CDS.AggregatesActive := True;

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

  // 表示用にフィールド幅を設定
  CDS.FieldByName('ORD').DisplayWidth := 3;
  CDS.FieldByName('ITEM').DisplayWidth := 25;
  CDS.FieldByName('QTY').DisplayWidth := 3;
  CDS.FieldByName('UNIT').DisplayWidth := 4;
  CDS.FieldByName('PRICE').DisplayWidth := 8;
  CDS.FieldByName('AMOUNT').DisplayWidth := 10;

  // 計算フィールドの設定
  CDS.OnCalcFields := Form1.CalcFields;

  // DBEditの設定
  Form1.DBEdit1.DataField := 'TOTAL_F';
  CDS.Open;

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

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

procedure TForm1.ClientDataSet1FilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept := AnsiPos(Edit1.Text, DataSet.FieldByName('ITEM').AsString) > 0;
end;


// 計算フィールド
procedure TForm1.CalcFields(DataSet: TDataSet);
begin
  DataSet.FieldByName('AMOUNT').AsCurrency :=
    DataSet.FieldByName('QTY').AsFloat *
    DataSet.FieldByName('Price').AsCurrency;
end;

// フィルターON
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  //ClientDataSet1.Filter := 'ITEM LIKE '+QuotedStr('%'+ Edit1.Text+'%');
  ClientDataSet1.Filtered := True;
end;

// フィルターOFF
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  ClientDataSet1.Filtered := False;
  ClientDataSet1.Filter := '';
end;

// インデックス ITEM
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  ClientDataSet1.IndexFieldNames := 'ITEM';
  // ClientDataSet1.IndexName := 'ITEM_IDX';
end;

// インデックス ORD_IDX
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  ClientDataSet1.IndexName := 'ORD_IDX';
end;

// Helpより
// メモ:  IndexFieldNames プロパティと
// IndexName プロパティは相互に排他的です。
// 一方を設定するともう一方はクリアされます。

|

MyBaseを試してみる。(インデックスを使わずに、行の追加、挿入、削除編)

前にも書きましたが、私がBDE(TTable)+Paradoxを使っていて一番便利だと思っていたところはインデックスを設定しなくてもAppendとInsertを使い分けることによって、レコードの順番が保持されるところでした。「データベースなんだからインデックスは、ちゃんと作ろうよ」と言われそうですが、本当なら、リスト構造+TStringGrid(or TListView)のところをDBGridを使うためだけのParadoxだったので、そんな点をメリットに感じていました。まあDBGridも複数行のDrag&Drop、Cut&Pasteを実装したりして、データベースというより表計算のようなソフトになっていましたけど。

だから私はMyBaseにもそんな仕様?を求めていました。同じように動作するならTTable(BDE)との置き換えが簡単かも知れないと期待しながら、そしてメモリ内なんだからインデックスはあったら便利だけど、無くても動くよね~なんて気軽に考えていました。しかしこれがなかなか難しく、結論としてインデックスがない場合のフィルターには対応できませんでした。
(フィルターについては、前回紹介したCloneCursor+2段DBGridで妥協しました)

インデックスを使わないMyBaseで困ったところ等を挙げます。
その1
ClientDataSetは、Append、Insertメソッドを持っており、単純に追加、挿入の処理が
できます。しかし、DBGrid上で、追加、挿入の処理が正しくできているように見えて
も、そのままファイルに保存して、再度読み込むと挿入も追加扱いになっています。
MergeChangeLogメソッドを呼び出した後、ファイルに保存すると正しいレコードの
順番で書き込まれます。

その2
ClientDataSetは、Deltaというプロパティを持っており、そこに変更されたデータを
保存しています。そのため、元に戻す処理も簡単にできるようになっています。
しかしながら、Insertで挿入したレコードやDeleteで削除したレコードは、最終行に
戻されるだけです。

その3
フィルター処理し解除した場合、挿入したレコードは、追加扱いになっています。
MergeChangeLogメソッドを呼び出して、ファイルに保存すれば正しく動作すること
から、フィルター前にいろんなことを試してみましたが、一度目は成功してもなぜか
二度目以降は正しく動作しませんでした。
(この記事の最後にどのような処理をしたか、書き残しておきますね)

その4
複数行の処理を元に戻すためにSavePointを利用しています。一度に処理した内
容は、一度に元に戻したいからです。
そのため、元に戻す処理は1度しか使えない仕様でプログラムしています。
デザイン画面

Design_3



var
  RecNoList: TList<Integer>; // Undoに使用
  SP: Integer = -1;          // Undoの処理に使用
  SN: Integer = 0;

// サンプルデータ
procedure MakeSample(DataSet: TDataSet);
var
  F: Boolean;
begin
  F := DataSet.Active;
  if not F then
    DataSet.Open;
  try
    // サンプルデータの追加
    with DataSet do
    begin
      Appendrecord(['iPod Touch']);
      Appendrecord(['Zaurus C-860']);
      Appendrecord(['Delphi 2009 Handbook']);
      Appendrecord(['GEORGIA BLACK']);
      CheckBrowseMode;
    end;
  finally
    if not F then
      DataSet.Close;
  end;
end;

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

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

  CDS.Open;
  MakeSample(CDS);
end;

// DataSetの有効/無効
procedure DataSetEnabled(DataSet: TDataSet; Value: Boolean);
begin
  if Value then
    DataSet.EnableControls
  else
    DataSet.DisableControls;
end;

// SaveToFile
procedure cdsSaveToFile(CDS: TClientDataSet;
  const FileName: String);
begin
  if CDS.ChangeCount > 0 then
    CDS.MergeChangeLog;
  CDS.SaveToFile(FileName);
end;

// LoadFromFile
procedure cdsLoadFromFile(CDS: TClientDataSet;
  const FileName: String);
begin
  CDS.LoadFromFile(FileName);
end;

// 通し番号を返します。別に要らない処理です。
function GetSN: String;
begin
  Inc(SN);
  Result := IntToStr(SN);
end;

// 現在の状態を保存
procedure SaveUndoPoint(CDS: TClientDataSet);
begin
  // 変更があれば更新させます。
  if CDS.ChangeCount > 0 then
    CDS.MergeChangeLog;
  SP := (CDS as TClientDataSet).SavePoint;
end;

// SavePointから元に戻す処理
procedure Undo(CDS: TClientDataSet);
begin
  if SP > -1 then
    CDS.SavePoint := SP;
  SP := -1;
end;

// 削除されたレコードを元に戻す処理 ※コテコテ(^-^)
procedure UndoDelete(CDS: TClientDataSet);
var
  I, RC, RecNo: Integer;
  Delta: TClientDataSet;
begin
  if (RecNoList.Count <> 0) and (CDS.ChangeCount > 0) then
  begin
    Delta := TClientDataSet.Create(nil);
    try
      Delta.Data := CDS.Delta;
      Delta.Open;
      Delta.Last;
      I := -1;
      RC := CDS.RecordCount;

      // Deltaから順番に戻していきます。
      while not Delta.Bof do
      begin
        Inc(I);
        if I < RecNoList.Count then
        begin
          RecNo := RecNoList[I];
          if RecNo > RC then
          begin
            CDS.Append;
            Inc(RC);
          end
          else
          begin
            CDS.RecNo := RecNo;
            CDS.Insert;
            Inc(RC);
          end;
          CDS.FieldByName('Item').AsString :=
            Delta.FieldByName('Item').AsString;
        end;
        Delta.Prior;
      end;
      CDS.CheckBrowseMode;
      CDS.MergeChangeLog;
      RecNoList.Clear;
    finally
      Delta.Free;
    end;
  end;
end;

// Undo
procedure cdsUndoNoIndex(CDS: TClientDataSet);
begin
    if RecNoList.Count > 0 then
    UndoDelete(CDS)            // 削除
  else if (SP > -1)  then
    Undo(CDS)                  // 追加/挿入-SavePoint
  else if CDS.ChangeCount > 0 then
    CDS.UndoLastChange(True);  // 上記以外
end;

// 追加
procedure cdsAppendNoIndex(CDS: TClientDataSet;
  Count: Integer = 1);
var
  I: Integer;
begin
  SaveUndoPoint(CDS);
  DataSetEnabled(CDS, False);
  try
    // Count分空白行を追加します。
    for I := 0 to Count - 1 do
    begin
      // 追加します。
      CDS.Append;
      CDS.FieldByName('ITEM').AsString := '追加'+ GetSN;
    end;
    CDS.CheckBrowseMode;
    // 今回追加した空白行の先頭レコードに移動させます。
    CDS.MoveBy(1-Count);
  finally
    DataSetEnabled(CDS, True);
  end;
end;

// 挿入
procedure cdsInsertNoIndex(CDS: TClientDataSet;
  Count: Integer = 1);
var
  I: Integer;
begin
  SaveUndoPoint(CDS);
  DataSetEnabled(CDS, False);
  try
    for I := 0 to Count -1 do
    begin
      // 挿入します。
      CDS.Insert;
      CDS.FieldByName('ITEM').AsString := '挿入'+ GetSN;
    end;
      CDS.CheckBrowseMode;
  finally
    DataSetEnabled(CDS, True);
  end;
end;

// 削除
procedure cdsDeleteNoIndex(CDS: TClientDataSet;
  BMList: TBookmarkList = nil);
type
  TIntegerComparer = TComparer<Integer>>;
var
  I: Integer;
begin
  // セル編集時は、BMList.Countは0です。
  // その場合の処理は含まれていないです。
  if not Assigned(BMList) then Exit;

  RecNoList.Clear;
  SaveUndoPoint(CDS);
  DataSetEnabled(CDS, False);
  try
    if Assigned(BMList) and (BMList.Count > 0) then
    begin
     for I := BMList.Count -1 downto 0 do
      begin
        CDS.GotoBookmark(BMList[I]);
        RecNoList.Add(CDS.RecNo);
        CDS.Delete;
      end;
      BMList.Clear;
    end;

    // RecNoListのソート
    RecNoList.Sort(TComparer<Integer>.Default);
  finally
    DataSetEnabled(CDS, True);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Undo用
  RecNoList:= TList<Integer>.Create;
  // データベースの作成
  CreateDB(ClientDataSet1, False);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(RecNoList);
end;

procedure TForm1.ClientDataSet2FilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept :=
    AnsiPos(Edit2.Text, DataSet.FieldByName('ITEM').AsString) > 0
end;

// SaveToFile
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  FileName: String;
begin
  FileName := ExtractFilePath(Application.ExeName) + 'MyBase.cds';
  cdsSaveToFile(ClientDataSet1,FileName);
end;

// LoadFromFile
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  FileName: String;
begin
  FileName := ExtractFilePath(Application.ExeName) + 'MyBase.cds';
  if FileExists(FileName) then
    cdsLoadFromFile(ClientDataSet1, FileName);
end;

// 追加
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  cdsAppendNoIndex(ClientDataSet1, StrToIntDef(Edit1.Text,1));
end;

// 挿入
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
  cdsInsertNoIndex(ClientDataSet1, StrToIntDef(Edit1.Text,1));
end;

// 削除
procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
  cdsDeleteNoIndex(ClientDataSet1, DBGrid1.SelectedRows);
end;

// Undo
procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
  cdsUndoNoIndex(ClientDataSet1);
end;

// Filter
procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
  ClientDataSet2.Filtered := not ClientDataSet2.Filtered;
  if ClientDataSet2.Filtered then
  begin
    ClientDataSet2.CloneCursor(ClientDataSet1, TRUE, False);
    ClientDataSet2.OnFilterRecord := ClientDataSet2FilterRecord;
    ClientDataSet2.Filtered := True;
  end
  else
    ClientDataSet2.Close;
end;

実行時画面

Runtime



フィルター処理の前に試したこと(^-^)
// 次のcdsUpdate0~cdsUpdate3までいずれも役に
// 立ちませんでした。
// いずれもClientDataSet1.Filtered := Trueの前に
// 入れてテストしたものです。

// ファイルの読み書きが正しくできるなら
// 採用するかどうかは別として
// この処理で動作すると考えた。
// 2度目以降使えない(T_T)
procedure cdsUpdate0(CDS: TClientDataSet);
begin
  Form1.SpeedButton1Click(nil);
  Form1.SpeedButton2Click(nil);
end;

procedure cdsUpdate1(CDS: TClientDataSet);
var
  Data: OleVariant;
begin
  // 2度目以降使えない(T_T)
  if CDS.ChangeCount > 0 then
    CDS.MergeChangeLog;
  Data := CDS.Data;
  CDS.Data := Data;
end;

procedure cdsUpdate2(CDS: TClientDataSet);
var
   MS: TMemoryStream;
begin
  // 2度目以降使えない(T_T)
  if CDS.ChangeCount > 0 then
    CDS.MergeChangeLog;
  MS := TMemoryStream.Create;
  try
    CDS.SaveToStream(MS, dfBinary);
    MS.Position := 0;
    CDS.LoadFromStream(MS);
  finally
   MS.Free;
  end;
end;

procedure cdsUpdate3(CDS: TClientDataSet);
var
   SL1, SL2: TStringList;
   I, J: Integer;
   FieldName, Value: String;
begin
  // こんなコテコテの処理をしたところで、
  // フィルターで編集されたデータは、
  // 一番最後に移動してしまいます。
  if CDS.ChangeCount > 0 then
    CDS.MergeChangeLog;
  SL1 := TStringList.Create;
  SL2 := TStringList.Create;
  try
    SL1.StrictDelimiter := True;
    SL1.Delimiter := ',';
    CDS.DisableControls;
    try
      CDS.First;
      while not CDS.EOF do
      begin
        SL1.Clear;
        for I := 0 to CDS.Fields.Count -1 do
          if (CDS.Fields[I].FieldKind = fkData) then
          SL1.Add(CDS.Fields[I].FieldName +'='+  CDS.Fields[I].AsString);

        SL2.Add(SL1.CommaText);
        CDS.Next;
      end;
      
      // 次の処理はEmptyDataSetを使う方が簡単
      CDS.Last;
      while not CDS.BOF do
        CDS.Delete;

      for I := 0 to SL2.Count-1 do
      begin
        SL1.CommaText := SL2[I];
        CDS.Append;
        for J := 0 to SL1.Count-1 do
        begin
          FieldName := SL1.Names[J];
          Value := SL1.Values[FieldName];
          CDS.FieldByName(FieldName).AsString := Value;
        end;
      end;
      CDS.CheckBrowseMode;

    finally
      CDS.EnableControls;
    end;

  finally
    SL2.Free;
    SL1.Free;
  end;
end;


MyBaseを試してみる。(インデックスを使わずに、行の追加、挿入、削除編) REVENGE(^o^)もご覧下さい。

|

MyBaseを試してみる。(CloneCursorでOnFilterRecord)

次のようにDBGridを2段配置して、下段にフィルター処理されたレコードを表示させてみました。期待する動作は、 CloneCursorでClientDataSet2を設定し、更にClientDataSet2.OnFilterRecordを設定して、それによりフィルター処理されることです。

Design_2


// サンプルデータ
procedure MakeSample(DataSet: TDataSet);
var
  No: Integer;
  F: Boolean;
begin
  F := DataSet.Active;
  if not F then
    DataSet.Open;
  try
    // サンプルデータの追加
    No := 0;
    with DataSet do
    begin
      Appendrecord(['iPod Touch']);
      Appendrecord(['Zaurus C-860']);
      Appendrecord(['Delphi 2009 Handbook']);
      Appendrecord(['GEORGIA BLACK']);
      CheckBrowseMode;
    end;
  finally
    if not F then
      DataSet.Close;
  end;
end;

// データベースの作成
procedure CreateDB(CDS: TClientDataSet; UsingIndex: Boolean);
var
  I, No: Integer;
begin
  CDS.Close;
  CDS.FieldDefs.Add('ITEM',ftWideString,20);
  CDS.CreateDataSet;
  CDS.Close;

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

  CDS.Open;
  MakeSample(CDS);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // データベースの作成
  CreateDB(ClientDataSet1, False);
end;

procedure TForm1.ClientDataSet1FilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept := AnsiPos(Edit1.Text,DataSet.FieldByName('ITEM').AsString) > 0
end;

procedure TForm1.ClientDataSet2FilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  Accept := AnsiPos(Edit2.Text, DataSet.FieldByName('ITEM').AsString) > 0
end;


// Filter
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  ClientDataSet2.Filtered := not ClientDataSet2.Filtered;
  if ClientDataSet2.Filtered then
  begin
    ClientDataSet2.CloneCursor(ClientDataSet1, False, False);
    ClientDataSet2.Filtered := True;
  end;
end;


しかしながら、いざ実行してみると正しくフィルターできませんでした。というかClientDataSet1のOnFilterRecordのデータが表示されています。

Tryfilter_2


CloneCursorのヘルプを読んでみると、第2のパラメーターの設定によることがわかりました。
procedure CloneCursor(Source: TCustomClientDataSet;
  Reset: Boolean;  KeepSettings: Boolean = False); virtual;

Online Help for Delphi® XE2 and C++Builder® XE2 DBClient.TCustomClientDataSet.CloneCursor
日本語ページを見つけられなかったので、ヘルプを読んでね(^-^)


CloneCursor側のOnFilterRecordを使う場合には、次のようにすると動作しました。
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  ClientDataSet2.Filtered := not ClientDataSet2.Filtered;
  if ClientDataSet2.Filtered then
  begin
    ClientDataSet2.CloneCursor(ClientDataSet1, TRUE, False);
    ClientDataSet2.OnFilterRecord := ClientDataSet2FilterRecord;
    ClientDataSet2.Filtered := True;
  end;
end;

Correct_2

|