ukingfilter.pas

MIS工具 万能过滤 查询 网格编辑器S_CXV

//if Assigned(FSaveOnFilterRecord) then
//  FSaveOnFilterRecord(DataSet, Accept);
  s := DataSet.Owner.Name + '.' + DataSet.Name;
  s := s + '=' + SaveTempFilterStr.Values[s];
  TMethod(e).Code := SaveTempFilterStr.Objects[SaveTempFilterStr.IndexOf(s)];
  if Assigned(E) then
  begin
    e(DataSet, Accept);
  end;

  if Accept then
    for I := 0 to SaveTempFilterStr.Count - 1 do
    begin
      Temp := SaveTempFilterStr.Values[DataSet.Owner.Name + '.' + DataSet.Name];
      //      ShowMessage(Temp);

      APos := 1;
      if I <> 0 then
      begin
        if ExtractSubStr(Temp, APos, ';') = '0' then // Logic AND
        begin
          if not Accept then
            Break
        end
        else if Accept then
          Break;
      end
      else
        ExtractSubStr(Temp, APos, ';');
      // FieldName := TField(FFilterStrings.Objects[I]).FieldName;
      FieldName := ExtractSubStr(Temp, APos, ';');
      //ExtractFieldName(Temp, APos);//IndexOfFieldName(FFilterFields, StrToInt(ExtractFieldName(Temp, APos)));
      Condition := TFilterCondition(StrToInt(ExtractSubStr(Temp, APos, ';')));
      Value := ExtractSubStr(Temp, APos, ';');
      //      if DataSet.FieldByName(FieldName).DataType in [ftDate, ftDateTime] then
      //        Value := DateToStr(StrToDate(Value));
      case Condition of
        fcEqual: Accept := CompareFieldValue(DataSet.FieldByName(FieldName),
            Value) = 0;
        fcNotEqual: Accept := CompareFieldValue(DataSet.FieldByName(FieldName),
            Value) <> 0;
        fcGreat: Accept := CompareFieldValue(DataSet.FieldByName(FieldName),
            Value) > 0;
        fcGreatEqual: Accept :=
          CompareFieldValue(DataSet.FieldByName(FieldName), Value) >= 0;
        fcLess: Accept := CompareFieldValue(DataSet.FieldByName(FieldName),
            Value) < 0;
        fcLessEqual: Accept := CompareFieldValue(DataSet.FieldByName(FieldName),
            Value) <= 0;
        fcBeginWith: Accept := LeftStr(DataSet.FieldByName(FieldName).AsString,
            Length(Value)) = Value;
        fcNotBeginWith: Accept :=
          LeftStr(DataSet.FieldByName(FieldName).AsString, Length(Value)) <>
            Value;
        fcEndWith: Accept := RightStr(DataSet.FieldByName(FieldName).AsString,
            Length(Value)) = Value;
        fcNotEndWith: Accept :=
          RightStr(DataSet.FieldByName(FieldName).AsString, Length(Value)) <>
            Value;
        fcContain: Accept := AnsiPos(Value,
            DataSet.FieldByName(FieldName).AsString) > 0;
        fcNotContain: Accept := AnsiPos(Value,
            DataSet.FieldByName(FieldName).AsString) = 0;
      end;
      //      ShowMessage(DataSet.FieldByName(FieldName).AsString + ' - ' + Value + ' = ' +
      //        FloatToStr(CompareFieldValue(DataSet.FieldByName(FieldName), Value)));
    end;
end;

//function TKingFilterDialog.GetDataSet: TDataSet;
//begin
//  if Assigned(FDataSource) then Result := FDataSource.DataSet
//  else Result := nil;
//end;

