cxdbfiltercontrol.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 954 行 · 第 1/2 页

  end;
end;

{ TcxFilterItemCollection }

procedure TcxFilterItemCollection.Update(Item: TCollectionItem);
begin
  if (UpdateCount = 0) and (Control.ComponentState * [csDestroying, csLoading] = []) then
    Control.LayoutChanged;
end;

function TcxFilterItemCollection.GetControl: TcxDBFilterControl;
begin
  if GetOwner is TcxDBFilterControl then
    Result := TcxDBFilterControl(GetOwner)
  else
    Result := nil;
end;

function TcxFilterItemCollection.GetItems(Index: Integer): TcxFilterItem;
begin
  Result := TcxFilterItem(inherited Items[Index])
end;

procedure TcxFilterItemCollection.SetItems(Index: Integer;
  const Value: TcxFilterItem);
begin
  inherited Items[Index] := Value;
end;

{ TcxFilterPropertiesList }

procedure TcxFilterPropertiesList.Clear;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    TcxCustomEditProperties(Items[I]).Free;
  inherited Clear;
end;

function TcxFilterPropertiesList.GetProperties(
  AClass: TcxCustomEditPropertiesClass): TcxCustomEditProperties;
var
  I: Integer;
begin
  Result := nil;
  if AClass = nil then Exit;
  for I := 0 to Count - 1 do
    if TcxCustomEditProperties(Items[I]).ClassType = AClass then
    begin
      Result := TcxCustomEditProperties(Items[I]);
      break
    end;
  if Result = nil then
  begin
    Result := AClass.Create(nil);
    Add(Result);
  end;
end;

{ TcxDBFilterOptions }

constructor TcxDBFilterOptions.Create(AFilterControl: TcxDBFilterControl);
begin
  FFilterControl := AFilterControl;
  FSupportedBetween := True;
  FSupportedIn := True;
  FSupportedLike := True;
end;

procedure TcxDBFilterOptions.Assign(Source: TPersistent);
begin
  if Source is TcxDBFilterOptions then
    with TcxDBFilterOptions(Source) do
    begin
      Self.DateTimeFormat := DateTimeFormat;
      Self.PercentWildcard := PercentWildcard;
      Self.SoftNull := SoftNull;
      Self.SupportedBetween := SupportedBetween;
      Self.SupportedIn := SupportedIn;
      Self.SupportedLike := SupportedLike;
      Self.TranslateBetween := TranslateBetween;
      Self.TranslateIn := TranslateIn;
      Self.TranslateLike := TranslateLike;
      Self.UnderscoreWildcard := UnderscoreWildcard;
    end;
end;

procedure TcxDBFilterOptions.ProcessFilterOperators(
  var SupportedOperations: TcxFilterControlOperators);
begin
  if not SupportedBetween then
    SupportedOperations := SupportedOperations - [fcoBetween, fcoNotBetween];
  if not SupportedIn then
    SupportedOperations := SupportedOperations - [fcoInList, fcoNotInList];
  if not SupportedLike then
    SupportedOperations := SupportedOperations - [fcoLike, fcoNotLike];
end;

function TcxDBFilterOptions.GetOwner: TPersistent;
begin
  Result := FFilterControl;
end;

function TcxDBFilterOptions.GetDateTimeFormat: string;
begin
  Result := FFilterControl.Criteria.DateTimeFormat;
end;

function TcxDBFilterOptions.GetPercentWildcard: Char;
begin
  Result := FFilterControl.Criteria.PercentWildcard;
end;

function TcxDBFilterOptions.GetSoftNull: Boolean;
begin
  Result := fcoSoftNull in FFilterControl.Criteria.Options;
end;

function TcxDBFilterOptions.GetTranslateBetween: Boolean;
begin
  Result := FFilterControl.Criteria.TranslateBetween;
end;

function TcxDBFilterOptions.GetTranslateIn: Boolean;
begin
  Result := FFilterControl.Criteria.TranslateIn;
end;

function TcxDBFilterOptions.GetTranslateLike: Boolean;
begin
  Result := FFilterControl.Criteria.TranslateLike;
end;

function TcxDBFilterOptions.GetUnderscoreWildcard: Char;
begin
  Result := FFilterControl.Criteria.UnderscoreWildcard;
end;

procedure TcxDBFilterOptions.SetDateTimeFormat(const Value: string);
begin
  FFilterControl.Criteria.DateTimeFormat := Value;
end;

procedure TcxDBFilterOptions.SetPercentWildcard(Value: Char);
begin
  FFilterControl.Criteria.PercentWildcard := Value;
end;

