cxdbfiltercontrol.pas

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

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressFilterControl                                         }
{                                                                    }
{       Copyright (c) 1998-2008 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSEDITORS AND ALL                }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}
unit cxDBFilterControl;

{$I cxVer.inc}

interface

uses
  Classes, Graphics, cxEdit, cxFilter, cxDataStorage, cxLookAndFeels,
  cxFilterControl, cxFilterControlUtils, DB;

type
  TcxDBFilterControl = class;

  { TcxFilterItem }

  TcxFilterItem = class(TCollectionItem, IUnknown,  IcxEditRepositoryItemListener)
  private
    FOwnerInterface: IUnknown;
    FFilterControl: TcxDBFilterControl;
    FCaption: string;
    FFieldName: string;
    FProperties: TcxCustomEditProperties;
    FRepositoryItem: TcxEditRepositoryItem;
    FPropertiesClass: TcxCustomEditPropertiesClass;
    procedure DoPropertiesChanged(Sender: TObject);
    function GetPropertiesClassName: string;
    function IsCaptionStored: Boolean;
    procedure RecreateProperties;
    procedure SetCaption(const Value: string);
    procedure SetFieldName(const Value: string);
    procedure SetProperties(const Value: TcxCustomEditProperties);
    procedure SetPropertiesClass(const Value: TcxCustomEditPropertiesClass);
    procedure SetPropertiesClassName(const Value: string);
    procedure SetRepositoryItem(const Value: TcxEditRepositoryItem);
  protected
    // IUnknown
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
    // IcxEditRepositoryItemListener
    procedure ItemRemoved(Sender: TcxEditRepositoryItem);
    procedure PropertiesChanged(Sender: TcxEditRepositoryItem);
    // overrided methods
    function GetDisplayName: string; override;
    procedure CreateProperties; virtual;
    procedure DestroyProperties; virtual;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    function GetProperties: TcxCustomEditProperties;

    property FilterControl: TcxDBFilterControl read FFilterControl;
    property PropertiesClass: TcxCustomEditPropertiesClass read FPropertiesClass write SetPropertiesClass;
  published
    property Caption: string read FCaption write SetCaption stored IsCaptionStored;
    property FieldName: string read FFieldName write SetFieldName;
    property PropertiesClassName: string read GetPropertiesClassName write SetPropertiesClassName;
    property Properties: TcxCustomEditProperties read FProperties write SetProperties;
    property RepositoryItem: TcxEditRepositoryItem read FRepositoryItem write SetRepositoryItem;
  end;

  { TcxFilterPropertiesList }

  TcxFilterPropertiesList = class(TList)
  public
    procedure Clear; override;
    function GetProperties(AClass: TcxCustomEditPropertiesClass): TcxCustomEditProperties;
  end;

  { TcxFilterItemCollection }

  TcxFilterItemCollection = class(TOwnedCollection)
  private
    function GetControl: TcxDBFilterControl;
    function GetItems(Index: Integer): TcxFilterItem;
    procedure SetItems(Index: Integer; const Value: TcxFilterItem);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    property Control: TcxDBFilterControl read GetControl;
    property Items[Index: Integer]: TcxFilterItem read GetItems write SetItems; default;
  end;

  { TcxDBFilterOptions }

  TcxDBFilterOptions = class(TPersistent)
  private
    FFilterControl: TcxDBFilterControl;
    FSupportedBetween: Boolean;
    FSupportedIn: Boolean;
    FSupportedLike: Boolean;
    function GetDateTimeFormat: string;
    function GetPercentWildcard: Char;
    function GetSoftNull: Boolean;
    function GetTranslateBetween: Boolean;
    function GetTranslateIn: Boolean;
    function GetTranslateLike: Boolean;
    function GetUnderscoreWildcard: Char;
    procedure SetDateTimeFormat(const Value: string);
    procedure SetPercentWildcard(Value: Char);
    procedure SetSoftNull(Value: Boolean);
    procedure SetTranslateBetween(Value: Boolean);
    procedure SetTranslateIn(Value: Boolean);
    procedure SetTranslateLike(Value: Boolean);
    procedure SetUnderscoreWildcard(Value: Char);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AFilterControl: TcxDBFilterControl); virtual;
    procedure Assign(Source: TPersistent); override;
    procedure ProcessFilterOperators(var SupportedOperations: TcxFilterControlOperators);
  published
    property DateTimeFormat: string read GetDateTimeFormat write SetDateTimeFormat;
    property PercentWildcard: Char read GetPercentWildcard write SetPercentWildcard default '%';
    property SoftNull: Boolean read GetSoftNull write SetSoftNull default False;
    property SupportedBetween: Boolean read FSupportedBetween write FSupportedBetween default True;
    property SupportedIn: Boolean read FSupportedIn write FSupportedIn default True;
    property SupportedLike: Boolean read FSupportedLike write FSupportedLike default True;
    property TranslateBetween: Boolean read GetTranslateBetween write SetTranslateBetween default False;
    property TranslateIn: Boolean read GetTranslateIn write SetTranslateIn default False;
    property TranslateLike: Boolean read GetTranslateLike write SetTranslateLike default False;
    property UnderscoreWildcard: Char read GetUnderscoreWildcard write SetUnderscoreWildcard default '_';
  end;

  { TcxDBFilterControl }

  TcxDBFilterControl = class(TcxCustomFilterControl, IcxFilterControl,
    IcxFilterControlDialog)
  private
    FApplyingFilter: Boolean;
    FDataSource: TDataSource;
    FDataSet: TDataSet;
    FFieldNamePostfix: string;
    FFieldNamePrefix: string;
    FFieldsProperties: TcxFilterPropertiesList;
    FFilterOptions: TcxDBFilterOptions;
    FItems: TcxFilterItemCollection;
  {$IFDEF CBUILDER6}
    function GetDataSet: TDataSet;
    function GetItems: TcxFilterItemCollection;
  {$ENDIF}
    function GetField(AIndex: Integer): TField;
    function GetFilterOptions: TcxDBFilterOptions;
    procedure DataSetStateChange(Sender: TObject);
    procedure SetDataSet(const Value: TDataSet);
    procedure SetFilterOptions(Value: TcxDBFilterOptions);
    procedure SetItems(Value: TcxFilterItemCollection);
  protected
    // IcxFilterControl
    function GetCaption(Index: Integer): string;
    function GetCount: Integer;
    function GetCriteria: TcxFilterCriteria;
    function GetItemLink(Index: Integer): TObject;
    function GetItemLinkID(Index: Integer): Integer;
    function GetItemLinkName(Index: Integer): string;
    function GetFieldName(Index: Integer): string;
    function GetProperties(Index: Integer): TcxCustomEditProperties;
    function GetValueType(Index: Integer): TcxValueTypeClass;
    //IcxFilterControlDialog
    procedure SetDialogLinkComponent(ALink: TComponent);
    // overrided VCL
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    // overrided TcxCustomFilterControl
    procedure CorrectOperatorClass(var AOperatorClass: TcxFilterOperatorClass); override;
    procedure DoApplyFilter; override;
    procedure ValidateConditions(var SupportedOperations: TcxFilterControlOperators); override;
    function GetFilterLink: IcxFilterControl; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BuildFromCriteria; override;
    procedure Clear; override;
    function GetFilterTextEx(const AFieldNamePrefix, AFieldNamePostfix: string): string;
    function GetPropertiesClassFromFieldType(AFieldType: TFieldType): TcxCustomEditPropertiesClass; virtual;

    property Criteria;
    property DataSource: TDataSource read FDataSource;
  published
    property Align;
    property Anchors;
    property Color;
  {$IFDEF CBUILDER6}
    property DataSet: TDataSet read GetDataSet write SetDataSet;
    property Items: TcxFilterItemCollection read GetItems write SetItems;
  {$ELSE}
    property DataSet: TDataSet read FDataSet write SetDataSet;
    property Items: TcxFilterItemCollection read FItems write SetItems;
  {$ENDIF}
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FilterOptions: TcxDBFilterOptions read GetFilterOptions write SetFilterOptions;
    property Font;
    property FontBoolOperator;
    property FontCondition;
    property FontItem;
    property FontValue;
    property HelpContext;
  {$IFDEF DELPHI6}
    property HelpKeyword;
    property HelpType;
  {$ENDIF}
    property Hint;
    property HotTrackOnUnfocused;
    property LookAndFeel;
    property NullString;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property ShowLevelLines;
    property SortItems;
    property TabOrder;
    property TabStop;
    property Visible;
    property WantTabs;
    property OnApplyFilter;
    property OnClick;
  {$IFDEF DELPHI5}
    property OnContextPopup;
  {$ENDIF}
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

