cxfilter.pas

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

  end;

  { NextYear }

  TcxFilterNextYearOperator = class(TcxFilterDateOperator)
  protected
    procedure Prepare; override;
  public
    function DisplayText: string; override;
  end;

  { InFuture }

  TcxFilterInFutureOperator = class(TcxFilterDateOperator)
  protected
    procedure Prepare; override;
  public
    function DisplayText: string; override;
  end;

  { TcxCustomFilterCriteriaItem }

  TcxCustomFilterCriteriaItem = class
  private
    FParent: TcxFilterCriteriaItemList;
  protected
    procedure Changed; virtual;
    function GetCriteria: TcxFilterCriteria; virtual;
    function GetIsItemList: Boolean; virtual; abstract;
    procedure ReadData(AStream: TStream); virtual;
    procedure WriteData(AStream: TStream); virtual;
  public
    constructor Create(AOwner: TcxFilterCriteriaItemList);
    destructor Destroy; override;
    function IsEmpty: Boolean; virtual; abstract;
    property IsItemList: Boolean read GetIsItemList;
    property Criteria: TcxFilterCriteria read GetCriteria;
    property Parent: TcxFilterCriteriaItemList read FParent;
  end;

  { TcxFilterCriteriaItemList }

  TcxFilterCriteriaItemListClass = class of TcxFilterCriteriaItemList;

  TcxFilterCriteriaItemList = class(TcxCustomFilterCriteriaItem)
  private
    FBoolOperatorKind: TcxFilterBoolOperatorKind;
    FCriteria: TcxFilterCriteria;
    FItems: TList;
    function GetCount: Integer;
    function GetItem(Index: Integer): TcxCustomFilterCriteriaItem;
    procedure SetBoolOperatorKind(Value: TcxFilterBoolOperatorKind);
  protected
    function GetCriteria: TcxFilterCriteria; override;
    function GetIsItemList: Boolean; override;
    procedure RemoveItem(AItem: TcxCustomFilterCriteriaItem); virtual;
    procedure ReadData(AStream: TStream); override;
    procedure WriteData(AStream: TStream); override;
    function ReadItem(AStream: TStream): TcxCustomFilterCriteriaItem;
    procedure WriteItem(AStream: TStream; AItem: TcxCustomFilterCriteriaItem);
  public
    constructor Create(AOwner: TcxFilterCriteriaItemList; ABoolOperatorKind: TcxFilterBoolOperatorKind); virtual;
    destructor Destroy; override;
    function AddItem(AItemLink: TObject; AOperatorKind: TcxFilterOperatorKind;
      const AValue: Variant; const ADisplayValue: string): TcxFilterCriteriaItem;
    function AddItemList(ABoolOperatorKind: TcxFilterBoolOperatorKind): TcxFilterCriteriaItemList;
    procedure Clear;
    function IsEmpty: Boolean; override;
    property BoolOperatorKind: TcxFilterBoolOperatorKind read FBoolOperatorKind write SetBoolOperatorKind default fboAnd;
    property Count: Integer read GetCount;
    property Criteria: TcxFilterCriteria read GetCriteria;
    property Items[Index: Integer]: TcxCustomFilterCriteriaItem read GetItem; default;
  end;

  { TcxFilterCriteriaItem }

  TcxFilterCriteriaItem = class(TcxCustomFilterCriteriaItem)
  private
    FDisplayValue: string;
    FItemLink: TObject;
    FOperator: TcxFilterOperator;
    FOperatorKind: TcxFilterOperatorKind;
    FValue: Variant;
    procedure SetDisplayValue(const Value: string);
    procedure SetOperatorKind(Value: TcxFilterOperatorKind);
    procedure SetValue(const Value: Variant);
  protected
    procedure CheckDisplayValue;
    function GetDataValue(AData: TObject): Variant; virtual; abstract;
    function GetDisplayValue: string; virtual;
    function GetExpressionValue(AIsCaption: Boolean): string; virtual;
    function GetFieldCaption: string; virtual; abstract;
    function GetFieldName: string; virtual; abstract;
    function GetFilterOperatorClass: TcxFilterOperatorClass; virtual;
    function GetItemLink: TObject; virtual;
    procedure SetItemLink(Value: TObject); virtual;
    function GetIsItemList: Boolean; override;
    procedure RecreateOperator; virtual;
    procedure ReadData(AStream: TStream); override;
    procedure WriteData(AStream: TStream); override;
  public
    constructor Create(AOwner: TcxFilterCriteriaItemList; AItemLink: TObject;
      AOperatorKind: TcxFilterOperatorKind; const AValue: Variant;
      const ADisplayValue: string); virtual;
    destructor Destroy; override;
    function IsEmpty: Boolean; override;
    function ValueIsNull(const AValue: Variant): Boolean; virtual;
    property DisplayValue: string read FDisplayValue write SetDisplayValue;
    property ItemLink: TObject read GetItemLink;
    property Operator: TcxFilterOperator read FOperator;
    property OperatorKind: TcxFilterOperatorKind read FOperatorKind write SetOperatorKind;
    property Value: Variant read FValue write SetValue;
  end;

  TcxFilterCriteriaItemClass = class of TcxFilterCriteriaItem;

  { TcxFilterValueList }

  TcxFilterValueItemKind = (fviAll, fviCustom, fviBlanks, fviNonBlanks, fviUser,
    fviValue, fviMRU, fviMRUSeparator, fviSpecial);

  TcxFilterValueItem = record
    Kind: TcxFilterValueItemKind;
    Value: Variant;
    DisplayText: string;
  end;
  PcxFilterValueItem = ^TcxFilterValueItem;

  TcxFilterValueList = class
  private
    FCriteria: TcxFilterCriteria;
    FItems: TList;
    FSortByDisplayText: Boolean;
    function GetCount: Integer;
    function GetItem(Index: Integer): PcxFilterValueItem;
    function GetMaxCount: Integer;
  protected
    function CompareItem(AIndex: Integer; const AValue: Variant; const ADisplayText: string): Integer; virtual;
    function GetMRUSeparatorIndex: Integer;
    function GetStartValueIndex: Integer;
  public
    constructor Create(ACriteria: TcxFilterCriteria); virtual;
    destructor Destroy; override;
    procedure Add(AKind: TcxFilterValueItemKind; const AValue: Variant; const ADisplayText: string; ANoSorting: Boolean); virtual;
    procedure Clear; virtual;
    procedure Delete(AIndex: Integer);
    function Find(const AValue: Variant; const ADisplayText: string; var AIndex: Integer): Boolean; virtual;
    function FindItemByKind(AKind: TcxFilterValueItemKind): Integer; overload;
    function FindItemByKind(AKind: TcxFilterValueItemKind; const AValue: Variant): Integer; overload;
    function FindItemByValue(const AValue: Variant): Integer;
    function GetIndexByCriteriaItem(ACriteriaItem: TcxFilterCriteriaItem): Integer; virtual;
    property Count: Integer read GetCount;
    property Criteria: TcxFilterCriteria read FCriteria;
    property Items[Index: Integer]: PcxFilterValueItem read GetItem; default;
    property ItemsList: TList read FItems;
    property MaxCount: Integer read GetMaxCount;
    property SortByDisplayText: Boolean read FSortByDisplayText write FSortByDisplayText;
  end;

  TcxFilterValueListClass = class of TcxFilterValueList;

  { TcxFilterCriteria }

  TcxFilterCriteriaOption = (fcoCaseInsensitive, fcoShowOperatorDescription,
    fcoSoftNull, fcoSoftCompare, fcoIgnoreNull);
  TcxFilterCriteriaOptions = set of TcxFilterCriteriaOption;

  TcxFilterCriteria = class(TPersistent)
  private
    FChanged: Boolean;
    FDateTimeFormat: string;
    FLoadedVersion: Byte;
    FLockCount: Integer;
    FMaxValueListCount: Integer;
    FOptions: TcxFilterCriteriaOptions;
    FPercentWildcard: Char;
    FRoot: TcxFilterCriteriaItemList;
    FSavedVersion: Byte;
    FSavingToStream: Boolean;
    FSupportedLike: Boolean;
    FTranslateBetween: Boolean;
    FTranslateLike: Boolean;
    FTranslateIn: Boolean;
    FUnderscoreWildcard: Char;
    FVersion: Byte;
    FOnChanged: TNotifyEvent;
    function GetOptions: TcxFilterCriteriaOptions;
    function GetStoreItemLinkNames: Boolean;
    procedure SetDateTimeFormat(const Value: string);
    procedure SetOptions(Value: TcxFilterCriteriaOptions);
    procedure SetPercentWildcard(Value: Char);
    procedure SetStoreItemLinkNames(Value: Boolean);
    procedure SetUnderscoreWildcard(Value: Char);
  protected
    procedure CheckChanges; virtual;
    function ConvertBoolToStr(const AValue: Variant): string; virtual;
    function ConvertDateToStr(const AValue: Variant): string; virtual;
    function DoFilterData(AData: TObject): Boolean;
    procedure FormatFilterTextValue(AItem: TcxFilterCriteriaItem; const AValue: Variant;
      var ADisplayValue: string); virtual;
    function GetFilterCaption: string; virtual;
    function GetFilterExpression(AIsCaption: Boolean): string; virtual;
    function GetFilterText: string; virtual;
    function GetIDByItemLink(AItemLink: TObject): Integer; virtual; abstract;
    function GetNameByItemLink(AItemLink: TObject): string; virtual; abstract;
    function GetItemClass: TcxFilterCriteriaItemClass; virtual;
    function GetItemListClass: TcxFilterCriteriaItemListClass; virtual;
    function GetItemExpression(AItem: TcxFilterCriteriaItem; AIsCaption: Boolean): string; virtual;
    function GetItemExpressionFieldName(AItem: TcxFilterCriteriaItem; AIsCaption: Boolean): string; virtual;
    function GetItemExpressionOperator(AItem: TcxFilterCriteriaItem; AIsCaption: Boolean): string; virtual;
    function GetItemExpressionValue(AItem: TcxFilterCriteriaItem; AIsCaption: Boolean): string; virtual;
    function GetItemLinkByID(AID: Integer): TObject; virtual; abstract;
    function GetItemLinkByName(const AName: string): TObject; virtual; abstract;
    function GetValueListClass: TcxFilterValueListClass; virtual;
    function IsStore: Boolean;
    procedure Prepare; virtual;
    function PrepareValue(AValue: Variant): Variant; virtual;
    procedure SetFilterText(const Value: string); virtual;
    procedure Update; virtual;

    property LoadedVersion: Byte read FLoadedVersion;
    property LockCount: Integer read FLockCount;
    property SavedVersion: Byte read FSavedVersion;
    property Version: Byte read FVersion write FVersion;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent; AIgnoreItemNames: Boolean = False); reintroduce; virtual;
    procedure AssignEvents(Source: TPersistent); virtual;
    procedure AssignItems(ASource: TcxFilterCriteria; AIgnoreItemNames: Boolean = False); virtual;
    function AddItem(AParent: TcxFilterCriteriaItemList; AItemLink: TObject;
      AOperatorKind: TcxFilterOperatorKind; const AValue: Variant;
      const ADisplayValue: string): TcxFilterCriteriaItem; virtual;
    procedure BeginUpdate;
    procedure CancelUpdate;
    procedure Clear;
    procedure Changed; virtual;
    procedure EndUpdate;
    function EqualItems(AFilterCriteria: TcxFilterCriteria; AIgnoreItemNames: Boolean = False): Boolean;
    function FindItemByItemLink(AItemLink: TObject): TcxFilterCriteriaItem; virtual;
    function IsEmpty: Boolean; virtual;
    procedure LoadFromStream(AStream: TStream); virtual;
    procedure Refresh;
    procedure RemoveItemByItemLink(AItemLink: TObject);
    procedure RestoreDefaults; virtual;
    procedure SaveToStream(AStream: TStream); virtual;
    function ValueIsNull(const AValue: Variant): Boolean; virtual;
    // internal
    procedure ReadData(AStream: TStream); virtual;
    procedure WriteData(AStream: TStream); overload;
    procedure WriteData(AStream: TStream; AVersion: Byte); overload; virtual;

    property DateTimeFormat: string read FDateTimeFormat write SetDateTimeFormat;
    property FilterCaption: string read GetFilterCaption;
    property FilterText: string read GetFilterText write SetFilterText;
    property Root: TcxFilterCriteriaItemList read FRoot;
    property StoreItemLinkNames: Boolean read GetStoreItemLinkNames write SetStoreItemLinkNames;
    property SupportedLike: Boolean read FSupportedLike write FSupportedLike default True;
    property TranslateBetween: Boolean read FTranslateBetween write FTranslateBetween default False;
    property TranslateIn: Boolean read FTranslateIn write FTranslateIn default False;
    property TranslateLike: Boolean read FTranslateLike write FTranslateLike default False;
  published
    property MaxValueListCount: Integer read FMaxValueListCount write FMaxValueListCount default 0;
    property Options: TcxFilterCriteriaOptions read GetOptions write SetOptions default [];
    property PercentWildcard: Char read FPercentWildcard write SetPercentWildcard default '%';
    property UnderscoreWildcard: Char read FUnderscoreWildcard write SetUnderscoreWildcard default '_';
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  end;

