qldbflt.~pas

企业ERP管理系统

    ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, ftInterface,
    ftIDispatch, ftGuid}
    else Result := False;
  end;
end;

procedure TQLDBFilterDialog.DataSetFilterRecord(DataSet: TDataSet; var Accept: Boolean);

  function CompareFieldValue(Field: TField; Value: string): Double;
  begin
    case Field.DataType of
//      ftUnknown, ftString, ftFixedChar, ftWideString, ftMemo, ftVariant, ftBlob,
//      ftFmtMemo:
//        Result := True;
      ftSmallint, ftInteger, ftWord, ftAutoInc, ftLargeint:
        Result := Field.AsInteger - StrToInt(Value);
      ftFloat, ftCurrency, ftBCD, ftBytes, ftVarBytes:
          Result := Field.AsFloat - StrToFloat(Value);
//        Result := FilterCondition in [fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
//          fcLess, fcLessEqual];
      ftBoolean: if Field.AsBoolean and (Value = '是') or
        (not Field.AsBoolean and (Value = '否')) then Result := 0
        else Result := 1;//FilterCondition in [fcEqual, fcNotEqual];
      ftDate: Result := Trunc(Field.AsDateTime) - StrToDate(Value);
      ftDateTime: Result := Field.AsDateTime - StrToDateTime(Value);
      ftTime: Result := Frac(Field.AsDateTime) - StrToTime(Value);
//        Result := FilterCondition in [fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
//          fcLess, fcLessEqual];
      {ftGraphic, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftADT
      ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, ftInterface,
      ftIDispatch, ftGuid}
      else Result := AnsiCompareStr(Trim(Field.DisplayText), Value);
    end;
  end;

var
  I, APos: Integer;
  Condition: TFilterCondition;
  FieldName, Value, Temp: string;
begin
  Accept := True;
//  if Accept = False then ShowMessage('Accept');
  if Assigned(FSaveOnFilterRecord) then FSaveOnFilterRecord(DataSet, Accept);
  if Accept then
    for I := 0 to FFilterStrings.Count - 1 do
    begin
      Temp := FFilterStrings[I];
//      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 := ExtractSubStr(Temp, APos, ';');//TField(FFilterStrings.Objects[I]).FieldName;//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 TQLDBFilterDialog.GetDataSet: TDataSet;
//begin
//  if Assigned(FDataSource) then Result := FDataSource.DataSet
//  else Result := nil;
//end;

function TQLDBFilterDialog.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 := ExtractSubStr(Temp, Pos, ';'); //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 TQLDBFilterDialog.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 TQLDBFilterDialog.GetFilterFields: string;
begin
  Result := FFilterFields;
//  Result := StringReplace(FFilterFields.CommaText, ',', ';', rfReplaceAll);
end;

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

{procedure TQLDBFilterDialog.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 TQLDBFilterDialog.SetTitle(const Value: string);
begin
  if FTitle <> Value then
  begin
    FTitle := Value;
  end;
end;

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


function TQLDBFilterDialog.Execute;
var
  FilterForm: TQLDBFilterForm;

  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
          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('Missing DataSet property');
  FilterForm := TQLDBFilterForm.Create(Self);
  with FilterForm do
    try
      Caption := FTitle;
      FillFieldsComboBox;
      cbConditions.Items.Assign(FConditions); //.Items.CommaText := StringReplace(FConditions, ';', ',', [rfReplaceAll]);
      lbFilter.Items.Assign(FFilterStrings);
      cbConditions.ItemIndex := 0;
      if cbFields.Items.Count > 0 then
      begin
        cbFields.ItemIndex := 0;
        cbFields.OnChange(cbFields);
      end;
      if ShowModal = mrOK then
      begin
        FFilterStrings.Assign(lbFilter.Items);
        Result := True;
      end;
    finally
      Free;
    end;
end;

procedure TQLDBFilterDialog.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 TQLDBFilterForm.btnOKClick(Sender: TObject);
begin
  if (lbFilter.Count = 0) and (MessageDlg('是否将定义的条件添加至列表？', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
    btnAddToList.Click;
  ModalResult := mrOK;
end;

procedure TQLDBFilterDialog.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if AComponent = FDataSet then FDataSet := nil;
end;

end.