VCL Delphi

Title: link a TFilterComboBox with a TShellListView?
{
Question:
Does anybody know how to make a component just like the
FilerComboBox but instead of applying the filter to the
TFilterComboBox doing it to the ShellListView?
}
{
Answer:
Looks like you've got two ways to make it work. First is by using standard
events of the TShellListView and TFilterComboBox controls. Assign the
OnAddFolder event to the shell listview and check up the file name, which is
coming as a PathName property of the AFolder parameter. Also, you need to
refresh the list each time the the value of the filter combobox was changed.
You could do it in the combobox's OnChange event. Below is an example:
}
// Refresh the ShellListView when the filter changes
procedure TForm1.ShellListView1AddFolder(Sender: TObject;
AFolder: TShellFolder; var CanAdd: Boolean);
var
XFilterExt, XExt: string;
begin
if FilterComboBox1.Mask '*.*' then
begin
XFilterExt := ExtractFileExt(FilterComboBox1.Mask);
XExt := ExtractFileExt(AFolder.PathName);
// Only accept filter and folders
if (CompareText(XExt, XFilterExt) = 0) or AFolder.IsFolder then
CanAdd := True
else
CanAdd := False;
end;
end;
// Refresh the ShellListView when the filter changes
procedure TForm1.FilterComboBox1Change(Sender: TObject);
begin
ShellListView1.Refresh;
end;
//
{
Second approach is to create your own TShellListView and TFilterComboBox
descendants. There you could implement the needed functionality. Override
list's OwnerDataFetch method in order to filter the undesired items. You
also need to add a ShellListView property to the filter combobox. Give a try
to the code listed below. It's a unit with components I was talking about,
they seemed to work fine for me :)
}
unit MyShCtrl;
{$WARN UNIT_PLATFORM OFF}
interface
uses
Windows, Messages, SysUtils, Graphics, Classes, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, FileCtrl, ShellCtrls;
type
TMyShellListView = class(TShellListView)
protected
FMask: string;
function OwnerDataFetch(Item: TListItem; Request: TItemRequest): Boolean; override;
procedure SetMask(AValue: string);
published
property Mask: string read FMask write SetMask;
end;
TMyFilterComboBox = class(TFilterComboBox)
protected
FShellListView: TMyShellListView;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Change; override;
procedure SetShellListView(AValue: TMyShellListView);
published
property ShellListView: TMyShellListView read FShellListView write SetShellListView;
end;
procedure Register;
{============================================}
implementation
procedure Register;
begin
RegisterComponents('My Components', [TMyShellListView,
TMyFilterComboBox]);
end;
{============================================}
function TMyShellListView.OwnerDataFetch(Item: TListItem;
Request: TItemRequest): Boolean;
var
XFolder: TShellFolder;
XExt, XFltExt: string;
begin
if (Length(FMask) 0) and (FMask '*.*') then
begin
XFolder := Folders[Item.Index];
if Assigned(XFolder) and not XFolder.IsFolder then
begin
XExt := ExtractFileExt(XFolder.PathName);
XFltExt := ExtractFileExt(FMask);
if CompareText(XExt, XFltExt) 0 then
begin
Result := False;
Exit;
end;
end;
end;
Result := inherited OwnerDataFetch(Item, Request);
end;
procedure TMyShellListView.SetMask(AValue: string);
begin
if FMask AValue then
begin
FMask := AValue;
Invalidate;
end;
end;
{============================================}
procedure TMyFilterComboBox.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FShellListView) then FShellListView := nil;
end;
procedure TMyFilterComboBox.Change;
begin
inherited Change;
if Assigned(FShellListView) then FShellListView.Mask := Mask
end;
procedure TMyFilterComboBox.SetShellListView(AValue: TMyShellListView);
begin
if AValue FShellListView then
begin
FShellListView := AValue;
if Assigned(AValue) then AValue.FreeNotification(Self);
end;
end;
end.