unit uKMListViewFilter;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, EditBtn, ComCtrls, FGL, LCLStrConsts;
type
TKMListViewFilterCustomMatch = Function (SearchString : String; MatchAll : Boolean = false; CaseSensitive: Boolean = true) : Boolean of Object;
{ TKMListViewFilterEntry }
TKMListViewFilterEntry = Class
private
FItems : TStringList;
FStateIndex : Integer;
FData : Pointer;
FCustomMatch : TKMListViewFilterCustomMatch;
public
constructor Create;
destructor Destroy; override;
function Match (SearchString : String; MatchAll : Boolean = false; CaseSensitive: Boolean = true) : Boolean;
property Items : TStringList read FItems;
property StateIndex : Integer read FStateIndex write FStateIndex;
property Data : Pointer read FData write FData;
property CustomMatch : TKMListViewFilterCustomMatch read FCustomMatch write FCustomMatch;
end;
TCustomKMListViewFilterEntries = specialize TFPGList<TKMListViewFilterEntry>;
TKMListViewFilterEntries = Class (TCustomKMListViewFilterEntries);
{ TKMCustomListViewFilter }
TKMCustomListViewFilter = class(TCustomEditButton)
private
FListEntries : TKMListViewFilterEntries;
FListView : TListView;
FMatchAll : Boolean;
FFilterOptions : TFilterStringOptions;
FSortData: Boolean;
procedure SetCustomMatch(AValue: TkmListViewFilterCustomMatch);
procedure SetFilteredListView(AValue: TListView);
procedure SetFilterOptions(AValue: TFilterStringOptions);
procedure SetMatchAll(AValue: Boolean);
procedure SetSortData(AValue: Boolean);
function IsTextHintStored : Boolean;
protected
FCustomMatch : TKMListViewFilterCustomMatch;
FAfterFilter : TNotifyEvent;
function GetDefaultGlyphName: string; override;
function GetCount : Integer;
procedure BuddyClick; override;
procedure EditChange (Sender : TObject); overload;
public
constructor Create (aOwner : TComponent); override;
destructor Destroy; override;
procedure Reload;
procedure RemoveFilter;
procedure Filter;
published
property FFilteredListView : TListView read FListView write SetFilteredListView;
property MatchAll : Boolean read FMatchAll write SetMatchAll default false;
property SortData : Boolean read FSortData write SetSortData;
property OriginalCount : Integer read GetCount;
property FilterOptions: TFilterStringOptions read fFilterOptions write SetFilterOptions default [];
property OnAfterFilter : TNotifyEvent read FAfterFilter write FAfterFilter;
property OnCustomMatch : TkmListViewFilterCustomMatch read FCustomMatch write SetCustomMatch;
property TextHint stored IsTextHintStored;
end;
TKMListViewFilterEdit = Class (TKMCustomListViewFilter)
public
property AutoSelected;
property Button;
property Edit;
property OnChange;
published
property NumbersOnly;
property Action;
property AutoSelect;
property AutoSize default True;
property Align;
property Alignment;
property Anchors;
property BiDiMode;
property BorderSpacing;
property BorderStyle default bsNone;
property ButtonCaption;
property ButtonCursor;
property ButtonHint;
property ButtonOnlyWhenFocused;
property ButtonWidth;
property CharCase;
property Color;
property Constraints;
property Cursor;
property DirectInput;
property EchoMode;
property Enabled;
property Flat;
property FocusOnButtonClick;
property Font;
property Glyph;
// property HideSelection;
property Hint;
property Images;
property ImageIndex;
property ImageWidth;
property Layout;
property MaxLength;
property NumGlyphs;
property OnButtonClick;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnContextPopup;
property OnEditingDone;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnStartDrag;
property OnUTF8KeyPress;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ReadOnly;
property ShowHint;
property Spacing;
property TabOrder;
property TabStop;
property Text;
property TextHint;
property Visible;
property OnAfterFilter;
property OnCustomMatch;
end;
procedure Register;
implementation
procedure Register;
begin
{$I ukmlistviewfilter_icon.lrs}
RegisterComponents('Misc',[TKMListViewFilterEdit]);
end;
{ TKMListViewFilterEntry }
constructor TKMListViewFilterEntry.Create;
begin
FItems := TStringList.Create;
FItems.Duplicates:= dupAccept;
FItems.Sorted := false;
FItems.OwnsObjects:=false;
FData := NIL;
end;
destructor TKMListViewFilterEntry.Destroy;
var
i : Integer;
begin
For i := 0 to FItems.Count - 1 do
FItems.Objects[i] := NIL;
FreeAndNil (FItems);
FData := NIL;
inherited Destroy;
end;
function TKMListViewFilterEntry.Match(SearchString: String; MatchAll: Boolean;
CaseSensitive: Boolean): Boolean;
var
i, max : Integer;
begin
Result := false;
if FCustomMatch <> NIL then
Result := FCustomMatch (SearchString, MatchAll, CaseSensitive)
else begin
max := 0;
if MatchAll then
max := FItems.Count -1;
if not CaseSensitive then SearchString := LowerCase (SearchString);
For i := 0 to max do
begin
if CaseSensitive then
Result := POS (SearchString, FItems[i]) > 0
else
Result := POS (SearchString, LowerCase(FItems[i])) > 0;
if Result then Break;
end;
end;
end;
{ TKMCustomListViewFilter }
procedure TKMCustomListViewFilter.SetCustomMatch(
AValue: TkmListViewFilterCustomMatch);
begin
if FCustomMatch=AValue then Exit;
FCustomMatch:=AValue;
end;
procedure TKMCustomListViewFilter.SetFilteredListView(AValue: TListView);
begin
if FListView=AValue then Exit;
FListView:=AValue;
Reload;
end;
procedure TKMCustomListViewFilter.SetFilterOptions(AValue: TFilterStringOptions
);
begin
if fFilterOptions=AValue then Exit;
fFilterOptions:=AValue;
end;
procedure TKMCustomListViewFilter.SetMatchAll(AValue: Boolean);
begin
if FMatchAll=AValue then Exit;
FMatchAll:=AValue;
end;
procedure TKMCustomListViewFilter.SetSortData(AValue: Boolean);
begin
if FSortData=AValue then Exit;
FSortData:=AValue;
end;
function TKMCustomListViewFilter.IsTextHintStored: Boolean;
begin
Result := TextHint<>rsFilter;
end;
function TKMCustomListViewFilter.GetDefaultGlyphName: string;
begin
Result:='btnfiltercancel';
end;
function TKMCustomListViewFilter.GetCount: Integer;
begin
Result := -1;
if Assigned (FListEntries) then
Result := FListEntries.Count;
end;
procedure TKMCustomListViewFilter.BuddyClick;
begin
Self.Text := '';
RemoveFilter;
if (fListView.SortType <> stNone) or fListView.AutoSort then
fListView.Sort;
if FocusOnButtonClick then
Edit.SetFocus;
Button.Enabled:= false;
inherited;
end;
procedure TKMCustomListViewFilter.EditChange(Sender: TObject);
begin
Button.Enabled:= Text <> '';
Filter;
if (fListView.SortType <> stNone) or fListView.AutoSort then
fListView.Sort;
end;
constructor TKMCustomListViewFilter.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
FListEntries := TKMListViewFilterEntries.Create;
FMatchAll:= false;
FFilterOptions:= [];
TextHint:= rsFilter;
ShowHint:= true;
ButtonHint:= 'Filter entfernen';
FocusOnButtonClick:= true;
Button.Enabled:= false;
OnChange:= @EditChange;
end;
destructor TKMCustomListViewFilter.Destroy;
begin
FListEntries.Free;
fAfterFilter := NIL;
fListView := NIL;
inherited Destroy;
end;
procedure TKMCustomListViewFilter.Reload;
var
i,j : Integer;
e : TkmListViewFilterEntry;
begin
if (fListView = NIL) or not Assigned (fListView) or not Assigned (fListEntries) then
Exit;
FListEntries.Clear;
For i := 0 to fListView.Items.Count -1 do
begin
e := TkmListViewFilterEntry.Create;
e.CustomMatch:=FCustomMatch;
With e do
begin
Items.AddObject (fListView.Items[i].Caption, TObject(PtrInt (fListView.Items[i].ImageIndex)));
StateIndex := fListView.Items[i].StateIndex;
For j := 0 to fListView.Items[i].SubItems.Count -1 do
Items.AddObject (fListView.Items[i].SubItems[j], TObject (PtrInt (fListView.Items[i].SubItemImages[j])));
FData:= fListView.Items[i].Data;
end;
FListEntries.Add(e);
end;
if Assigned (FAfterFilter) then FAfterFilter (Self);
end;
procedure TKMCustomListViewFilter.RemoveFilter;
var
i,j : Integer;
e : TkmListViewFilterEntry;
begin
if (fListView = NIL) or not Assigned (fListView) then
Exit;
fListView.BeginUpdate;
fListView.Items.Clear;
For i := 0 to FListEntries.Count -1 do
begin
e := FListEntries[i];
if e <> NIL then
With fListView.Items.Add do
begin
Caption := e.Items[0];
ImageIndex := PtrInt (e.Items.Objects[0]);
StateIndex := e.StateIndex;
SubItems.AddStrings (e.Items);
SubItems.Delete(0);
for j := 0 to SubItems.Count -1 do
SubItemImages[j] := PtrInt (e.Items.Objects[j+1]);
Data := e.Data;
end;
end;
fListView.EndUpdate;
if Assigned (FAfterFilter) then FAfterFilter (Self);
end;
procedure TKMCustomListViewFilter.Filter;
var
i,j : Integer;
e : TkmListViewFilterEntry;
begin
if (fListView = NIL) or not Assigned (fListView) then
Exit;
if Self.Text = '' then
RemoveFilter
else begin
fListView.BeginUpdate;
fListView.Items.Clear;
For i := 0 to FListEntries.Count -1 do
begin
e := FListEntries[i];
if e.Match (Self.Text, FMatchall, fsoCaseSensitive in FFilterOptions) then
With fListView.Items.Add do
begin
Caption := e.Items[0];
ImageIndex := PtrInt (e.Items.Objects[0]);
StateIndex := e.StateIndex;
SubItems.AddStrings(e.Items);
SubItems.Delete(0);
For j := 0 to SubItems.Count -1 do
SubItemImages[j] := PtrInt (e.Items.Objects[j+1]);
Data := e.Data;
end;
end;
fListView.EndUpdate;
if Assigned (FAfterFilter) then FAfterFilter (Self);
end;
end;
end.
Recent