procedure TcxDBFilterOptions.SetSoftNull(Value: Boolean);
begin
  with FFilterControl.Criteria do
    if Value then
      Options := Options + [fcoSoftNull]
    else
      Options := Options - [fcoSoftNull];
end;

procedure TcxDBFilterOptions.SetTranslateBetween(Value: Boolean);
begin
  FFilterControl.Criteria.TranslateBetween := Value;
end;

procedure TcxDBFilterOptions.SetTranslateIn(Value: Boolean);
begin
  FFilterControl.Criteria.TranslateIn := Value;
end;

procedure TcxDBFilterOptions.SetTranslateLike(Value: Boolean);
begin
  FFilterControl.Criteria.TranslateLike := Value;
end;

procedure TcxDBFilterOptions.SetUnderscoreWildcard(Value: Char);
begin
  FFilterControl.Criteria.UnderscoreWildcard := Value;
end;

{ TcxDBFilterControl }

constructor TcxDBFilterControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFilterOptions := TcxDBFilterOptions.Create(Self);
  FItems := TcxFilterItemCollection.Create(Self, TcxFilterItem);
  FDataSource := TDataSource.Create(Self);
  FDataSource.OnStateChange := DataSetStateChange;
  FFieldsProperties := TcxFilterPropertiesList.Create;
end;

destructor TcxDBFilterControl.Destroy;
begin
  FreeAndNil(FDataSource);
  FreeAndNil(FItems);
  FreeAndNil(FFieldsProperties);
  FreeAndNil(FFilterOptions);
  inherited Destroy;
end;

procedure TcxDBFilterControl.BuildFromCriteria;
begin
  inherited;
end;

procedure TcxDBFilterControl.Clear;
begin
  inherited Clear;
  FFieldsProperties.Clear;
end;

function TcxDBFilterControl.GetFilterTextEx(
  const AFieldNamePrefix, AFieldNamePostfix: string): string;
begin
  FFieldNamePrefix := AFieldNamePrefix;
  FFieldNamePostfix := AFieldNamePostfix;
  try
    Result := GetFilterText;
  finally
    FFieldNamePrefix := '';
    FFieldNamePostfix := '';
  end;
end;

function TcxDBFilterControl.GetPropertiesClassFromFieldType(
  AFieldType: TFieldType): TcxCustomEditPropertiesClass;
begin
  case AFieldType of
    ftString, ftWideString:
      Result := TcxTextEditProperties;
    ftSmallint, ftInteger, ftWord, ftAutoInc {$IFDEF DELPHI6}, ftLargeint {$ENDIF}:
      Result := TcxSpinEditProperties;
    ftBoolean:
      Result := TcxCheckBoxProperties;
    ftFloat:
      Result := TcxCalcEditProperties;
    ftCurrency, ftBCD:
      Result := TcxCurrencyEditProperties;
    ftDate, ftDateTime {$IFDEF DELPHI6}, ftTimeStamp {$ENDIF}:
      Result := TcxDateEditProperties;
    ftTime:
      Result := TcxTimeEditProperties;
  else
    Result := nil;
  end;
end;

function TcxDBFilterControl.GetCaption(Index: Integer): string;
begin
  if (Index > -1) and (Index < GetCount) then
    if FItems.Count > 0 then
      Result := FItems[Index].Caption
    else
      Result := GetField(Index).DisplayName
  else
    Result := '';
end;

function TcxDBFilterControl.GetCount: Integer;
var
  I: Integer;
begin
  if (FItems <> nil) and (FItems.Count > 0) then
    Result := FItems.Count
  else
    if (FDataSet <> nil) and not (FDataSet.DefaultFields and (FDataSource.State = dsInactive)) then
    begin
      Result := 0;
      with FDataSet do
        for I := 0 to Fields.Count - 1 do
          if Fields[I].Visible then Inc(Result);
    end
    else
      Result := 0;
end;

function TcxDBFilterControl.GetCriteria: TcxFilterCriteria;
begin
  Result := inherited Criteria;
end;

function TcxDBFilterControl.GetItemLink(Index: Integer): TObject;
begin
  if (Index > -1) and (Index < GetCount) then
    if FItems.Count > 0 then
      Result := FItems[Index]
    else
      Result := GetField(Index)
  else
    Result := nil;
end;

function TcxDBFilterControl.GetItemLinkID(Index: Integer): Integer;
begin
  Result := Index;
end;

function TcxDBFilterControl.GetItemLinkName(Index: Integer): string;
begin
  Result := GetFieldName(Index);
end;

function TcxDBFilterControl.GetFieldName(Index: Integer): string;
var
  AField: TField;
