cxfiltercontrol.pas

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

PAS
2,067
字号
    procedure InitControl; override;
    procedure InitScrollBarsParameters; override;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel; AChangedValues: TcxLookAndFeelValues); override;
    procedure MouseEnter(AControl: TControl); override;
    procedure MouseLeave(AControl: TControl); override;
    procedure Scroll(AScrollBarKind: TScrollBarKind; AScrollCode: TScrollCode;
      var AScrollPos: Integer); override;
    // work with rows
    procedure AddCondition(ARow: TcxCustomRowViewInfo);
    procedure AddGroup;
    procedure AddValue;
    procedure ClearRows;
    procedure Remove;
    procedure RemoveRow;
    procedure RemoveValue;
    // navigation
    procedure FocusNext(ATab: Boolean);
    procedure FocusPrev(ATab: Boolean);
    procedure FocusUp(ATab: Boolean);
    procedure FocusDown(ATab: Boolean);
    procedure RowNavigate(AElement: TcxFilterControlHitTest; ACellIndex: Integer = -1);
    procedure ValueEditorHide(AAccept: Boolean);

    procedure EnsureRowVisible;
    procedure RefreshProperties;

    procedure BuildFromCriteria; virtual;
    procedure BuildFromRows;

    procedure CreateInternalControls; virtual;
    procedure DestroyInternalControls; virtual;
    procedure DoApplyFilter; virtual;
    function GetDefaultProperties: TcxCustomEditProperties; virtual;
    function GetDefaultPropertiesViewInfo: TcxCustomEditViewInfo;
    function GetFilterControlCriteriaClass: TcxFilterControlCriteriaClass; virtual;
    function GetViewInfoClass: TcxFilterControlViewInfoClass; virtual;
    function HasFocus: Boolean;
    function HasHotTrack: Boolean;
    procedure FillFilterItemList(AStrings: TStrings); virtual;
    procedure FillConditionList(AStrings: TStrings); virtual;
    procedure ValidateConditions(var SupportedOperations: TcxFilterControlOperators); virtual;

    procedure CorrectOperatorClass(var AOperatorClass: TcxFilterOperatorClass); virtual;
    function GetFilterCaption: string; virtual;
    function GetFilterLink: IcxFilterControl; virtual;
    function GetFilterText: string; virtual;
    procedure SelectAction; virtual;
    procedure SelectBoolOperator; virtual;
    procedure SelectCondition; virtual;
    procedure SelectItem; virtual;
    procedure SelectValue(AActivateKind: TcxActivateValueEditKind; AKey: Char); virtual;

    // IcxMouseTrackingCaller
    procedure DoMouseLeave;
    procedure IcxMouseTrackingCaller.MouseLeave = DoMouseLeave;

    // IcxFormatContollerListener
    procedure FormatChanged;

    property Criteria: TcxFilterControlCriteria read FCriteria;
    property FilterLink: IcxFilterControl read GetFilterLink;
    property FocusedInfo: TcxFilterControlHitTestInfo read FFocusedInfo;
    property FocusedRow: TcxCustomRowViewInfo read GetFocusedRow write SetFocusedRow;
    property LeftOffset: Integer read FLeftOffset write SetLeftOffset;
    property NullString: string read FNullString write SetNullString stored IsNullStringStored;
    property RowCount: Integer read GetRowCount;
    property Rows[Index: Integer]: TcxCustomRowViewInfo read GetRow;
    property State: TFilterControlState read FState write FState;
    property TopVisibleRow: Integer read FTopVisibleRow write SetTopVisibleRow;
    property ViewInfo: TcxFilterControlViewInfo read FViewInfo;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ApplyFilter;
    procedure BeginUpdate;
    procedure Clear; virtual;
    procedure EndUpdate;
    function IsValid: Boolean; virtual;
    function HasItems: Boolean;
    procedure LayoutChanged;
    procedure Localize;
    // save & restore
    procedure LoadFromStream(AStream: TStream);
    procedure SaveToStream(AStream: TStream);
    procedure LoadFromFile(const AFileName: string);
    procedure SaveToFile(const AFileName: string);

    // properties
    property Color default clBtnFace;
    property FilterCaption: string read GetFilterCaption;
    property FilterText: string read GetFilterText;
    property FontBoolOperator: TFont index fcfBoolOperator read GetFont write SetFont stored IsFontStored;
    property FontCondition: TFont index fcfCondition read GetFont write SetFont stored IsFontStored;
    property FontItem: TFont index fcfItem read GetFont write SetFont stored IsFontStored;
    property FontValue: TFont index fcfValue read GetFont write SetFont stored IsFontStored;
    property HotTrackOnUnfocused: Boolean read FHotTrackOnUnfocused write FHotTrackOnUnfocused default True;
    property LookAndFeel;
    property ParentColor default False;
    property ShowLevelLines: Boolean read FShowLevelLines write SetShowLevelLines default True;
    property SortItems: Boolean read FSortItems write FSortItems default False;
    property WantTabs: Boolean read FWantTabs write SetWantTabs default False;
    property OnApplyFilter: TNotifyEvent read FOnApplyFilter write FOnApplyFilter;
  end;

  { TcxFilterControlPainter }

  TcxFilterControlPainter = class
  private
    FControl: TcxCustomFilterControl;
    function GetCanvas: TcxCanvas;
    function GetPainter: TcxCustomLookAndFeelPainterClass;
    function GetViewInfo: TcxFilterControlViewInfo;
    procedure DrawGroup(ARow: TcxGroupViewInfo);
    procedure DrawCondition(ARow: TcxConditionViewInfo);
    procedure DrawValues(ARow: TcxConditionViewInfo);
  protected
    function GetContentColor: TColor; virtual;
    procedure DrawBorder;
    procedure DrawDotLine(const R: TRect);
    procedure DrawRow(ARow: TcxCustomRowViewInfo); virtual;
    procedure TextDraw(X, Y: Integer; const AText: string);
  public
    constructor Create(AOwner: TcxCustomFilterControl); virtual;
    property Canvas: TcxCanvas read GetCanvas;
    property ContentColor: TColor read GetContentColor;
    property Control: TcxCustomFilterControl read FControl;
    property Painter: TcxCustomLookAndFeelPainterClass read GetPainter;
    property ViewInfo: TcxFilterControlViewInfo read GetViewInfo;
  end;

  TcxFilterControlPainterClass = class of TcxFilterControlPainter;

  { TcxFilterControlViewInfo }

  TcxFilterControlViewInfo = class
  private
    FControl: TcxCustomFilterControl;
    FAddConditionRect: TRect;
    FAddConditionCaption: string;
    FBitmap: TBitmap;
    FBitmapCanvas: TcxCanvas;
    FButtonState: TcxButtonState;
    FFocusRect: TRect;
    FMaxRowWidth: Integer;
    FPainter: TcxFilterControlPainter;
    FRowHeight: Integer;
    FMinValueWidth: Integer;
    FEnabled: Boolean;
    procedure CalcButtonState;
    procedure CheckBitmap;
    function GetCanvas: TcxCanvas;
    function GetEditHeight: Integer;
  protected
    procedure CalcFocusRect; virtual;
    function GetPainterClass: TcxFilterControlPainterClass; virtual;
  public
    constructor Create(AOwner: TcxCustomFilterControl); virtual;
    destructor Destroy; override;
    procedure Calc;
    procedure GetHitTestInfo(AShift: TShiftState; const P: TPoint;
      var HitInfo: TcxFilterControlHitTestInfo); virtual;
    procedure Paint;
    procedure InvalidateRow(ARow: TcxCustomRowViewInfo);
    procedure Update;
    property AddConditionCaption: string read FAddConditionCaption;
    property AddConditionRect: TRect read FAddConditionRect;
    property ButtonState: TcxButtonState read FButtonState;
    property Canvas: TcxCanvas read GetCanvas;
    property Control: TcxCustomFilterControl read FControl;
    property Enabled: Boolean read FEnabled;
    property MaxRowWidth: Integer read FMaxRowWidth;
    property MinValueWidth: Integer read FMinValueWidth;
    property Painter: TcxFilterControlPainter read FPainter;
    property RowHeight: Integer read FRowHeight;
  end;

  { TcxFilterControl }

  TcxFilterControl = class(TcxCustomFilterControl, IcxFilterControlDialog)
  private
    FLinkComponent: TComponent;
  {$IFDEF CBUILDER6}
    function GetLinkComponent: TComponent;
  {$ENDIF}
    procedure SetLinkComponent(Value: TComponent);
  protected
    //IcxFilterControlDialog
    procedure IcxFilterControlDialog.SetDialogLinkComponent = SetLinkComponent;
    function GetFilterLink: IcxFilterControl; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public  
    procedure UpdateFilter;
  published
    property Align;
    property Anchors;
    property Color;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property FontBoolOperator;
    property FontCondition;
    property FontItem;
    property FontValue;
    property HelpContext;
  {$IFDEF DELPHI6}
    property HelpKeyword;
    property HelpType;
  {$ENDIF}
    property Hint;
    property HotTrackOnUnfocused;
  {$IFDEF CBUILDER6}
    property LinkComponent: TComponent read GetLinkComponent write SetLinkComponent;
  {$ELSE}
    property LinkComponent: TComponent read FLinkComponent write SetLinkComponent;
  {$ENDIF}
    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 cxGetConditionText(AOperator: TcxFilterControlOperator): string;
