cxfilter.pas

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

end;

destructor TcxFilterCriteriaItemList.Destroy;
begin
  Clear;
  FItems.Free;
  inherited Destroy;
end;

function TcxFilterCriteriaItemList.AddItem(AItemLink: TObject; AOperatorKind: TcxFilterOperatorKind;
  const AValue: Variant; const ADisplayValue: string): TcxFilterCriteriaItem;
begin
  Result := Criteria.GetItemClass.Create(Self, AItemLink, AOperatorKind, AValue, ADisplayValue);
  FItems.Add(Result);
  Changed;
end;

function TcxFilterCriteriaItemList.AddItemList(ABoolOperatorKind: TcxFilterBoolOperatorKind): TcxFilterCriteriaItemList;
begin
  Result := Criteria.GetItemListClass.Create(Self, ABoolOperatorKind);
  FItems.Add(Result);
  Changed;
end;

procedure TcxFilterCriteriaItemList.Clear;
var
  I: Integer;
begin
  Criteria.BeginUpdate;
  try
    for I := Count - 1 downto 0 do
      Items[I].Free;
  finally
    Criteria.EndUpdate;
  end;
end;

function TcxFilterCriteriaItemList.IsEmpty: Boolean;
begin
  Result := Count = 0;
end;

function TcxFilterCriteriaItemList.GetCriteria: TcxFilterCriteria;
begin
  if FCriteria <> nil then
    Result := FCriteria
  else
    Result := inherited GetCriteria;
end;

function TcxFilterCriteriaItemList.GetIsItemList: Boolean;
begin
  Result := True;
end;

procedure TcxFilterCriteriaItemList.RemoveItem(AItem: TcxCustomFilterCriteriaItem);
begin
  if FItems.Remove(AItem) <> -1 then
    Changed;
end;

procedure TcxFilterCriteriaItemList.ReadData(AStream: TStream);
var
  ACount, I: Integer;
begin
  inherited;
  BoolOperatorKind := TcxFilterBoolOperatorKind(ReadByteFunc(AStream));
  ACount := ReadIntegerFunc(AStream);
  for I := 0 to ACount - 1 do
    ReadItem(AStream);
end;

procedure TcxFilterCriteriaItemList.WriteData(AStream: TStream);
var
  I: Integer;
begin
  inherited;
  WriteByteProc(AStream, Byte(BoolOperatorKind));
  WriteIntegerProc(AStream, Count);
  for I := 0 to Count - 1 do
    WriteItem(AStream, Items[I]);
end;

function TcxFilterCriteriaItemList.ReadItem(AStream: TStream): TcxCustomFilterCriteriaItem;
var
  AIsItemList: Boolean;
begin
  AIsItemList := ReadBooleanFunc(AStream);
  if AIsItemList then
    Result := AddItemList(fboAnd)
  else
    Result := AddItem(nil, foEqual, Unassigned, '');
  Result.ReadData(AStream);
  if Result.IsEmpty then
    FreeAndNil(Result);
end;

procedure TcxFilterCriteriaItemList.WriteItem(AStream: TStream;
  AItem: TcxCustomFilterCriteriaItem);
begin
  WriteBooleanProc(AStream, AItem.IsItemList);
  AItem.WriteData(AStream);
end;

function TcxFilterCriteriaItemList.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TcxFilterCriteriaItemList.GetItem(Index: Integer): TcxCustomFilterCriteriaItem;
begin
  if (0 <= Index) and (Index < Count) then
    Result := TcxCustomFilterCriteriaItem(FItems[Index])
  else
    Result := nil;
end;

procedure TcxFilterCriteriaItemList.SetBoolOperatorKind(Value: TcxFilterBoolOperatorKind);
begin
  if FBoolOperatorKind <> Value then
  begin
    FBoolOperatorKind := Value;
    Changed; 
  end;
end;

{ TcxFilterCriteriaItem }

constructor TcxFilterCriteriaItem.Create(AOwner: TcxFilterCriteriaItemList;
  AItemLink: TObject; AOperatorKind: TcxFilterOperatorKind; const AValue: Variant;
  const ADisplayValue: string);
begin
  inherited Create(AOwner);
  SetItemLink(AItemLink);
  FDisplayValue := ADisplayValue;
  FOperatorKind := AOperatorKind;
  FValue := AValue;
  RecreateOperator;
  CheckDisplayValue;
end;

destructor TcxFilterCriteriaItem.Destroy;
begin
  FOperator.Free;
  FOperator := nil;
  inherited Destroy;
end;

function TcxFilterCriteriaItem.IsEmpty: Boolean;
begin
  Result := ItemLink = nil; 
end;

function TcxFilterCriteriaItem.ValueIsNull(const AValue: Variant): Boolean;
begin
  Result := Criteria.ValueIsNull(AValue);
end;