function TKingFilterDialog.GetFilter;

  function ValueToFilterText(const FieldName, Value: string): string;
  begin
    if Assigned(DataSet) then
      case DataSet.FieldByName(FieldName).DataType of
        ftSmallint, ftInteger, ftWord, ftAutoInc: Result := Value;
        ftFloat, ftCurrency, ftBCD, ftVarBytes, ftBytes, ftTypedBinary: Result
          := Value;
        //       ftDate, ftTime, ftDateTime:
        ftBoolean:
          if Value = '是' then
            Result := 'True'
          else
            Result := 'False';
      else
        Result := '''' + Value + '''';
      end
    else
      Result := Value;
  end;

var
  Temp, FieldName: string;
  I, Pos: Integer;
begin
  Result := '';
  for I := 0 to FFilterStrings.Count - 1 do
  begin
    Temp := FFilterStrings[I];
    Pos := 1;
    if I <> 0 then
    begin
      if ExtractSubStr(Temp, Pos, ';') = '0' then
        Result := Result + ' AND '
      else
        Result := Result + ' OR ';
    end
    else
      ExtractSubStr(Temp, Pos, ';');
    FieldName := TField(FFilterStrings.Objects[I]).FieldName;
    //ExtractFieldName(Temp, APos);//IndexOfFieldName(FFilterFields, StrToInt(ExtractFieldName(Temp, APos)));

  //    FieldName := ExtractSubStr(Temp, Pos, ';');//IndexOfFieldName(FFilterFields, StrToInt(ExtractSubStr(Temp, Pos, ';')));
  //    Result := Result + FieldName;
    case TFilterCondition(StrToInt(ExtractSubStr(Temp, Pos, ';'))) of
      fcEqual: Result := Result + FieldName + ' = ' +
        ValueToFilterText(FieldName, ExtractSubStr(Temp, Pos, ';'));
      fcNotEqual: Result := Result + FieldName + ' <> ' +
        ValueToFilterText(FieldName, ExtractSubStr(Temp, Pos, ';'));
      fcGreat: Result := Result + FieldName + ' >' +
        ValueToFilterText(FieldName, ExtractSubStr(Temp, Pos, ';'));
      fcGreatEqual: Result := Result + FieldName + ' >= ' +
        ValueToFilterText(FieldName, ExtractSubStr(Temp, Pos, ';'));
      fcLess: Result := Result + FieldName + ' < ' +
        ValueToFilterText(FieldName, ExtractSubStr(Temp, Pos, ';'));
      fcLessEqual: Result := Result + FieldName + ' <= ' +
        ValueToFilterText(FieldName, ExtractSubStr(Temp, Pos, ';'));
      fcBeginWith: Result := Result + FieldName + ' LIKE ''' +
        ExtractSubStr(Temp, Pos, ';') + '%''';
      fcNotBeginWith: Result := Result + ' NOT ' + FieldName + ' LIKE ''' +
        ExtractSubStr(Temp, Pos, ';') + '%''';
      fcEndWith: Result := Result + FieldName + ' LIKE ''%' +
        ExtractSubStr(Temp, Pos, ';') + '''';
      fcNotEndWith: Result := Result + ' NOT ' + FieldName + ' LIKE ''%' +
        ExtractSubStr(Temp, Pos, ';') + '''';
      fcContain: Result := Result + FieldName + ' LIKE ''%' +
        ExtractSubStr(Temp, Pos, ';') + '%''';
      fcNotContain: Result := Result + ' NOT ' + FieldName + 'LIKE ''%' +
        ExtractSubStr(Temp, Pos, ';') + '%''';
    end;
  end;
  Result := Trim(Result);
end;

procedure TKingFilterDialog.GetFilterDescriptions(List: TStrings);
var
  I, Pos: Integer;
  S, Temp: string;
begin
  List.Clear;
  for I := 0 to FFilterStrings.Count - 1 do
  begin
    Temp := FFilterStrings[I];
    Pos := 1;
    if I <> 0 then
    begin
      if ExtractSubStr(Temp, Pos) = '0' then
        S := '与'
      else
        S := '或';
    end
    else
      ExtractSubStr(Temp, Pos);
    S := S + ' ' + IndexOfFieldName(FilterFields, StrToInt(ExtractSubStr(Temp,
      Pos)));
    S := S + ' ' + FConditions[StrToInt(ExtractSubStr(Temp, Pos))];
    S := S + ' ' + ExtractSubStr(Temp, Pos) + ' 。';
    List.Add(S);
  end;