function IsSupportFiltering(AClass: TcxCustomEditPropertiesClass): Boolean;

implementation

uses
  cxVariants, cxFilterConsts, cxFilterControlStrs, cxCustomData;

type
  TWinControlAccess = class(TWinControl);

const
  cxFilterControlFontColors: array[TcxFilterControlFont] of TColor = (clRed,
    clGreen, clMaroon, clBlue);

  EmptyRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);

var
  cxBoolOperatorText: array[TcxFilterBoolOperatorKind] of string;
  cxConditionText: array[TcxFilterControlOperator] of string;
  HalftoneBrush: HBRUSH;

function cxGetConditionText(AOperator: TcxFilterControlOperator): string;
begin
  Result := cxConditionText[AOperator];
end;

function IsSupportFiltering(AClass: TcxCustomEditPropertiesClass): Boolean;
var
  Test: TcxCustomEditProperties;
begin
  Result := False;
  if AClass <> nil then
  begin
    Test := AClass.Create(nil);
    Result := esoFiltering in Test.GetSupportedOperations;
    Test.Free;
  end;
end;

function Max(A, B: Integer): Integer;
begin
  if A > B then Result := A else Result := B;
end;

function Min(A, B: Integer): Integer;
begin
  if A < B then Result := A else Result := B;