procedure TcxFilterCriteriaItem.CheckDisplayValue;
begin
  if ((FOperator is TcxFilterNullOperator) or (FOperator is TcxFilterNotNullOperator)) and
    (FDisplayValue = '') then
    FDisplayValue := cxSFilterString(@cxSFilterBlankCaption);
end;

function TcxFilterCriteriaItem.GetDisplayValue: string;
begin
  Result := DisplayValue;
  Operator.PrepareDisplayValue(Result);
end;

function TcxFilterCriteriaItem.GetExpressionValue(AIsCaption: Boolean): string;
begin
  if AIsCaption then
    Result := GetDisplayValue
  else
    Result := Operator.GetExpressionValue(Value);
end;

function TcxFilterCriteriaItem.GetFilterOperatorClass: TcxFilterOperatorClass;
const
  AOperatorClasses: array[TcxFilterOperatorKind] of TcxFilterOperatorClass = (
    TcxFilterEqualOperator, TcxFilterNotEqualOperator,
    TcxFilterLessOperator, TcxFilterLessEqualOperator,
    TcxFilterGreaterOperator, TcxFilterGreaterEqualOperator,
    TcxFilterLikeOperator, TcxFilterNotLikeOperator,
    TcxFilterBetweenOperator, TcxFilterNotBetweenOperator,
    TcxFilterInListOperator, TcxFilterNotInListOperator,
    TcxFilterYesterdayOperator, TcxFilterTodayOperator, TcxFilterTomorrowOperator,
    TcxFilterLast7DaysOperator, TcxFilterLastWeekOperator, TcxFilterLast14DaysOperator, TcxFilterLastTwoWeeksOperator,
    TcxFilterLast30DaysOperator, TcxFilterLastMonthOperator, TcxFilterLastYearOperator, TcxFilterInPastOperator,
    TcxFilterThisWeekOperator, TcxFilterThisMonthOperator, TcxFilterThisYearOperator,
    TcxFilterNext7DaysOperator, TcxFilterNextWeekOperator, TcxFilterNext14DaysOperator, TcxFilterNextTwoWeeksOperator,
    TcxFilterNext30DaysOperator, TcxFilterNextMonthOperator, TcxFilterNextYearOperator, TcxFilterInFutureOperator);
  ANullOperatorClasses: array[Boolean] of TcxFilterOperatorClass = (
    TcxFilterNullOperator, TcxFilterNotNullOperator);
begin
  if (OperatorKind in [foEqual, foNotEqual, foLike, foNotLike]) and (ValueIsNull(Value)) then
    Result := ANullOperatorClasses[OperatorKind in [foNotEqual, foNotLike]]
  else
    Result := AOperatorClasses[OperatorKind];
end;

function TcxFilterCriteriaItem.GetItemLink: TObject;
begin
  Result := FItemLink;
end;

procedure TcxFilterCriteriaItem.SetItemLink(Value: TObject);
begin
  FItemLink := Value;
end;

function TcxFilterCriteriaItem.GetIsItemList: Boolean;
begin
  Result := False;
end;

procedure TcxFilterCriteriaItem.RecreateOperator;
var
  AIsConstruction: Boolean;
begin
  AIsConstruction := FOperator = nil;
  FOperator.Free;
  FOperator := GetFilterOperatorClass.Create(Self);
  if not AIsConstruction then
    Changed;
end;

procedure TcxFilterCriteriaItem.ReadData(AStream: TStream);

  function FindItemLink(const AName: string; AID: Integer): TObject;
  begin
    if AName = '' then
      Result := Criteria.GetItemLinkByID(AID)
    else
    begin
      Result := Criteria.GetItemLinkByName(AName);
      if Result = nil then
      begin
        Result := Criteria.GetItemLinkByID(AID);
        if (Result <> nil) and (Criteria.GetNameByItemLink(Result) <> '') then
          Result := nil;
      end;
    end;
  end;

var
  AItemLinkID: Integer;
  AItemLinkName: string;
begin
  inherited;
  OperatorKind := TcxFilterOperatorKind(ReadByteFunc(AStream));
  DisplayValue := ReadStringFunc(AStream);

  AItemLinkID := ReadIntegerFunc(AStream);
  if Criteria.LoadedVersion >= 3 then
    AItemLinkName := ReadStringFunc(AStream)
  else
    AItemLinkName := '';

  Value := ReadVariantFunc(AStream);

  SetItemLink(FindItemLink(AItemLinkName, AItemLinkID));
  CheckDisplayValue;
end;

procedure TcxFilterCriteriaItem.WriteData(AStream: TStream);
begin
  inherited WriteData(AStream);
  WriteByteProc(AStream, Byte(OperatorKind));
  WriteStringProc(AStream, DisplayValue);

  WriteIntegerProc(AStream, Criteria.GetIDByItemLink(ItemLink));
  if Criteria.SavedVersion >= 3 then
    WriteStringProc(AStream, Criteria.GetNameByItemLink(ItemLink));

  WriteVariantProc(AStream, Value);