end;

function TKingFilterDialog.GetFilterFields: string;
begin
  Result := FFilterFields;
  //  Result := StringReplace(FFilterFields.CommaText, ',', ';', rfReplaceAll);
end;

procedure TKingFilterDialog.SetFilterFields(const Value: string);
begin
  if FFilterFields <> Value then
  begin
    FFilterFields := Value;
    //    InitFieldTypes;
  end;
end;

{procedure TKingFilterDialog.InitFieldTypes;
var
  Pos: Integer;
  FieldName: string;
begin
  if Assigned(DataSet) then
  begin
    SetLength(FFieldTypes, 0);
    Pos := 1;
    FieldName := ExtractFieldName(FFilterFields, Pos);
    while FieldName <> '' do
    begin
      SetLength(FFieldTypes, Length(FFieldTypes) + 1);
      FFieldTypes[High(FFieldTypes)] := DataSet.FieldByName(FieldName).DataType;
      FieldName := ExtractFieldName(FFilterFields, Pos);
    end;
  end;
end;
}

procedure TKingFilterDialog.SetTitle(const Value: string);
begin
  if FTitle <> Value then
  begin
    FTitle := Value;
  end;
end;

procedure TKingFilterDialog.SetDataSet(Value: TDataSet);
begin
  if FDataSet <> Value then
  begin
    if Assigned(DataSet) then
    begin
      DataSet.OnFilterRecord := FSaveOnFilterRecord;
      DataSet.Filtered := FSaveFiltered;
    end;
    FDataSet := Value;
    if Assigned(DataSet) then
    begin
      FSaveOnFilterRecord := DataSet.OnFilterRecord;
      FSaveFiltered := DataSet.Filtered;
      DataSet.OnFilterRecord := DataSetFilterRecord;
    end;
  end;
end;

function TKingFilterDialog.Execute;
var
  FilterForm: TKingFilter;

  procedure FillFieldsComboBox;
  var
    I: Integer;
    //    FieldName: string;
    AFields: TList;
  begin
    //    I := 1;
    //    FieldName := ExtractFieldName(FFilterFields, I);
    if Assigned(DataSet) then
    begin
      AFields := TList.Create;
      try
        with DataSet do
        begin
          if FFilterFields = '' then //如果没有设置过滤字段时,默认是所有字段
            for i := 0 to FieldCount - 1 do
            begin
              if Fields[i].Visible then
                AFields.Add(Fields[i]);
            end
          else
            GetFieldList(AFields, FFilterFields);
          for I := 0 to Fields.Count - 1 do
            if AFields.IndexOf(Fields[I]) >= 0 then
              FilterForm.cbFields.Items.AddObject(Fields[I].DisplayLabel,
                Fields[I]);
        end;
      finally
        AFields.Free;
      end;
    end;

    //      while FieldName <> '' do
    //      begin
    //        FilterForm.cbFields.Items.Add(FDataSource.DataSet.FieldByName(FieldName).DisplayLabel);
    //        FieldName := ExtractFieldName(FFilterFields, I);
    //      end
    //    else
    //      while FieldName <> '' do
    //      begin
    //        FilterForm.cbFields.Items.Add(FieldName);
    //        FieldName := ExtractFieldName(FFilterFields, I);
    //      end
  end;

begin
  Result := False;
  if not Assigned(FDataSet) then
    raise Exception.Create('未设置数据集!');
  FilterForm := TKingFilter.Create(Self);
  with FilterForm do
  try
    Caption := FTitle;
    DataSet := FDataSet;
    FillFieldsComboBox;
    cbConditions.Items.Assign(FConditions);
    //.Items.CommaText := StringReplace(FConditions, ';', ',', [rfReplaceAll]);