function ExecuteDBFilterControlDialog(ADataSet: TDataSet;
  ALookAndFeel: TcxLookAndFeel; AOnApplyProc: TNotifyEvent = nil;
  AOnShowDialog: TNotifyEvent = nil; AColor: TColor = clDefault;
  const AInitialDir: string = ''): Boolean;
  
implementation

uses
  SysUtils, cxDBFilter, cxDBData, cxCalc, cxCalendar, cxTextEdit,
{$IFNDEF DELPHI5}
  cxClasses,
{$ENDIF}
  cxSpinEdit, cxCheckBox, cxCurrencyEdit, cxTimeEdit, cxFilterControlDialog;

function ExecuteDBFilterControlDialog(ADataSet: TDataSet;
  ALookAndFeel: TcxLookAndFeel; AOnApplyProc: TNotifyEvent = nil;
  AOnShowDialog: TNotifyEvent = nil; AColor: TColor = clDefault;
  const AInitialDir: string = ''): Boolean;
begin
  Result := cxInternalExecuteFilterControlDialog(TcxDBFilterControl, ADataSet,
    ALookAndFeel, AOnApplyProc, AOnShowDialog, AColor, AInitialDir);
end;

{ TcxFilterItem }

constructor TcxFilterItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FFilterControl := TcxFilterItemCollection(Collection).Control;
end;

