Added: filter options in Units dialog
Added: support for Project Source Added: dialog overrides View Form Added: dialog now actually activates the unit Changed: refactored filters to use Visitor pattern Note: requires at least Delphi 7
This commit is contained in:
parent
4e7456ac74
commit
27a1a5023f
@ -34,6 +34,7 @@ requires
|
||||
contains
|
||||
UnSwClient in '..\..\Source\UnSwClient.pas',
|
||||
UnSwObjects in '..\..\Source\UnSwObjects.pas',
|
||||
UnSwDialog in '..\..\Source\UnSwDialog.pas' {frmUnSwDialog};
|
||||
UnSwDialog in '..\..\Source\UnSwDialog.pas' {frmUnSwDialog},
|
||||
UnSwFilters in '..\..\Source\UnSwFilters.pas';
|
||||
|
||||
end.
|
||||
|
||||
@ -16,9 +16,12 @@ uses
|
||||
type
|
||||
TUnitSwitcherHook = class(TObject)
|
||||
private
|
||||
FOldExecute: TNotifyEvent;
|
||||
FOldUnitExecute: TNotifyEvent;
|
||||
FOldFormExecute: TNotifyEvent;
|
||||
FViewUnitAction: TContainedAction;
|
||||
FViewFormAction: TContainedAction;
|
||||
protected
|
||||
function ActiveFileName(): String;
|
||||
procedure NewExecute(Sender: TObject); virtual;
|
||||
public
|
||||
constructor Create();
|
||||
@ -48,15 +51,21 @@ begin
|
||||
pAction := ifNTA.ActionList.Actions[iAction];
|
||||
if pAction.Name = 'ViewUnitCommand' then
|
||||
begin
|
||||
FOldExecute := pAction.OnExecute;
|
||||
FOldUnitExecute := pAction.OnExecute;
|
||||
pAction.OnExecute := NewExecute;
|
||||
FViewUnitAction := pAction;
|
||||
break;
|
||||
end else if pAction.Name = 'ViewFormCommand' then
|
||||
begin
|
||||
FOldFormExecute := pAction.OnExecute;
|
||||
pAction.OnExecute := NewExecute;
|
||||
FViewFormAction := pAction;
|
||||
end;
|
||||
end;
|
||||
|
||||
Assert(Assigned(FViewUnitAction), 'ViewUnitCommand action is not' +
|
||||
'available in the IDE.');
|
||||
Assert(Assigned(FViewFormAction), 'ViewFormCommand action is not' +
|
||||
'available in the IDE.');
|
||||
except
|
||||
on E:EAssertionFailed do
|
||||
ShowMessage('Error while loading UnitSwitcher: ' + E.Message);
|
||||
@ -65,30 +74,59 @@ end;
|
||||
|
||||
destructor TUnitSwitcherHook.Destroy();
|
||||
begin
|
||||
if Assigned(FViewFormAction) then
|
||||
FViewFormAction.OnExecute := FOldFormExecute;
|
||||
|
||||
if Assigned(FViewUnitAction) then
|
||||
FViewUnitAction.OnExecute := FOldExecute;
|
||||
FViewUnitAction.OnExecute := FOldUnitExecute;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TUnitSwitcherHook.ActiveFileName(): String;
|
||||
var
|
||||
ifModule: IOTAModule;
|
||||
|
||||
begin
|
||||
Result := '';
|
||||
ifModule := (BorlandIDEServices as IOTAModuleServices).CurrentModule;
|
||||
if Assigned(ifModule) then
|
||||
begin
|
||||
if Assigned(ifModule.CurrentEditor) then
|
||||
Result := ifModule.FileName;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUnitSwitcherHook.NewExecute(Sender: TObject);
|
||||
var
|
||||
iActive: Integer;
|
||||
ifProject: IOTAProject;
|
||||
iModule: Integer;
|
||||
pProject: IOTAProject;
|
||||
pActive: TUnSwUnit;
|
||||
pUnits: TUnSwUnitList;
|
||||
|
||||
begin
|
||||
pProject := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
|
||||
if not Assigned(pProject) then
|
||||
ifProject := (BorlandIDEServices as IOTAModuleServices).GetActiveProject;
|
||||
if not Assigned(ifProject) then
|
||||
exit;
|
||||
|
||||
pUnits := TUnSwUnitList.Create();
|
||||
try
|
||||
for iModule := 0 to Pred(pProject.GetModuleCount) do
|
||||
pUnits.Add(TUnSwUnit.Create(pProject.GetModule(iModule)));
|
||||
pUnits.Add(TUnSwProjectUnit.Create(ifProject));
|
||||
|
||||
TfrmUnSwDialog.Execute(pUnits);
|
||||
for iModule := 0 to Pred(ifProject.GetModuleCount) do
|
||||
pUnits.Add(TUnSwModuleUnit.Create(ifProject.GetModule(iModule)));
|
||||
|
||||
pActive := nil;
|
||||
iActive := pUnits.IndexOfFileName(ActiveFileName());
|
||||
if iActive > -1 then
|
||||
pActive := pUnits[iActive];
|
||||
|
||||
pActive := TfrmUnSwDialog.Execute(pUnits, (Sender = FViewFormAction),
|
||||
pActive);
|
||||
if Assigned(pActive) then
|
||||
pActive.Activate((Sender = FViewUnitAction));
|
||||
finally
|
||||
FreeAndNil(pUnits);
|
||||
end;
|
||||
|
||||
@ -3,7 +3,7 @@ object frmUnSwDialog: TfrmUnSwDialog
|
||||
Top = 83
|
||||
BorderIcons = [biSystemMenu]
|
||||
Caption = 'UnitSwitcher - it almosts makes coffee.'
|
||||
ClientHeight = 387
|
||||
ClientHeight = 427
|
||||
ClientWidth = 299
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
@ -17,7 +17,7 @@ object frmUnSwDialog: TfrmUnSwDialog
|
||||
TextHeight = 13
|
||||
object sbStatus: TStatusBar
|
||||
Left = 0
|
||||
Top = 368
|
||||
Top = 408
|
||||
Width = 299
|
||||
Height = 19
|
||||
Panels = <
|
||||
@ -29,11 +29,11 @@ object frmUnSwDialog: TfrmUnSwDialog
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 299
|
||||
Height = 334
|
||||
Height = 317
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
BorderWidth = 4
|
||||
TabOrder = 1
|
||||
TabOrder = 0
|
||||
ExplicitWidth = 297
|
||||
ExplicitHeight = 368
|
||||
object pnlSearch: TPanel
|
||||
@ -59,7 +59,7 @@ object frmUnSwDialog: TfrmUnSwDialog
|
||||
Left = 4
|
||||
Top = 29
|
||||
Width = 291
|
||||
Height = 301
|
||||
Height = 284
|
||||
Style = lbVirtualOwnerDraw
|
||||
Align = alClient
|
||||
ItemHeight = 20
|
||||
@ -68,38 +68,74 @@ object frmUnSwDialog: TfrmUnSwDialog
|
||||
OnDrawItem = lstUnitsDrawItem
|
||||
end
|
||||
end
|
||||
object Panel1: TPanel
|
||||
object pnlButtons: TPanel
|
||||
Left = 0
|
||||
Top = 334
|
||||
Top = 372
|
||||
Width = 299
|
||||
Height = 34
|
||||
Height = 36
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
TabOrder = 2
|
||||
DesignSize = (
|
||||
299
|
||||
34)
|
||||
36)
|
||||
object btnCancel: TButton
|
||||
Left = 220
|
||||
Top = 2
|
||||
Top = 5
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akTop, akRight]
|
||||
Anchors = [akRight, akBottom]
|
||||
Cancel = True
|
||||
Caption = 'Cancel'
|
||||
ModalResult = 2
|
||||
TabOrder = 0
|
||||
TabOrder = 1
|
||||
end
|
||||
object btnOK: TButton
|
||||
Left = 139
|
||||
Top = 2
|
||||
Top = 5
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akTop, akRight]
|
||||
Anchors = [akRight, akBottom]
|
||||
Caption = 'OK'
|
||||
Default = True
|
||||
ModalResult = 1
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
object pnlIncludeTypes: TPanel
|
||||
Left = 0
|
||||
Top = 317
|
||||
Width = 299
|
||||
Height = 55
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
TabOrder = 1
|
||||
object chkDataModules: TCheckBox
|
||||
Left = 4
|
||||
Top = 19
|
||||
Width = 291
|
||||
Height = 17
|
||||
Caption = 'Show &DataModule units'
|
||||
TabOrder = 1
|
||||
OnClick = TypeFilterChange
|
||||
end
|
||||
object chkForms: TCheckBox
|
||||
Left = 4
|
||||
Top = 2
|
||||
Width = 291
|
||||
Height = 17
|
||||
Caption = 'Show &Form units'
|
||||
TabOrder = 0
|
||||
OnClick = TypeFilterChange
|
||||
end
|
||||
object chkProjectSource: TCheckBox
|
||||
Left = 4
|
||||
Top = 36
|
||||
Width = 291
|
||||
Height = 17
|
||||
Caption = 'Show &Project source'
|
||||
TabOrder = 2
|
||||
OnClick = TypeFilterChange
|
||||
end
|
||||
end
|
||||
object ilsTypes: TImageList
|
||||
|
||||
@ -1,5 +1,7 @@
|
||||
unit UnSwDialog;
|
||||
|
||||
// #ToDo1 Store dialog settings
|
||||
|
||||
interface
|
||||
uses
|
||||
Classes,
|
||||
@ -11,19 +13,35 @@ uses
|
||||
StdCtrls,
|
||||
Windows,
|
||||
|
||||
UnSwObjects;
|
||||
UnSwObjects,
|
||||
UnSwFilters;
|
||||
|
||||
type
|
||||
TUnSwIconVisitor = class(TUnSwNoRefIntfObject, IUnSwVisitor)
|
||||
private
|
||||
FImageIndex: Integer;
|
||||
protected
|
||||
procedure VisitModule(const AUnit: TUnSwModuleUnit);
|
||||
procedure VisitProject(const AUnit: TUnSwProjectUnit);
|
||||
public
|
||||
property ImageIndex: Integer read FImageIndex;
|
||||
end;
|
||||
|
||||
TfrmUnSwDialog = class(TForm)
|
||||
btnCancel: TButton;
|
||||
btnOK: TButton;
|
||||
edtSearch: TEdit;
|
||||
ilsTypes: TImageList;
|
||||
lstUnits: TListBox;
|
||||
pnlButtons: TPanel;
|
||||
pnlMain: TPanel;
|
||||
pnlSearch: TPanel;
|
||||
sbStatus: TStatusBar;
|
||||
Panel1: TPanel;
|
||||
btnCancel: TButton;
|
||||
btnOK: TButton;
|
||||
chkForms: TCheckBox;
|
||||
chkDataModules: TCheckBox;
|
||||
chkProjectSource: TCheckBox;
|
||||
pnlIncludeTypes: TPanel;
|
||||
procedure TypeFilterChange(Sender: TObject);
|
||||
|
||||
procedure edtSearchChange(Sender: TObject);
|
||||
procedure edtSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
@ -31,18 +49,26 @@ type
|
||||
procedure lstUnitsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
||||
private
|
||||
FUnitList: TUnSwUnitList;
|
||||
FActiveUnit: TUnSwUnit;
|
||||
FFormsOnly: Boolean;
|
||||
|
||||
FTypeFilteredList: TUnSwUnitList;
|
||||
FInputFilteredList: TUnSwUnitList;
|
||||
|
||||
FTypeFilter: TUnSwUnitTypeFilter;
|
||||
FInputFilter: TUnSwUnitSimpleFilter;
|
||||
|
||||
function InternalExecute(const AUnits: TUnSwUnitList): Integer;
|
||||
FIconVisitor: TUnSwIconVisitor;
|
||||
|
||||
function InternalExecute(): TUnSwUnit;
|
||||
procedure UpdateTypeFilter();
|
||||
procedure UpdateList();
|
||||
|
||||
function GetActiveUnit(): TUnSwUnit;
|
||||
public
|
||||
class function Execute(const AUnits: TUnSwUnitList): Integer;
|
||||
class function Execute(const AUnits: TUnSwUnitList;
|
||||
const AFormsOnly: Boolean;
|
||||
const AActive: TUnSwUnit = nil): TUnSwUnit;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -50,41 +76,74 @@ uses
|
||||
SysUtils,
|
||||
Graphics;
|
||||
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
|
||||
{ TUnSwIconVisitor }
|
||||
procedure TUnSwIconVisitor.VisitModule(const AUnit: TUnSwModuleUnit);
|
||||
begin
|
||||
case AUnit.UnitType of
|
||||
swutForm: FImageIndex := 1;
|
||||
swutDataModule: FImageIndex := 2;
|
||||
else
|
||||
FImageIndex := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUnSwIconVisitor.VisitProject(const AUnit: TUnSwProjectUnit);
|
||||
begin
|
||||
FImageIndex := 3;
|
||||
end;
|
||||
|
||||
|
||||
{ TfrmUnSwDialog }
|
||||
class function TfrmUnSwDialog.Execute(const AUnits: TUnSwUnitList): Integer;
|
||||
class function TfrmUnSwDialog.Execute(const AUnits: TUnSwUnitList;
|
||||
const AFormsOnly: Boolean;
|
||||
const AActive: TUnSwUnit): TUnSwUnit;
|
||||
begin
|
||||
with Self.Create(nil) do
|
||||
try
|
||||
Result := InternalExecute(AUnits);
|
||||
FUnitList := AUnits;
|
||||
FActiveUnit := AActive;
|
||||
FFormsOnly := AFormsOnly;
|
||||
Result := InternalExecute();
|
||||
finally
|
||||
Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function SortByName(Item1, Item2: Pointer): Integer;
|
||||
begin
|
||||
Result := CompareText(TUnSwUnit(Item1).Name, TUnSwUnit(Item2).Name)
|
||||
end;
|
||||
|
||||
function TfrmUnSwDialog.InternalExecute(const AUnits: TUnSwUnitList): Integer;
|
||||
function TfrmUnSwDialog.InternalExecute(): TUnSwUnit;
|
||||
begin
|
||||
Result := -1;
|
||||
FUnitList := AUnits;
|
||||
Result := nil;
|
||||
|
||||
if not FFormsOnly then
|
||||
begin
|
||||
chkForms.Checked := FTypeFilter.IncludeForms;
|
||||
chkDataModules.Checked := FTypeFilter.IncludeDataModules;
|
||||
chkProjectSource.Checked := FTypeFilter.IncludeProjectSource;
|
||||
end else
|
||||
pnlIncludeTypes.Visible := False;
|
||||
|
||||
FTypeFilteredList := TUnSwUnitList.Create();
|
||||
FInputFilteredList := TUnSwUnitList.Create();
|
||||
FTypeFilter := TUnSwUnitTypeFilter.Create();
|
||||
FInputFilter := TUnSwUnitSimpleFilter.Create();
|
||||
FTypeFilter := TUnSwUnitTypeFilter.Create(FTypeFilteredList);
|
||||
FInputFilter := TUnSwUnitSimpleFilter.Create(FInputFilteredList);
|
||||
try
|
||||
FTypeFilteredList.Clone(FUnitList);
|
||||
FTypeFilteredList.ApplyFilter(FTypeFilter);
|
||||
FTypeFilteredList.Sort(SortByName);
|
||||
UpdateList();
|
||||
UpdateTypeFilter();
|
||||
|
||||
Self.ShowModal();
|
||||
FIconVisitor := TUnSwIconVisitor.Create();
|
||||
try
|
||||
if Self.ShowModal() = mrOk then
|
||||
Result := GetActiveUnit();
|
||||
finally
|
||||
FreeAndNil(FIconVisitor);
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(FInputFilter);
|
||||
FreeAndNil(FTypeFilter);
|
||||
@ -99,10 +158,9 @@ var
|
||||
|
||||
begin
|
||||
pActive := GetActiveUnit();
|
||||
// #ToDo1 Try to select the previous unit, otherwise select the first
|
||||
|
||||
FInputFilteredList.Clone(FTypeFilteredList);
|
||||
FInputFilteredList.ApplyFilter(FInputFilter);
|
||||
FInputFilteredList.AcceptVisitor(FInputFilter);
|
||||
|
||||
lstUnits.Count := FInputFilteredList.Count;
|
||||
if FInputFilteredList.Count > 0 then
|
||||
@ -115,11 +173,28 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmUnSwDialog.UpdateTypeFilter();
|
||||
begin
|
||||
FTypeFilter.IncludeUnits := not FFormsOnly;
|
||||
FTypeFilter.IncludeForms := (FFormsOnly or chkForms.Checked);
|
||||
FTypeFilter.IncludeDataModules := ((not FFormsOnly) and chkDataModules.Checked);
|
||||
FTypeFilter.IncludeProjectSource := ((not FFormsOnly) and chkProjectSource.Checked);
|
||||
|
||||
FTypeFilteredList.Clone(FUnitList);
|
||||
FTypeFilteredList.AcceptVisitor(FTypeFilter);
|
||||
FTypeFilteredList.Sort(SortByName);
|
||||
UpdateList();
|
||||
end;
|
||||
|
||||
function TfrmUnSwDialog.GetActiveUnit(): TUnSwUnit;
|
||||
begin
|
||||
Result := nil;
|
||||
if lstUnits.ItemIndex > -1 then
|
||||
Result := FInputFilteredList[lstUnits.ItemIndex];
|
||||
Result := FActiveUnit;
|
||||
if not Assigned(Result) then
|
||||
begin
|
||||
if lstUnits.ItemIndex > -1 then
|
||||
Result := FInputFilteredList[lstUnits.ItemIndex];
|
||||
end else
|
||||
FActiveUnit := nil;
|
||||
end;
|
||||
|
||||
procedure TfrmUnSwDialog.edtSearchChange(Sender: TObject);
|
||||
@ -134,14 +209,26 @@ begin
|
||||
if Shift = [] then
|
||||
case Key of
|
||||
VK_UP:
|
||||
if lstUnits.ItemIndex > 0 then
|
||||
lstUnits.ItemIndex := Pred(lstUnits.ItemIndex);
|
||||
begin
|
||||
if lstUnits.ItemIndex > 0 then
|
||||
lstUnits.ItemIndex := Pred(lstUnits.ItemIndex);
|
||||
|
||||
Key := 0;
|
||||
end;
|
||||
VK_DOWN:
|
||||
if lstUnits.ItemIndex < Pred(lstUnits.Items.Count) then
|
||||
lstUnits.ItemIndex := Succ(lstUnits.ItemIndex);
|
||||
begin
|
||||
if lstUnits.ItemIndex < Pred(lstUnits.Items.Count) then
|
||||
lstUnits.ItemIndex := Succ(lstUnits.ItemIndex);
|
||||
|
||||
Key := 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmUnSwDialog.TypeFilterChange(Sender: TObject);
|
||||
begin
|
||||
UpdateTypeFilter();
|
||||
end;
|
||||
|
||||
procedure TfrmUnSwDialog.lstUnitsData(Control: TWinControl; Index: Integer;
|
||||
var Data: string);
|
||||
@ -152,13 +239,15 @@ end;
|
||||
procedure TfrmUnSwDialog.lstUnitsDrawItem(Control: TWinControl; Index: Integer;
|
||||
Rect: TRect; State: TOwnerDrawState);
|
||||
var
|
||||
iIcon: Integer;
|
||||
pUnit: TUnSwUnit;
|
||||
rText: TRect;
|
||||
sText: String;
|
||||
|
||||
begin
|
||||
with TListBox(Control) do
|
||||
begin
|
||||
pUnit := FInputFilteredList[Index];
|
||||
|
||||
if odSelected in State then
|
||||
begin
|
||||
Canvas.Brush.Color := clHighlight;
|
||||
@ -173,16 +262,11 @@ begin
|
||||
rText := Rect;
|
||||
InflateRect(rText, -2, -2);
|
||||
|
||||
iIcon := 0;
|
||||
case FInputFilteredList[Index].UnitType of
|
||||
swutForm: iIcon := 1;
|
||||
swutDataModule: iIcon := 2;
|
||||
swutProjUnit: iIcon := 3;
|
||||
end;
|
||||
ilsTypes.Draw(Canvas, rText.Left, rText.Top, iIcon);
|
||||
pUnit.AcceptVisitor(FIconVisitor);
|
||||
ilsTypes.Draw(Canvas, rText.Left, rText.Top, FIconVisitor.ImageIndex);
|
||||
|
||||
Inc(rText.Left, ilsTypes.Width + 4);
|
||||
sText := FInputFilteredList[Index].Name;
|
||||
sText := pUnit.Name;
|
||||
DrawText(Canvas.Handle, PChar(sText), Length(sText), rText, DT_SINGLELINE or
|
||||
DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
|
||||
end;
|
||||
|
||||
137
Source/UnSwFilters.pas
Normal file
137
Source/UnSwFilters.pas
Normal file
@ -0,0 +1,137 @@
|
||||
unit UnSwFilters;
|
||||
|
||||
interface
|
||||
uses
|
||||
UnSwObjects;
|
||||
|
||||
type
|
||||
TUnSwUnitFilter = class(TUnSwNoRefIntfObject, IUnSwVisitor)
|
||||
private
|
||||
FList: TUnSwUnitList;
|
||||
protected
|
||||
// Called by default by all other Visit methods
|
||||
procedure VisitUnit(const AUnit: TUnSwUnit); virtual;
|
||||
|
||||
procedure VisitModule(const AUnit: TUnSwModuleUnit); virtual;
|
||||
procedure VisitProject(const AUnit: TUnSwProjectUnit); virtual;
|
||||
|
||||
procedure FilterUnit(const AUnit: TUnSwUnit); virtual;
|
||||
public
|
||||
constructor Create(const AList: TUnSwUnitList); virtual;
|
||||
end;
|
||||
|
||||
TUnSwUnitSimpleFilter = class(TUnSwUnitFilter)
|
||||
private
|
||||
FFilter: String;
|
||||
|
||||
procedure SetFilter(const Value: String);
|
||||
protected
|
||||
procedure VisitUnit(const AUnit: TUnSwUnit); override;
|
||||
public
|
||||
property Filter: String read FFilter write SetFilter;
|
||||
end;
|
||||
|
||||
TUnSwUnitTypeFilter = class(TUnSwUnitFilter)
|
||||
private
|
||||
FIncludeDataModules: Boolean;
|
||||
FIncludeForms: Boolean;
|
||||
FIncludeProjectSource: Boolean;
|
||||
FIncludeUnits: Boolean;
|
||||
protected
|
||||
procedure VisitModule(const AUnit: TUnSwModuleUnit); override;
|
||||
procedure VisitProject(const AUnit: TUnSwProjectUnit); override;
|
||||
public
|
||||
constructor Create(const AList: TUnSwUnitList); override;
|
||||
|
||||
property IncludeDataModules: Boolean read FIncludeDataModules write FIncludeDataModules;
|
||||
property IncludeForms: Boolean read FIncludeForms write FIncludeForms;
|
||||
property IncludeProjectSource: Boolean read FIncludeProjectSource write FIncludeProjectSource;
|
||||
property IncludeUnits: Boolean read FIncludeUnits write FIncludeUnits;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
|
||||
{ TUnSwUnitFilter }
|
||||
constructor TUnSwUnitFilter.Create(const AList: TUnSwUnitList);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
Assert(Assigned(AList), 'List must be assigned.');
|
||||
FList := AList;
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitFilter.VisitUnit(const AUnit: TUnSwUnit);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitFilter.VisitModule(const AUnit: TUnSwModuleUnit);
|
||||
begin
|
||||
VisitUnit(AUnit);
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitFilter.VisitProject(const AUnit: TUnSwProjectUnit);
|
||||
begin
|
||||
VisitUnit(AUnit);
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitFilter.FilterUnit(const AUnit: TUnSwUnit);
|
||||
begin
|
||||
FList.Remove(AUnit);
|
||||
end;
|
||||
|
||||
|
||||
{ TUnSwUnitSimpleFilter }
|
||||
procedure TUnSwUnitSimpleFilter.VisitUnit(const AUnit: TUnSwUnit);
|
||||
begin
|
||||
if (Length(FFilter) > 0) and
|
||||
(AnsiPos(FFilter, LowerCase(AUnit.Name)) = 0) then
|
||||
FilterUnit(AUnit);
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitSimpleFilter.SetFilter(const Value: String);
|
||||
begin
|
||||
FFilter := LowerCase(Value);
|
||||
end;
|
||||
|
||||
|
||||
{ TUnSwUnitTypeFilter }
|
||||
constructor TUnSwUnitTypeFilter.Create(const AList: TUnSwUnitList);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FIncludeDataModules := True;
|
||||
FIncludeForms := True;
|
||||
FIncludeProjectSource := True;
|
||||
FIncludeUnits := True;
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitTypeFilter.VisitModule(const AUnit: TUnSwModuleUnit);
|
||||
var
|
||||
eValidTypes: TUnSwUnitTypes;
|
||||
|
||||
begin
|
||||
eValidTypes := [];
|
||||
|
||||
if FIncludeDataModules then
|
||||
Include(eValidTypes, swutDataModule);
|
||||
|
||||
if FIncludeForms then
|
||||
Include(eValidTypes, swutForm);
|
||||
|
||||
if FIncludeUnits then
|
||||
Include(eValidTypes, swutUnit);
|
||||
|
||||
if not (AUnit.UnitType in eValidTypes) then
|
||||
FilterUnit(AUnit);
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitTypeFilter.VisitProject(const AUnit: TUnSwProjectUnit);
|
||||
begin
|
||||
if not FIncludeProjectSource then
|
||||
FilterUnit(AUnit);
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -8,7 +8,46 @@ uses
|
||||
|
||||
type
|
||||
// Forward declarations
|
||||
TUnSwUnitFilter = class;
|
||||
TUnSwUnit = class;
|
||||
TUnSwModuleUnit = class;
|
||||
TUnSwProjectUnit = class;
|
||||
|
||||
|
||||
IUnSwVisitor = interface
|
||||
['{A822C25B-5D0F-462F-94DD-47CD6235D79F}']
|
||||
procedure VisitModule(const AUnit: TUnSwModuleUnit);
|
||||
procedure VisitProject(const AUnit: TUnSwProjectUnit);
|
||||
end;
|
||||
|
||||
IUnSwVisited = interface
|
||||
['{9540671E-184B-4DB6-A015-27B457C74C6C}']
|
||||
procedure AcceptVisitor(const AVisitor: IUnSwVisitor);
|
||||
end;
|
||||
|
||||
|
||||
TUnSwNoRefIntfObject = class(TPersistent, IInterface)
|
||||
protected
|
||||
// IInterface
|
||||
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
|
||||
function _AddRef(): Integer; stdcall;
|
||||
function _Release(): Integer; stdcall;
|
||||
end;
|
||||
|
||||
|
||||
TUnSwUnit = class(TUnSwNoRefIntfObject, IUnSwVisited)
|
||||
protected
|
||||
function GetName(): String; virtual;
|
||||
function GetFileName(): String; virtual;
|
||||
public
|
||||
// IUnSwVisited
|
||||
procedure AcceptVisitor(const AVisitor: IUnSwVisitor); virtual; abstract;
|
||||
|
||||
procedure Activate(const ASource: Boolean); virtual; abstract;
|
||||
|
||||
property Name: String read GetName;
|
||||
property FileName: String read GetFileName;
|
||||
end;
|
||||
|
||||
|
||||
TUnSwUnitType = (
|
||||
swutForm = 0,
|
||||
@ -29,22 +68,38 @@ type
|
||||
);
|
||||
TUnSwUnitTypes = set of TUnSwUnitType;
|
||||
|
||||
TUnSwUnit = class(TPersistent)
|
||||
|
||||
TUnSwModuleUnit = class(TUnSwUnit)
|
||||
private
|
||||
FModule: IOTAModuleInfo;
|
||||
|
||||
function GetName(): String;
|
||||
function GetFileName(): String;
|
||||
protected
|
||||
function GetName(): String; override;
|
||||
function GetFileName(): String; override;
|
||||
function GetUnitType(): TUnSwUnitType;
|
||||
public
|
||||
constructor Create(const AModule: IOTAModuleInfo); virtual;
|
||||
constructor Create(const AModule: IOTAModuleInfo);
|
||||
procedure AcceptVisitor(const AVisitor: IUnSwVisitor); override;
|
||||
|
||||
procedure Activate(const ASource: Boolean); override;
|
||||
|
||||
property Name: String read GetName;
|
||||
property FileName: String read GetFileName;
|
||||
property UnitType: TUnSwUnitType read GetUnitType;
|
||||
end;
|
||||
|
||||
TUnSwUnitList = class(TPersistent)
|
||||
TUnSwProjectUnit = class(TUnSwUnit)
|
||||
private
|
||||
FProject: IOTAProject;
|
||||
protected
|
||||
function GetName(): String; override;
|
||||
function GetFileName(): String; override;
|
||||
public
|
||||
constructor Create(const AProject: IOTAProject);
|
||||
procedure AcceptVisitor(const AVisitor: IUnSwVisitor); override;
|
||||
|
||||
procedure Activate(const ASource: Boolean); override;
|
||||
end;
|
||||
|
||||
|
||||
TUnSwUnitList = class(TUnSwNoRefIntfObject, IUnSwVisited)
|
||||
private
|
||||
FItems: TObjectList;
|
||||
|
||||
@ -57,74 +112,94 @@ type
|
||||
|
||||
function Add(const AUnit: TUnSwUnit): Integer; virtual;
|
||||
function IndexOf(const AUnit: TUnSwUnit): Integer;
|
||||
procedure Sort(Compare: TListSortCompare);
|
||||
function IndexOfFileName(const AFileName: String): Integer;
|
||||
procedure Delete(const AIndex: Integer);
|
||||
function Remove(const AUnit: TUnSwUnit): Integer;
|
||||
|
||||
procedure Sort(Compare: TListSortCompare);
|
||||
procedure Clone(const ASource: TUnSwUnitList); virtual;
|
||||
procedure ApplyFilter(const AFilter: TUnSwUnitFilter); virtual;
|
||||
|
||||
procedure AcceptVisitor(const AVisitor: IUnSwVisitor);
|
||||
|
||||
property Count: Integer read GetCount;
|
||||
property Items[Index: Integer]: TUnSwUnit read GetItem
|
||||
write SetItem; default;
|
||||
end;
|
||||
|
||||
TUnSwUnitFilter = class(TObject)
|
||||
protected
|
||||
function IsFiltered(const AUnit: TUnSwUnit): Boolean; virtual; abstract;
|
||||
public
|
||||
constructor Create(); virtual;
|
||||
end;
|
||||
|
||||
TUnSwUnitSimpleFilter = class(TUnSwUnitFilter)
|
||||
private
|
||||
FFilter: String;
|
||||
|
||||
procedure SetFilter(const Value: String);
|
||||
protected
|
||||
function IsFiltered(const AUnit: TUnSwUnit): Boolean; override;
|
||||
public
|
||||
property Filter: String read FFilter write SetFilter;
|
||||
end;
|
||||
|
||||
TUnSwUnitTypeFilter = class(TUnSwUnitFilter)
|
||||
private
|
||||
FIncludeDataModules: Boolean;
|
||||
FIncludeForms: Boolean;
|
||||
FIncludeProjectSource: Boolean;
|
||||
protected
|
||||
function IsFiltered(const AUnit: TUnSwUnit): Boolean; override;
|
||||
public
|
||||
constructor Create(); override;
|
||||
|
||||
property IncludeDataModules: Boolean read FIncludeDataModules write FIncludeDataModules;
|
||||
property IncludeForms: Boolean read FIncludeForms write FIncludeForms;
|
||||
property IncludeProjectSource: Boolean read FIncludeProjectSource write FIncludeProjectSource;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
|
||||
{ TUnSwNoRefIntfObject }
|
||||
function TUnSwNoRefIntfObject.QueryInterface(const IID: TGUID; out Obj): HResult;
|
||||
begin
|
||||
if GetInterface(IID, Obj) then
|
||||
Result := S_OK
|
||||
else
|
||||
Result := E_NOINTERFACE;
|
||||
end;
|
||||
|
||||
function TUnSwNoRefIntfObject._AddRef(): Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TUnSwNoRefIntfObject._Release(): Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
|
||||
{ TUnSwUnit }
|
||||
constructor TUnSwUnit.Create(const AModule: IOTAModuleInfo);
|
||||
function TUnSwUnit.GetName(): String;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TUnSwUnit.GetFileName(): String;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
|
||||
{ TUnSwModuleUnit }
|
||||
constructor TUnSwModuleUnit.Create(const AModule: IOTAModuleInfo);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
FModule := AModule;
|
||||
end;
|
||||
|
||||
procedure TUnSwModuleUnit.Activate(const ASource: Boolean);
|
||||
var
|
||||
ifModule: IOTAModule;
|
||||
|
||||
function TUnSwUnit.GetName(): String;
|
||||
begin
|
||||
ifModule := FModule.OpenModule();
|
||||
if Assigned(ifModule) then
|
||||
if ASource then
|
||||
ifModule.ShowFilename(ifModule.FileName)
|
||||
else
|
||||
ifModule.Show();
|
||||
end;
|
||||
|
||||
procedure TUnSwModuleUnit.AcceptVisitor(const AVisitor: IUnSwVisitor);
|
||||
begin
|
||||
AVisitor.VisitModule(Self);
|
||||
end;
|
||||
|
||||
function TUnSwModuleUnit.GetName(): String;
|
||||
begin
|
||||
Result := FModule.Name;
|
||||
end;
|
||||
|
||||
function TUnSwUnit.GetFileName(): String;
|
||||
function TUnSwModuleUnit.GetFileName(): String;
|
||||
begin
|
||||
Result := FModule.FileName;
|
||||
end;
|
||||
|
||||
function TUnSwUnit.GetUnitType(): TUnSwUnitType;
|
||||
function TUnSwModuleUnit.GetUnitType(): TUnSwUnitType;
|
||||
begin
|
||||
Result := TUnSwUnitType(FModule.ModuleType);
|
||||
if (Result = swutForm) and (Length(FModule.FormName) = 0) then
|
||||
@ -132,6 +207,35 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TUnSwProjectUnit }
|
||||
constructor TUnSwProjectUnit.Create(const AProject: IOTAProject);
|
||||
begin
|
||||
inherited Create();
|
||||
|
||||
FProject := AProject;
|
||||
end;
|
||||
|
||||
procedure TUnSwProjectUnit.Activate(const ASource: Boolean);
|
||||
begin
|
||||
FProject.ShowFilename(FProject.FileName);
|
||||
end;
|
||||
|
||||
procedure TUnSwProjectUnit.AcceptVisitor(const AVisitor: IUnSwVisitor);
|
||||
begin
|
||||
AVisitor.VisitProject(Self);
|
||||
end;
|
||||
|
||||
function TUnSwProjectUnit.GetName(): String;
|
||||
begin
|
||||
Result := ChangeFileExt(ExtractFileName(FProject.FileName), '');
|
||||
end;
|
||||
|
||||
function TUnSwProjectUnit.GetFileName(): String;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
|
||||
{ TUnSwUnitList}
|
||||
constructor TUnSwUnitList.Create();
|
||||
begin
|
||||
@ -149,6 +253,15 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TUnSwUnitList.AcceptVisitor(const AVisitor: IUnSwVisitor);
|
||||
var
|
||||
iItem: Integer;
|
||||
|
||||
begin
|
||||
for iItem := Pred(Count) downto 0 do
|
||||
Items[iItem].AcceptVisitor(AVisitor);
|
||||
end;
|
||||
|
||||
function TUnSwUnitList.Add(const AUnit: TUnSwUnit): Integer;
|
||||
begin
|
||||
Result := FItems.Add(AUnit);
|
||||
@ -159,20 +272,36 @@ begin
|
||||
Result := FItems.IndexOf(AUnit);
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitList.Sort(Compare: TListSortCompare);
|
||||
begin
|
||||
FItems.Sort(Compare);
|
||||
end;
|
||||
|
||||
|
||||
procedure TUnSwUnitList.ApplyFilter(const AFilter: TUnSwUnitFilter);
|
||||
function TUnSwUnitList.IndexOfFileName(const AFileName: String): Integer;
|
||||
var
|
||||
iItem: Integer;
|
||||
|
||||
begin
|
||||
Result := -1;
|
||||
if Length(AFileName) = 0 then
|
||||
exit;
|
||||
|
||||
for iItem := Pred(Count) downto 0 do
|
||||
if AFilter.IsFiltered(Items[iItem]) then
|
||||
FItems.Delete(iItem);
|
||||
if SameText(Items[iItem].FileName, AFileName) then
|
||||
begin
|
||||
Result := iItem;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitList.Delete(const AIndex: Integer);
|
||||
begin
|
||||
FItems.Delete(AIndex);
|
||||
end;
|
||||
|
||||
function TUnSwUnitList.Remove(const AUnit: TUnSwUnit): Integer;
|
||||
begin
|
||||
Result := FItems.Remove(AUnit);
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitList.Sort(Compare: TListSortCompare);
|
||||
begin
|
||||
FItems.Sort(Compare);
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitList.Clone(const ASource: TUnSwUnitList);
|
||||
@ -203,54 +332,4 @@ begin
|
||||
FItems[Index] := Value;
|
||||
end;
|
||||
|
||||
|
||||
{ TUnSwUnitFilter }
|
||||
constructor TUnSwUnitFilter.Create();
|
||||
begin
|
||||
inherited Create();
|
||||
end;
|
||||
|
||||
|
||||
{ TUnSwUnitSimpleFilter }
|
||||
function TUnSwUnitSimpleFilter.IsFiltered(const AUnit: TUnSwUnit): Boolean;
|
||||
begin
|
||||
Result := (Length(FFilter) > 0) and
|
||||
(AnsiPos(FFilter, LowerCase(AUnit.Name)) = 0);
|
||||
end;
|
||||
|
||||
procedure TUnSwUnitSimpleFilter.SetFilter(const Value: String);
|
||||
begin
|
||||
FFilter := LowerCase(Value);
|
||||
end;
|
||||
|
||||
|
||||
{ TUnSwUnitTypeFilter }
|
||||
constructor TUnSwUnitTypeFilter.Create();
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FIncludeDataModules := True;
|
||||
FIncludeForms := True;
|
||||
FIncludeProjectSource := True;
|
||||
end;
|
||||
|
||||
function TUnSwUnitTypeFilter.IsFiltered(const AUnit: TUnSwUnit): Boolean;
|
||||
var
|
||||
eValidTypes: TUnSwUnitTypes;
|
||||
|
||||
begin
|
||||
eValidTypes := [swutUnit];
|
||||
|
||||
if FIncludeDataModules then
|
||||
Include(eValidTypes, swutDataModule);
|
||||
|
||||
if FIncludeForms then
|
||||
Include(eValidTypes, swutForm);
|
||||
|
||||
if FIncludeProjectSource then
|
||||
Include(eValidTypes, swutProjUnit);
|
||||
|
||||
Result := not (AUnit.UnitType in eValidTypes);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user