function ExtractFilterDisplayValue(const AValues: string; var Pos: Integer): string;

//function StrToVarBetweenArray(const AValue: string): Variant;
//function StrToVarListArray(const AValue: string): Variant;

function VarBetweenArrayToStr(const AValue: Variant): string;
function VarListArrayToStr(const AValue: Variant): string;

var
  cxFilterIncludeTodayInLastNextDaysList: Boolean = True;

implementation

uses
  {$IFDEF DELPHI9}Windows, {$ENDIF}
  SysUtils, Math,
  {$IFDEF DELPHI6}RTLConsts, SqlTimSt,{$ENDIF}
  cxVariants, cxLike, cxFilterConsts, cxDataUtils;

const
  cxFilterNullDate = 0;  // it is safe because we do not use such past dates for the property values

type
  TFilterWrapper = class(TComponent)
  private
    FFilter: TcxFilterCriteria;
  published
    property Filter: TcxFilterCriteria read FFilter write FFilter;
  end;

function FilterVarToStr(const AValue: Variant): string;
begin
  if VarIsNull(AValue) then
    Result := cxSFilterString(@cxSFilterBlankCaption)
  else
    Result := VarToStr(AValue);
end;

function ExtractFilterDisplayValue(const AValues: string; var Pos: Integer): string;
var
  I: Integer;