end;

procedure TcxFilterCriteriaItem.SetOperatorKind(Value: TcxFilterOperatorKind);
begin
  if FOperatorKind <> Value then
  begin
    FOperatorKind := Value;
    RecreateOperator;
  end;
end;

procedure TcxFilterCriteriaItem.SetDisplayValue(const Value: string);
begin
  if FDisplayValue <> Value then
  begin
    FDisplayValue := Value;
    Changed;
  end;
end;

procedure TcxFilterCriteriaItem.SetValue(const Value: Variant);
begin
  if VarCompare(FValue, Value) <> 0 then
  begin
    FValue := Value;
    RecreateOperator;
  end;
end;

{ TcxFilterValueList }

constructor TcxFilterValueList.Create(ACriteria: TcxFilterCriteria);
begin
  inherited Create;
  FCriteria := ACriteria;
  FItems := TList.Create;
end;

destructor TcxFilterValueList.Destroy;
begin
  Clear;
  FItems.Free;
  inherited Destroy;
end;

procedure TcxFilterValueList.Add(AKind: TcxFilterValueItemKind; const AValue: Variant;
  const ADisplayText: string; ANoSorting: Boolean);
var
  AIndex: Integer;
  PItem: PcxFilterValueItem;
begin
  AIndex := -1;
  if AKind = fviMRU then
  begin
    AIndex := GetMRUSeparatorIndex;
    if AIndex = -1 then // first MRU item
    begin
      AIndex := 0;
      // add MRU Separator
      New(PItem);
      PItem.Kind := fviMRUSeparator;
      PItem.Value := Null;
      PItem.DisplayText := '';
      FItems.Insert(AIndex, PItem);
    end;
  end
  else
    if AKind <> fviValue then
      AIndex := GetStartValueIndex
    else
      if ANoSorting then
        AIndex := Count
      else
        if ((MaxCount = 0) or (Count < MaxCount)) then
          if Find(AValue, ADisplayText, AIndex) then
            AIndex := -1;
  if AIndex <> -1 then
  begin
    New(PItem);
    PItem.Kind := AKind;
    PItem.Value := AValue;
    PItem.DisplayText := ADisplayText;
    FItems.Insert(AIndex, PItem);
  end;
end;

procedure TcxFilterValueList.Clear;
var
  I: Integer;
begin
  for I := 0 to FItems.Count - 1 do
    Dispose(PcxFilterValueItem(FItems[I]));
  FItems.Clear;
end;

procedure TcxFilterValueList.Delete(AIndex: Integer);
begin
  Dispose(PcxFilterValueItem(FItems[AIndex]));
  FItems.Delete(AIndex);
end;

function TcxFilterValueList.Find(const AValue: Variant; const ADisplayText: string;
  var AIndex: Integer): Boolean;
var
  L, H, I, C: Integer;
  AMRUSeparatorIndex: Integer;
begin
  Result := False;
  // MRU
  AMRUSeparatorIndex := GetMRUSeparatorIndex;
  if AMRUSeparatorIndex <> -1 then
    for I := 0 to AMRUSeparatorIndex - 1 do
      if CompareItem(I, AValue, ADisplayText) = 0 then
      begin
        AIndex := I;
        Result := True;
        Exit;
      end;
  // Values
  L := GetStartValueIndex;
  H := Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := CompareItem(I, AValue, ADisplayText);
    if C < 0 then
      L := I + 1
    else
    begin
      if C = 0 then
      begin
        Result := True;
        L := I;
      end;
      H := I - 1;
    end;
  end;
  AIndex := L;
end;

function TcxFilterValueList.FindItemByKind(AKind: TcxFilterValueItemKind): Integer;
begin
  Result := FindItemByKind(AKind, Null);
end;

function TcxFilterValueList.FindItemByKind(AKind: TcxFilterValueItemKind;
  const AValue: Variant): Integer;
begin
  for Result := 0 to Count - 1 do
    if (Items[Result].Kind = AKind) and
      (VarIsNull(AValue) or VarEquals(Items[Result].Value, AValue)) then
      Exit;
  Result := -1;
end;

function TcxFilterValueList.FindItemByValue(const AValue: Variant): Integer;
begin
  if not Find(AValue, AValue, Result) then
    Result := -1;
end;

function TcxFilterValueList.GetIndexByCriteriaItem(ACriteriaItem: TcxFilterCriteriaItem): Integer;
begin
  if ACriteriaItem = nil then
    Result := FindItemByKind(fviAll)
  else
    if ACriteriaItem.ValueIsNull(ACriteriaItem.Value) and
      (ACriteriaItem.OperatorKind in [foEqual, foNotEqual]) then
      if ACriteriaItem.OperatorKind = foEqu