ukingfilter.~pas

delphi源码 delphi源码 delphi源码 delphi源码 delphi源码

    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 := CS('与')
      else
        S := CS('或');
    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(CS('未设置数据集!'));
  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;
    LoadDBCondition; //装入预存在数据库中的预设条件
    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
  checkValueType(nil);
  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(CS('是否将定义的条件添加至列表？'),
    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
  checkValueType(nil);
  btDel.Click;
  btNew.Click;
end;

procedure TKingFilter.cbSavedListChange(Sender: TObject);
//var
//  s: string;
begin
  if cbSavedList.ItemIndex = -1 then
    exit;
  if lbFilter.Items.Count > 0 then
    if MessageDlg(CS('是否覆盖当前的条件?'), mtWarning, [mbYes, mbNo], 0) = mrNo
      then
    begin
      cbSavedList.ItemIndex := -1;
      exit;
    end;
  lbFilter.Items.Text :=
    ku.GetIniValue(DataSet.Owner.Name + '.' +
    DataSet.Name, cbSavedList.Text, '');

end;

procedure TKingFilter.btAddtodbClick(Sender: TObject);
var
  s: string;
begin
  if lbFilter.Items.Count = 0 then
  begin
    MSG_OK(CS('请先设置筛选条件!'), MB_ICONERROR);
    Exit;
  end;
  s := InputBox(CS('输入'),CS('请输入预设条件的标题'), CS('新的预设条件'));
  if cbSavedList.Items.IndexOf(s) > 0 then
    if MSG_YESNO(CS('预设条件已经存在,是否替换?')) then
    begin //删除旧的预设条件
      cbSavedList.ItemIndex := cbSavedList.Items.IndexOf(s);
      btDelFromDb.Click;
    end;

  ku.SetIniValue(DataSet.Owner.Name + '.' +
    DataSet.Name, S, lbFilter.Items.Text);
  begin
    LoadDBCondition;
    cbSavedList.ItemIndex := cbSavedList.Items.IndexOf(s);
  end;

end;

procedure TKingFilter.LoadDBCondition;
var
  i: integer;
  st: TstringList;
begin

  try
    st := GetIniSec(DataSet.Owner.Name + '.' +
      DataSet.Name);
    if assigned(st) then
    begin
      cbSavedList.Clear;
      for i := 0 to st.Count - 1 do
        cbSavedList.AddItem(st.Strings[i],
          TObject(i));
      if i > 0 then
        cbSavedList.ItemIndex := 0;
    end;
  finally
    FreeAndNil(st);
  end;

end;

procedure TKingFilter.btDelFromDbClick(Sender: TObject);
begin
  if cbSavedList.ItemIndex = -1 then
    exit;
  if MSG_YESNO(CS('确定要删除吗?'), MB_ICONWARNING) then
  begin
    IniDelName(DataSet.Owner.Name + '.' +
      DataSet.Name, cbSavedList.Text);
    LoadDBCondition;
  end;
end;

procedure TKingFilter.cbFieldsChange(Sender: TObject);
const
  maxtime = 500; //如果500毫秒内还未完成填充动作,则就不再填充
var
  I: Integer;
  d: DWORD;
  bm: string;
begin
  //设置条件项目
  cbConditions.Clear;
  for I := 0 to FFilterDialog.FConditions.Count - 1 do
    if
      FFilterDialog.CanUseFilterCondition(TField(cbFields.Items.Objects[cbFields.ItemIndex]),
      TFilterCondition(FFilterDialog.FConditions.Objects[I])) then
      cbConditions.Items.AddObject(FFilterDialog.FConditions[I],
        FFilterDialog.FConditions.Objects[I]);
  cbConditions.Enabled := cbConditions.Items.Count > 0;
  if cbConditions.Enabled then
    cbConditions.ItemIndex := 0;
  //设置可供选择的项目
//  if not showing then
//    exit;
  d := GetTickCount;
  cbValue.Clear;
  bm := DataSet.Bookmark;
  DataSet.Filtered := False;
  DataSet.DisableControls;
  try
    try
      with DataSet do
      begin
        First;
        if TField(cbFields.Items.Objects[cbFields.ItemIndex]).DataType =
          ftBoolean then
        begin
          cbValue.Items.Add('True');
          cbValue.Items.Add('False');
        end;
        while not Eof do
        begin
          //填充值到cbValue中了
          if (TField(cbFields.Items.Objects[cbFields.ItemIndex]).AsString <> '')
            and
            (cbValue.Items.IndexOf(TField(cbFields.Items.Objects[cbFields.ItemIndex]).AsString) = -1) then
            cbValue.Items.Add(TField(cbFields.Items.Objects[cbFields.ItemIndex]).AsString);
          if (GetTickCount - d) >= maxtime then
          begin
            Application.ProcessMessages;
            if ActiveControl <> cbFields then
              Break; //如果时间到了,并且界面上做了其他的选择或是动作,则退出不执行了
          end;

          Next;
        end;
      end;
      //      Caption:=IntToStr(cbValue.Items.Count);
      DataSet.Bookmark := bm;
    except
    end;
  finally
    DataSet.EnableControls;
  end;

  //  case TField(cbFields.Items.Objects[cbFields.ItemIndex]).DataType of
  //    ftBoolean: nbValue.PageIndex := 1;
  //    ftDate, ftDateTime: nbValue.PageIndex := 2;
  //    ftString, ftWideString, ftFixedChar, ftMemo, ftFmtMemo:
  //      cbConditions.ItemIndex :=
  //        cbConditions.Items.IndexOfObject(TObject(fcContain));
  //  else
  //    nbValue.PageIndex := 0;
  //  end;
end;

procedure TKingFilter.checkValueType(Sender: TObject);
var
  s: string;
  f: TObject;
begin //检测所输入的内容,是否符合指定字段的类型
  s := cbValue.Text;
  if s = '' then
    exit;
  f := cbFields.Items.Objects[cbFields.ItemIndex];
  if Assigned(f) then
  begin
    try
      case TField(F).DataType of
        ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftBCD, ftBytes,
          ftVarBytes, ftAutoInc, ftLargeint:
          StrToFloat(s);
        ftBoolean:
          StrToBool(s);
        ftDate, ftTime, ftDateTime:
          StrToDateTime(s);
      end;
    except
      MessageDlg(CS('输入的值类型不正确!'), mtError, [mbOK], 0);
      cbValue.SelectAll;
      cbValue.SetFocus;
      Abort;
    end;
  end;
end;

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

end.