begin
  I := Pos;
  while (I <= Length(AValues)) and (AValues[I] <> ';') do Inc(I);
  Result := Trim(Copy(AValues, Pos, I - Pos));
  if (I <= Length(AValues)) and (AValues[I] = ';') then Inc(I);
  Pos := I;
end;

function StrToVarBetweenArray(const AValue: string): Variant;
var
  APos: Integer;
  S1, S2: string;
begin
  S1 := '';
  S2 := '';
  APos := 1;
  S1 := ExtractFilterDisplayValue(AValue, APos);
  if APos <= Length(AValue) then
    S2 := ExtractFilterDisplayValue(AValue, APos);
  Result := VarBetweenArrayCreate(S1, S2);  
end;

function StrToVarListArray(const AValue: string): Variant;
var
  AEmpty: Boolean;
  APos: Integer;
  S: string;
begin
  AEmpty := True;
  Result := '';
  APos := 1;
  while APos <= Length(AValue) do
  begin
    S := ExtractFilterDisplayValue(AValue, APos);
    if AEmpty then
    begin
      Result := VarListArrayCreate(S);
      AEmpty := False;
    end
    else
      VarListArrayAddValue(Result, S);
  end;
end;

function StreamsEqual(AStream1, AStream2: TMemoryStream): Boolean;
begin
  Result := (AStream1.Size = AStream2.Size) and
    CompareMem(AStream1.Memory, AStream2.Memory, AStream1.Size);