end;

function WidthOf(const R: TRect): Integer;
begin
  Result := R.Right - R.Left;
end;

function HeightOf(const R: TRect): Integer;
begin
  Result := R.Bottom - R.Top;
end;
procedure CenterRectVert(const ABounds: TRect; var R: TRect);
var
  H1, H2: Integer;
begin
  H1 := HeightOf(ABounds);
  H2 := HeightOf(R);
  OffsetRect(R, 0, (ABounds.Top - R.Top) + (H1 - H2) div 2);
end;

function cxStrFromBoolOperator(ABoolOperator: TcxFilterBoolOperatorKind): string;
begin
  case ABoolOperator of
    fboAnd: Result := cxGetResourceString(@cxSFilterBoolOperatorAnd);
    fboOr: Result := cxGetResourceString(@cxSFilterBoolOperatorOr);
    fboNotAnd: Result := cxGetResourceString(@cxSFilterBoolOperatorNotAnd);
    fboNotOr: Result := cxGetResourceString(@cxSFilterBoolOperatorNotOr);
  else
    Result := '';
  end;
end;

{ TcxFilterControlCriteriaItem }

function TcxFilterControlCriteriaItem.GetDataValue(
  AData: TObject): Variant;
begin
  Result := Null;
end;

function TcxFilterControlCriteriaItem.GetFieldCaption: string;
begin
  if ValidItem then
    Result := Filter.Captions[ItemIndex]
  else
    Result := '';
end;

function TcxFilterControlCriteriaItem.GetFieldName: string;
begin
  if ValidItem then
    Result := Filter.FieldNames[ItemIndex]
  else
    Result := '';
end;

function TcxFilterControlCriteriaItem.GetFilterOperatorClass: TcxFilterOperatorClass;
begin
  Result := inherited GetFilterOperatorClass;
  Criteria.Control.CorrectOperatorClass(Result);
end;

function TcxFilterControlCriteriaItem.GetFilter: IcxFilterControl;
begin
  if (Criteria <> nil) and (Criteria.Control <> nil) then
    Result := Criteria.Control.FilterLink
  else
    Result := nil;
end;

function TcxFilterControlCriteriaItem.GetItemIndex: Integer;
var
  I: Integer;
  AFilter: IcxFilterControl;
begin
  Result := -1;
  AFilter := Filter;
  if AFilter <> nil then
  begin
    for I := 0 to AFilter.Count - 1 do
      if AFilter.ItemLinks[I] = ItemLink then
      begin
        Result := I;
        break;
      end;
  end;
end;

function TcxFilterControlCriteriaItem.ValidItem: Boolean;
begin
  Result := (Filter <> nil) and (ItemIndex >= 0) and (ItemIndex < Filter.Count);
end;

function TcxFilterControlCriteriaItem.GetFilterControlCriteria: TcxFilterControlCriteria;
begin
  Result := TcxFilterControlCriteria(inherited Criteria);
end;

{ TcxFilterControlCriteria }

constructor TcxFilterControlCriteria.Create(
  AOwner: TcxCustomFilterControl);
begin
  inherited Create;
  FControl := AOwner;
  //ver 3
  Version := cxDataFilterVersion;
end;

procedure TcxFilterControlCriteria.AssignEvents(Source: TPersistent);
begin
//don't assign events
end;

function TcxFilterControlCriteria.GetIDByItemLink(

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?