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でも問題ないようです。

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

フィルター処理します。

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

フィルター処理します。

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

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;