begin
  if (Index > -1) and (Index < GetCount) then
    if FItems.Count > 0 then
      Result := FItems[Index].FieldName
    else
    begin
      AField := GetField(Index);
      if AField.Origin <> '' then
        Result := FFieldNamePrefix + AField.Origin + FFieldNamePostfix
      else
        Result := FFieldNamePrefix + AField.FieldName + FFieldNamePostfix;
    end
  else
    Result := '';
end;

function TcxDBFilterControl.GetProperties(Index: Integer): TcxCustomEditProperties;
begin
  if (Index > -1) and (Index < GetCount) then
    if FItems.Count > 0 then
      Result := FItems[Index].GetProperties
    else
      Result := FFieldsProperties.GetProperties(
        GetPropertiesClassFromFieldType(GetField(Index).DataType))
  else
    Result := nil;
  if Result = nil then Result := GetDefaultProperties;
end;

function TcxDBFilterControl.GetValueType(Index: Integer): TcxValueTypeClass;

  function TrimFieldName(const AFieldName: string): string;
  begin
    Result := AFieldName;
    while (Length(Result) > 0) and 
      (AnsiChar(Result[1]) in [#0..' ', '"', '''', '[']) do
        Delete(Result, 1, 1);
    while (Length(Result) > 0) and 
      (AnsiChar(Result[Length(Result)]) in [#0..' ', '"', '''', ']']) do
        Delete(Result, Length(Result), 1);
  end;

var
  AField: TField;
begin
  if (Index > -1) and (Index < GetCount) then
    if FItems.Count > 0 then
    begin
      if (FDataSet <> nil) then
        AField := FDataSet.FindField(TrimFieldName(FItems[Index].FieldName))
      else
        AField := nil;
      Result := GetValueTypeClassByField(AField);
    end
    else
      Result := GetValueTypeClassByField(GetField(Index))
  else
  Result := nil;
end;

procedure TcxDBFilterControl.SetFilterOptions(Value: TcxDBFilterOptions);
begin
  FFilterOptions.Assign(Value);
end;

procedure TcxDBFilterControl.SetItems(Value: TcxFilterItemCollection);
begin
  FItems.Assign(Value);
end;

procedure TcxDBFilterControl.SetDialogLinkComponent(ALink: TComponent);
begin
  if ALink = nil then
    DataSet := nil
  else
    if ALink is TDataSet then DataSet := TDataSet(ALink);
end;

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

procedure TcxDBFilterControl.CorrectOperatorClass(
  var AOperatorClass: TcxFilterOperatorClass);
var
  AOperatorAdapter: TcxDBFilterOperatorAdapter;
begin
  AOperatorAdapter := cxGetFilterOperatorAdapter(FDataSet);
  if Assigned(AOperatorAdapter) then
    AOperatorAdapter.PrepareOperatorClass(nil, FDataSet, AOperatorClass);
end;

procedure TcxDBFilterControl.DoApplyFilter;
begin
  FApplyingFilter := True;
  try
    inherited DoApplyFilter;
  finally
    FApplyingFilter := False;
  end;
end;

procedure TcxDBFilterControl.ValidateConditions(
  var SupportedOperations: TcxFilterControlOperators);
begin
  FilterOptions.ProcessFilterOperators(SupportedOperations);
end;

function TcxDBFilterControl.GetFilterLink: IcxFilterControl;
begin
  QueryInterface(IcxFilterControl, Result);
end;

{$IFDEF CBUILDER6}
function TcxDBFilterControl.GetDataSet: TDataSet;
begin
  Result := FDataSet;
end;

function TcxDBFilterControl.GetItems: TcxFilterItemCollection;
begin
  Result := FItems;
end;
{$ENDIF}

function TcxDBFilterControl.GetField(AIndex: Integer): TField;
var
  I, ATest: Integer;
begin
  ATest := 0;
  Result := nil;
  with FDataSet do
    for I := 0 to Fields.Count - 1 do
      if Fields[I].Visible then
      begin
        if ATest = AIndex then
        begin
          Result := Fields[I];
          Exit;
        end;
        Inc(ATest);
      end;
end;

function TcxDBFilterControl.GetFilterOptions: TcxDBFilterOptions;
begin
  Result := FFilterOptions; 
end;

procedure TcxDBFilterControl.DataSetStateChange(Sender: TObject);
begin
  if not FApplyingFilter and (FDataSource.State in [dsInactive, dsBrowse]) then
    LayoutChanged;
end;

procedure TcxDBFilterControl.SetDataSet(const Value: TDataSet);
begin
  if FDataSet <> Value then
  begin
    FDataSet := Value;
    FDataSource.DataSet := Value;
    Clear;
    if Value <> nil then Value.FreeNotification(Self);
  end;
end;

end.