destructor TcxFilterItem.Destroy;
begin
  RepositoryItem := nil;
  DestroyProperties;
  inherited Destroy;
end;

procedure TcxFilterItem.AfterConstruction;
begin
  inherited;
  if GetOwner <> nil then
    GetOwner.GetInterface(IUnknown, FOwnerInterface);
end;

function TcxFilterItem.GetProperties: TcxCustomEditProperties;
begin
  if FRepositoryItem = nil then
    Result := FProperties
  else
    Result := FRepositoryItem.Properties;
end;

function TcxFilterItem._AddRef: Integer;
begin
  if FOwnerInterface <> nil then
    Result := FOwnerInterface._AddRef
  else
    Result := -1;
end;

function TcxFilterItem._Release: Integer;
begin
  if FOwnerInterface <> nil then
    Result := FOwnerInterface._Release
  else
    Result := -1;
end;

function TcxFilterItem.QueryInterface(const IID: TGUID; out Obj): HResult;
const
  E_NOINTERFACE = HResult($80004002);
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

procedure TcxFilterItem.ItemRemoved(Sender: TcxEditRepositoryItem);
begin
  RepositoryItem := nil;
  PropertiesChanged(Sender);
end;

procedure TcxFilterItem.PropertiesChanged(Sender: TcxEditRepositoryItem);
begin
  with FilterControl do
    if (ComponentState * [csLoading, csDestroying, csDesigning]) = [] then
      RefreshProperties;
end;

function TcxFilterItem.GetDisplayName: string;
begin
  if FCaption <> '' then
    Result := FCaption
  else
    if FieldName <> '' then
      Result := FieldName
    else
      if GetProperties <> nil then
        Result := GetProperties.ClassName
      else
        Result := ClassName
end;

procedure TcxFilterItem.CreateProperties;
begin
  if FPropertiesClass <> nil then
  begin
    FProperties := FPropertiesClass.Create(Self);
    FProperties.OnPropertiesChanged := DoPropertiesChanged;
  end;
end;

procedure TcxFilterItem.DestroyProperties;
begin
  FreeAndNil(FProperties);
end;

procedure TcxFilterItem.DoPropertiesChanged(Sender: TObject);
begin
  PropertiesChanged(nil);
end;

function TcxFilterItem.GetPropertiesClassName: string;
begin
  if FProperties = nil then
    Result := ''
  else
    Result := FProperties.ClassName;
end;

function TcxFilterItem.IsCaptionStored: Boolean;
begin
  Result := (FCaption <> '') and (FCaption <> FFieldName);
end;

procedure TcxFilterItem.RecreateProperties;
begin
  DestroyProperties;
  CreateProperties;
end;

procedure TcxFilterItem.SetCaption(const Value: string);
begin
  if FCaption <> Value then
  begin
    FCaption := Value;
    Changed(False);
  end;
end;

procedure TcxFilterItem.SetFieldName(const Value: string);
begin
  if FFieldName <> Value then
  begin
    if FFieldName = FCaption then
      FCaption := Value;
    FFieldName := Value;
    Changed(False);
  end;
end;

procedure TcxFilterItem.SetProperties(const Value: TcxCustomEditProperties);
begin
  if (Value <> nil) and (esoFiltering in Value.GetSupportedOperations) then
    FProperties.Assign(Value);
end;

procedure TcxFilterItem.SetPropertiesClass(
  const Value: TcxCustomEditPropertiesClass);
begin
  if (FPropertiesClass <> Value) and ((Value = nil) or IsSupportFiltering(Value)) then
  begin
    FPropertiesClass := Value;
    RecreateProperties;
    PropertiesChanged(nil);
  end;
end;

procedure TcxFilterItem.SetPropertiesClassName(const Value: string);
var
  APropertiesClass: TcxCustomEditPropertiesClass;
begin
  APropertiesClass :=
    TcxCustomEditPropertiesClass(GetRegisteredEditProperties.FindByClassName(Value));
  if (APropertiesClass = nil) or IsSupportFiltering(APropertiesClass) then
    PropertiesClass := APropertiesClass;
end;

procedure TcxFilterItem.SetRepositoryItem(
  const Value: TcxEditRepositoryItem);
begin
  if FRepositoryItem <> Value then
  begin
    if (Value <> nil) and
      not (esoFiltering in Value.Properties.GetSupportedOperations) then Exit;
    if FRepositoryItem <> nil then
      FRepositoryItem.RemoveListener(Self);
    FRepositoryItem := Value;
    if FRepositoryItem <> nil then
      FRepositoryItem.AddListener(Self);
    PropertiesChanged(nil);