end;

function VarBetweenArrayToStr(const AValue: Variant): string;
begin
  Result := FilterVarToStr(AValue[0]) + ' ' +
    cxSFilterString(@cxSFilterAndCaption) + ' ' + FilterVarToStr(AValue[1]);
end;

function VarListArrayToStr(const AValue: Variant): string;
var
  I: Integer;
begin
  Result := '(' + FilterVarToStr(AValue[0]);
  for I := VarArrayLowBound(AValue, 1) + 1 to VarArrayHighBound(AValue, 1) do
    Result := Result + ', ' + FilterVarToStr(AValue[I]);
  Result := Result + ')';
end;

{ TcxFilterOperator }

constructor TcxFilterOperator.Create(ACriteriaItem: TcxFilterCriteriaItem);
begin
  inherited Create;
  FCriteriaItem := ACriteriaItem;
end;

function TcxFilterOperator.DisplayText: string;
begin
  Result := FilterText;
end;

function TcxFilterOperator.IsDescription: Boolean;
begin
  Result := False;
end;

function TcxFilterOperator.IsExpression: Boolean;
begin
  Result := False;
end;

function TcxFilterOperator.IsNullOperator: Boolean; 
begin
  Result := False;
end;

function TcxFilterOperator.GetExpressionFilterText(const AValue: Variant): string;
begin
  Result := GetExpressionValue(AValue);
end;

function TcxFilterOperator.GetExpressionValue(const AValue: Variant): string;
var
  AVarType: Integer;
begin
  if not PrepareExpressionValue(AValue, Result) then
  begin
    AVarType := VarType(AValue);
    if (AVarType = varString) or (AVarType = varOleStr) then // <- VarTypeIsStr()
      Result := QuotedStr(VarToStr(AValue))
    else
      if (AVarType = varDate) {$IFDEF DELPHI6} or (AVarType = VarSQLTimeStamp) {$ENDIF} then
        Result := '''' + CriteriaItem.Criteria.ConvertDateToStr(AValue) + ''''
      else
        if AVarType = varBoolean then
          Result := CriteriaItem.Criteria.ConvertBoolToStr(AValue)
        else
          if AVarType = varNull then
            Result := 'NULL'
          else
            Result := VarToStr(AValue);
    CriteriaItem.Criteria.FormatFilterTextValue(CriteriaItem, AValue, Result);
  end;
end;

procedure TcxFilterOperator.PrepareDisplayValue(var DisplayValue: string);
begin
end;

procedure TcxFilterOperator.Prepare;
begin
end;

function TcxFilterOperator.PrepareExpressionValue(const AValue: Variant; var DisplayValue: string): Boolean;
begin
  Result := False;
end;

{ TcxFilterEqualOperator }

function TcxFilterEqualOperator.CompareValues(const AValue1, AValue2: Variant): Boolean;