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 = 'ＮＯＴ';
    L2 = 'ＯＲ';
  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;

起動時

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

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

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

.