//    lbFilter.Items.Assign(FFilterStrings);
    lbFilter.Items.Text := SaveTempFilterStr.Values[DataSet.Owner.Name + '.'
      + DataSet.Name];
    cbConditions.ItemIndex := 0;
    if cbFields.Items.Count > 0 then
    begin
      cbFields.ItemIndex := 0;
      cbFields.OnChange(cbFields);
    end;
    if ShowModal = mrOK then
    begin
        SaveTempFilterStr.Values[DataSet.Owner.Name + '.' + DataSet.Name] :=
          lbFilter.Items.Text;
      if lbFilter.Items.Count > 0 then
      begin
        SaveTempFilterStr.Objects[SaveTempFilterStr.IndexOf(DataSet.Owner.Name +
          '.' + DataSet.Name + '=' + lbFilter.Items.Text)];
        FFilterStrings.Assign(lbFilter.Items);
      end;
      Result := True;
    end;
  finally
    Free;
  end;
end;

procedure TKingFilterDialog.FilterStringsChange(Sender: TObject);
var
  DataSetFiltered: Boolean;
begin
  if not (dfdOnlyBuildFilter in FOptions) and Assigned(DataSet) then
  begin
    DataSetFiltered := DataSet.Filtered;
    DataSet.Filtered := False;
    if (FFilterStrings.Count > 0) or (DataSetFiltered and not FPreFiltered) then
      DataSet.Filtered := True;
    if DataSetFiltered and not FPreFiltered and not FSaveFiltered then
      FSaveFiltered := True;
    FPreFiltered := DataSet.Filtered;
  end;
end;

procedure TKingFilter.btNewClick(Sender: TObject);
var
  S: string;
begin
  S := IntToStr(cbLink.ItemIndex) + ';';
  //  S := S + TField(cbFields.Items.Objects[cbFields.ItemIndex]).FieldName{IntToStr(cbFields.ItemIndex)} + ';' +
  //    IntToStr(Integer(cbConditions.Items.Objects[cbConditions.ItemIndex])) + ';';
  s := s + TField(cbFields.Items.Objects[cbFields.ItemIndex]).FieldName + ';';
  S := S + IntToStr(Integer(cbConditions.Items.Objects[cbConditions.ItemIndex]))
    + ';';
  //  case nbValue.PageIndex of
  //    0: S := S + edtValue.Text;
  //    1: S := S + cbValue.Text;
  //    2: S := S + DateToStr(dtpDate.Date);
  //  end;
  s := s + cbValue.Text + ';';
  //    + edtValue.Text;
  //lbFilter.Items.AddObject(S, cbFields.Items.Objects[cbFields.ItemIndex]);
  lbFilter.Items.Add(S);
  lbFilter.ItemIndex := lbFilter.Items.Count - 1;
  //  lbFilter.Items.AddObject(cbFields.Text + ' ' + cbConditions.Text + ' ' +
  //    edtValue.Text, TObject(Ord(rbAnd.Checked)));
end;

procedure TKingFilter.btDelClick(Sender: TObject);
begin
  lbFilter.Items.Delete(lbFilter.ItemIndex);
  lbFilter.ItemIndex := lbFilter.Items.Count - 1;
end;

procedure TKingFilter.btOkClick(Sender: TObject);
begin
  if (lbFilter.Count = 0) and (MessageDlg('是否将定义的条件添加至列表？',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
    btNew.Click;
  ModalResult := mrOK;
end;

procedure TKingFilter.btCancelClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TKingFilter.btClearClick(Sender: TObject);
begin
  lbFilter.Clear;
end;

procedure TKingFilter.btReplaceClick(Sender: TObject);
begin
  btDel.Click;
  btNew.Click;
end;

procedure TKingFilter.FormActivate(Sender: TObject);
begin
  //  cbFieldsChange(cbFields);
end;

initialization
  SaveTempFilterStr := TStringList.Create;
finalization
  FreeAndNil(SaveTempFilterStr);

end.