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 + -
显示快捷键?