GitHub-Mirror/unitswitcher
1
0
Fork 0
mirror of synced 2024-11-15 00:43:50 +00:00
Code Issues Projects Releases Wiki Activity

Initial refactoring to support ComponentSwitcher

Browse Source
This commit is contained in:
Mark van Renswoude 2007-12-07 15:33:00 +00:00
parent 82485ca0a0
commit ec7bcfeb28
14 changed files with 2338 additions and 288 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Packages/D7/UnitSwitcher.dof
View File

@ -105,6 +105,10 @@ HostApplication=
Launcher= Launcher=
UseLauncher=0 UseLauncher=0
DebugCWD= DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info] [Version Info]
IncludeVerInfo=1 IncludeVerInfo=1
AutoIncBuild=0 AutoIncBuild=0

8
Packages/D7/UnitSwitcher.dpk
View File

@ -41,6 +41,12 @@ contains
UnSwFilters in '..\..\Source\UnSwFilters.pas', UnSwFilters in '..\..\Source\UnSwFilters.pas',
UnSwSettings in '..\..\Source\UnSwSettings.pas', UnSwSettings in '..\..\Source\UnSwSettings.pas',
UnSwConfiguration in '..\..\Source\UnSwConfiguration.pas' {frmUnSwConfiguration}, UnSwConfiguration in '..\..\Source\UnSwConfiguration.pas' {frmUnSwConfiguration},
UnSwShortcuts in '..\..\Source\UnSwShortcuts.pas' {frmUnSwShortcuts}; UnSwShortcuts in '..\..\Source\UnSwShortcuts.pas' {frmUnSwShortcuts},
CmpSwClient in '..\..\Source\CmpSwClient.pas',
BaseSwClient in '..\..\Source\BaseSwClient.pas',
UnSwReg in '..\..\Source\UnSwReg.pas',
BaseSwObjects in '..\..\Source\BaseSwObjects.pas',
BaseSwFilters in '..\..\Source\BaseSwFilters.pas',
BaseSwDialog in '..\..\Source\BaseSwDialog.pas' {frmBaseSwDialog};
end. end.

193
Source/BaseSwClient.pas Normal file
View File

@ -0,0 +1,193 @@
{: Provides a base for hooking IDE actions.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
{$ASSERTIONS ON}
unit BaseSwClient;
interface
uses
ActnList,
Classes;
type
PHookedAction = ^THookedAction;
THookedAction = record
Action: TContainedAction;
OldOnExecute: TNotifyEvent;
NewOnExecute: TNotifyEvent;
end;
TBaseSwitcherHook = class(TObject)
private
FHookedActions: TList;
protected
function GetHookedActionIndex(AAction: TContainedAction): Integer;
function GetHookedAction(AAction: TContainedAction): PHookedAction;
procedure HookAction(AAction: TContainedAction; AOnExecute: TNotifyEvent);
function HookIDEAction(const AName: String; AOnExecute: TNotifyEvent): TContainedAction;
procedure UnhookActionIndex(AIndex: Integer);
procedure UnhookAction(AAction: TContainedAction);
procedure OldActionExecute(AAction: TObject);
public
constructor Create();
destructor Destroy(); override;
end;
implementation
uses
SysUtils,
ToolsAPI;
{ TBaseSwitcherHook }
constructor TBaseSwitcherHook.Create();
begin
inherited;
FHookedActions := TList.Create();
end;
destructor TBaseSwitcherHook.Destroy();
var
actionIndex: Integer;
begin
for actionIndex := Pred(FHookedActions.Count) downto 0 do
UnhookActionIndex(actionIndex);
FreeAndNil(FHookedActions);
inherited;
end;
function TBaseSwitcherHook.GetHookedActionIndex(AAction: TContainedAction): Integer;
var
actionIndex: Integer;
begin
Result := -1;
for actionIndex := Pred(FHookedActions.Count) downto 0 do
if PHookedAction(FHookedActions[actionIndex]).Action = AAction then
begin
Result := actionIndex;
Break;
end;
end;
function TBaseSwitcherHook.GetHookedAction(AAction: TContainedAction): PHookedAction;
var
actionIndex: Integer;
begin
Result := nil;
actionIndex := GetHookedActionIndex(AAction);
if actionIndex > -1 then
Result := FHookedActions[actionIndex];
end;
procedure TBaseSwitcherHook.HookAction(AAction: TContainedAction; AOnExecute: TNotifyEvent);
var
hookedAction: PHookedAction;
begin
Assert(GetHookedActionIndex(AAction) = -1, 'Action is already hooked');
New(hookedAction);
hookedAction^.Action := AAction;
hookedAction^.OldOnExecute := AAction.OnExecute;
hookedAction^.NewOnExecute := AOnExecute;
FHookedActions.Add(hookedAction);
AAction.OnExecute := AOnExecute;
end;
function TBaseSwitcherHook.HookIDEAction(const AName: String; AOnExecute: TNotifyEvent): TContainedAction;
var
actionIndex: Integer;
ntaServices: INTAServices;
action: TContainedAction;
begin
Result := nil;
Assert(Assigned(BorlandIDEServices), 'BorlandIDEServices not available.');
Assert(Supports(BorlandIDEServices, INTAServices, ntaServices),
'BorlandIDEServices does not support the ' +
'INTAServices interface.');
for actionIndex := 0 to Pred(ntaServices.ActionList.ActionCount) do
begin
action := ntaServices.ActionList.Actions[actionIndex];
if action.Name = AName then
begin
Result := action;
HookAction(action, AOnExecute);
Break;
end;
end;
Assert(Assigned(Result), AName + ' action is not available in the IDE.');
end;
procedure TBaseSwitcherHook.UnhookActionIndex(AIndex: Integer);
var
hookedAction: PHookedAction;
action: TContainedAction;
// onExecute: TNotifyEvent;
begin
hookedAction := FHookedActions[AIndex];
action := TContainedAction(hookedAction^.Action);
// onExecute := action.OnExecute;
// if onExecute = hookedAction^.NewOnExecute then
action.OnExecute := hookedAction^.OldOnExecute;
Dispose(hookedAction);
FHookedActions.Delete(AIndex);
end;
procedure TBaseSwitcherHook.UnhookAction(AAction: TContainedAction);
var
actionIndex: Integer;
begin
actionIndex := GetHookedActionIndex(AAction);
if actionIndex > -1 then
UnhookActionIndex(actionIndex);
end;
procedure TBaseSwitcherHook.OldActionExecute(AAction: TObject);
var
hookedAction: PHookedAction;
begin
if AAction is TContainedAction then
begin
hookedAction := GetHookedAction(TContainedAction(AAction));
if Assigned(hookedAction) and Assigned(hookedAction^.NewOnExecute) then
hookedAction^.NewOnExecute(AAction);
end;
end;
end.

0
Source/UnSwDefines.inc → Source/BaseSwDefines.inc
View File

636
Source/BaseSwDialog.dfm Normal file
View File

@ -0,0 +1,636 @@
object frmBaseSwDialog: TfrmBaseSwDialog
Left = 284
Top = 120
Width = 320
Height = 425
BorderIcons = [biSystemMenu]
Caption = 'UnitSwitcher'
Color = clBtnFace
Constraints.MinHeight = 240
Constraints.MinWidth = 290
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Icon.Data = {
0000010001001010100001000400280100001600000028000000100000002000
0000010004000000000080000000000000000000000000000000000000000000
000000008000008000000080800080000000800080008080000080808000C0C0
C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF000000
0000000000000000F777777777700000FF8F8F8F8F700000F8F8F8F8F8700000
FF0000000F700000F8F8F8F8F8700000F999999999700400F9FFFFFFF9700000
F999999999700000F8F8F8F8F8700000FF0000008F700000F8F8F8F8F7700000
FF00008F00000000F8F8F8F80F000000FFFFFFFF00000000000000000000E000
0000E0000000E0000000E0000000E00000006000000020000000000000002000
000060000000E0000000E0000000E0000000E0010000E0030000E0070000}
OldCreateOrder = False
Position = poScreenCenter
OnResize = FormResize
PixelsPerInch = 96
TextHeight = 13
object sbStatus: TStatusBar
Left = 0
Top = 379
Width = 312
Height = 19
Panels = <
item
Width = 50
end>
end
object pnlMain: TPanel
Left = 0
Top = 0
Width = 312
Height = 343
Align = alClient
BevelOuter = bvNone
BorderWidth = 4
TabOrder = 0
object pnlSearch: TPanel
Left = 4
Top = 24
Width = 304
Height = 25
Align = alTop
BevelOuter = bvNone
TabOrder = 0
DesignSize = (
304
25)
object cmbSearch: TComboBox
Left = 0
Top = 0
Width = 304
Height = 21
AutoComplete = False
Anchors = [akLeft, akTop, akRight]
DropDownCount = 10
ItemHeight = 13
TabOrder = 0
OnChange = cmbSearchChange
OnKeyDown = cmbSearchKeyDown
OnKeyPress = cmbSearchKeyPress
end
end
object lstItems: TListBox
Left = 4
Top = 49
Width = 304
Height = 290
Style = lbVirtualOwnerDraw
Align = alClient
ItemHeight = 20
MultiSelect = True
PopupMenu = pmnUnits
TabOrder = 1
OnClick = lstItemsClick
OnData = lstItemsData
OnDblClick = lstItemsDblClick
OnDrawItem = lstItemsDrawItem
OnMouseDown = lstItemsMouseDown
end
object pnlSubFilters: TPanel
Left = 4
Top = 4
Width = 304
Height = 20
Align = alTop
BevelOuter = bvNone
TabOrder = 2
Visible = False
DesignSize = (
304
20)
object lblSubFilters: TLabel
Left = 0
Top = 1
Width = 305
Height = 13
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = 'frm '#187' Dialog '#187
end
end
end
object pnlButtons: TPanel
Left = 0
Top = 343
Width = 312
Height = 36
Align = alBottom
BevelOuter = bvNone
TabOrder = 1
DesignSize = (
312
36)
object btnCancel: TButton
Left = 233
Top = 5
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object btnOK: TButton
Left = 152
Top = 5
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
TabOrder = 0
OnClick = btnOKClick
end
end
object ilsTypes: TImageList
Left = 28
Top = 228
Bitmap = {
494C010106000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000003000000001002000000000000030
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000C0C0C000C0C0C000C0C0C000C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00808080008080
8000808080008080800080808000808080008080800080808000808080008080
8000808080000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000800000008000C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00FFFFFF00C0C0
C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000808080000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF00C0C0C000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00FFFFFF00C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00FFFFFF00C0C0
C000FFFFFF00C0C0C000FFFFFF0000000000FFFFFF0080808000808080008080
8000808080008080800080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000800000008000C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF00C0C0C00000000000FFFFFF00FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00FFFFFF00C0C0
C000FFFFFF00C0C0C000FFFFFF0000000000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C00080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF00C0C0C00000000000FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00FFFFFF00C0C0
C000FFFFFF00C0C0C000FFFFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF00C0C0C00000000000FF000000FF000000FF000000FF00
0000FF00000000000000C0C0C000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00FFFFFF00C0C0
C000FFFFFF00C0C0C000FFFFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00FFFFFF00C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00808080000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FF000000FF000000FF00
0000FF000000FF000000FF00000000000000C0C0C00000000000C0C0C0000000
0000C0C0C0000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000008000
0000000000000000000080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF008080800080808000808080008080800080808000808080008080
8000808080008080800080808000000000000000000000000000000000000000
0000FFFFFF008080800080808000808080008080800080808000808080008080
8000808080008080800080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000080000000800000008000
0000800000000000000080808000C0C0C000C0C0C000C0C0C000C0C0C0000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000080000000000000008000
0000000000000000000080808000808080008080800000000000808080008080
8000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C00080808000000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C000808080000000000000000000FFFFFF00808080008080
8000808080008080800080808000808080008080800080808000808080008080
8000808080008080800080808000000000000000000080000000000000000000
0000000000000000000000000000000000008080800000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
0000FFFFFF00FFFFFF0000000000000000000000000000000000000000000000
000000000000FFFFFF00808080000000000000000000FFFFFF00FFFFFF00C0C0
C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C00080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C00080808000000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C000808080000000000000000000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000008080800000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
0000FFFFFF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF00808080000000000000000000FFFFFF00FFFFFF00C0C0
C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C00080808000000000008080800080808000000000000000
000000000000FFFFFF0080808000808080008080800080808000808080008080
8000808080008080800080808000000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C00080808000000000000000000080000000000000000000
0000FFFFFF000000FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF000000FF00808080000000000000000000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
000000000000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
0000FFFFFF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF00808080000000000000000000FFFFFF00FFFFFF00C0C0
C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C00080808000000000000000000000000000000000000000
000000000000FFFFFF00FFFFFF00C0C0C0000000FF000000FF000000FF00C0C0
C000FFFFFF00C0C0C00080808000000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C00080808000000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C000808080000000000000000000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
000000000000FFFFFF00C0C0C000FFFFFF000000FF000000FF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
0000FFFFFF00FFFFFF0000000000000000000000000000000000000000000000
0000C0C0C000FFFFFF00808080000000000000000000FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000
000000000000FFFFFF00FFFFFF00C0C0C0000000FF00C0C0C0000000FF000000
FF00FFFFFF00C0C0C00080808000000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF00C0C0C00080808000000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C000FFFFFF008080800080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFF
FF00000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF0000000000000000000000000000000000C0C0C000FFFF
FF000000000000000000000000000000000000000000FF000000FF000000FF00
0000FF000000FF000000FF000000FF000000FF00000000000000C0C0C0000000
0000C0C0C00000000000C0C0C000000000000000000000000000000000000000
000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C00000000000FFFFFF0000000000000000000000000000000000000000000000
0000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0
C00000000000FFFFFF0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000FF000000FF000000FF000000FF00000000000000C0C0C0000000
0000C0C0C00000000000C0C0C000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000040000000300000000100010000000000800100000000000000000000
000000000000000000000000FFFFFF0000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000003FFF0000000000003FFF000000000
0003FFF0000000000000FFF0000000000000FFF0000000000000FFF000000000
0000FFF0000000000000FFF0000000000000FFF0000000000000FFF000000000
0000FFF0000000000003FFFF000000000003FFFF000000000003FFFF00000000
0003FFFF000000000003FFFF00000000E000E000FFFFEC0FE000E000FFFF840F
E000E0000000AC0FE000E0000000BF3FE000E0000000FFFFE000600000001000
E000200000001000E00000000000B000E00020000000F000E00060000000F000
E000E0000000F000E000E0000000F000E000E0000000F000E001E0010000F000
E003E003FFFFF000E007E007FFFFF00000000000000000000000000000000000
000000000000}
end
object alMain: TActionList
Left = 84
Top = 228
object actSelectAll: TAction
Caption = 'Select &All'
ShortCut = 16449
OnExecute = actSelectAllExecute
end
object actSelectInvert: TAction
Caption = '&Invert Selection'
ShortCut = 16457
OnExecute = actSelectInvertExecute
end
object actMRUPrior: TAction
Caption = 'actMRUPrior'
ShortCut = 16422
OnExecute = actMRUPriorExecute
end
object actMRUNext: TAction
Caption = 'actMRUNext'
ShortCut = 16424
OnExecute = actMRUNextExecute
end
end
object pmnUnits: TPopupMenu
Left = 140
Top = 228
object pmnUnitsOpen: TMenuItem
Caption = '&Open'
ShortCut = 13
end
object pmnUnitsOpenDFM: TMenuItem
Caption = 'Open D&FM'
ShortCut = 8205
end
object pmnUnitsSep1: TMenuItem
Caption = '-'
end
object pmnUnitsSelectAll: TMenuItem
Action = actSelectAll
end
object pmnUnitsSelectInvert: TMenuItem
Action = actSelectInvert
end
object pmnUnitsSep2: TMenuItem
Caption = '-'
end
object pmnUnitsSortByName: TMenuItem
Caption = 'Sort by &Name'
ShortCut = 49230
end
object pmnUnitsSortByType: TMenuItem
Caption = 'Sort by &Type'
ShortCut = 49236
end
object pmnUnitsSep3: TMenuItem
Caption = '-'
end
object pmnUnitsReadOnly: TMenuItem
Caption = '&Read only'
ShortCut = 49234
end
object pmnUnitsSep4: TMenuItem
Caption = '-'
end
object pmnUnitsOpenFolder: TMenuItem
Caption = 'Open containing &folder'
ShortCut = 49222
end
object pmnUnitsOpenProperties: TMenuItem
Caption = '.PAS &Properties'
ShortCut = 49165
end
object pmnUnitsOpenDFMProperties: TMenuItem
Caption = '.&DFM Properties'
ShortCut = 24589
end
end
end

860
Source/BaseSwDialog.pas Normal file
View File

@ -0,0 +1,860 @@
{: Contains the base Switcher dialog.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit BaseSwDialog;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ActnList,
Classes,
ComCtrls,
Controls,
ExtCtrls,
Forms,
Graphics,
ImgList,
Menus,
StdCtrls,
Windows,
BaseSwFilters,
BaseSwObjects;
type
TBaseSwStyleVisitor = class(TInterfacedPersistent, IBaseSwVisitor)
private
FColor: TColor;
FImageIndex: Integer;
FOverlayIndex: Integer;
protected
procedure VisitItem(const AItem: TBaseSwItem);
public
property Color: TColor read FColor write FColor;
property ImageIndex: Integer read FImageIndex write FImageIndex;
property OverlayIndex: Integer read FOverlayIndex write FOverlayIndex;
end;
TfrmBaseSwDialog = class(TForm)
actMRUNext: TAction;
actMRUPrior: TAction;
actSelectAll: TAction;
actSelectInvert: TAction;
alMain: TActionList;
btnCancel: TButton;
btnOK: TButton;
cmbSearch: TComboBox;
ilsTypes: TImageList;
lblSubFilters: TLabel;
lstItems: TListBox;
pmnUnits: TPopupMenu;
pmnUnitsOpen: TMenuItem;
pmnUnitsOpenDFM: TMenuItem;
pmnUnitsOpenDFMProperties: TMenuItem;
pmnUnitsOpenFolder: TMenuItem;
pmnUnitsOpenProperties: TMenuItem;
pmnUnitsReadOnly: TMenuItem;
pmnUnitsSelectAll: TMenuItem;
pmnUnitsSelectInvert: TMenuItem;
pmnUnitsSep1: TMenuItem;
pmnUnitsSep2: TMenuItem;
pmnUnitsSep3: TMenuItem;
pmnUnitsSep4: TMenuItem;
pmnUnitsSortByName: TMenuItem;
pmnUnitsSortByType: TMenuItem;
pnlButtons: TPanel;
pnlMain: TPanel;
pnlSearch: TPanel;
pnlSubFilters: TPanel;
sbStatus: TStatusBar;
procedure actMRUNextExecute(Sender: TObject);
procedure actMRUPriorExecute(Sender: TObject);
procedure actSelectAllExecute(Sender: TObject);
procedure actSelectInvertExecute(Sender: TObject);
procedure cmbSearchChange(Sender: TObject);
procedure cmbSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure cmbSearchKeyPress(Sender: TObject; var Key: Char);
procedure FormResize(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure lstItemsClick(Sender: TObject);
procedure lstItemsData(Control: TWinControl; Index: Integer; var Data: string);
procedure lstItemsDblClick(Sender: TObject);
procedure lstItemsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure lstItemsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure btnOKClick(Sender: TObject);
private
FLoading: Boolean;
FItemList: TBaseSwItemList;
FActiveItem: TBaseSwItem;
FFormsOnly: Boolean;
FMRUList: TStrings;
FMRUIndex: Integer;
FSubFilters: TStringList;
FOpenDFM: Boolean;
// FTypeFilteredList: TUnSwUnitList;
FSubFilteredList: TBaseSwItemList;
FInputFilteredList: TBaseSwItemList;
// FTypeFilter: TUnSwUnitTypeFilter;
FSubFilter: TBaseSwItemSimpleFilter;
FInputFilter: TBaseSwItemSimpleFilter;
FLastFilter: String;
FStyleVisitor: TBaseSwStyleVisitor;
protected
function InternalExecute(): TBaseSwItemList; virtual;
// procedure UpdateTypeFilter();
procedure UpdateList(); virtual;
function GetActiveItems(): TBaseSwItemList;
procedure SelectMRUItem();
function PushFilter(const AFilter: String): Boolean;
procedure PopFilter();
procedure UpdateSubFilters();
procedure LoadSettings(); virtual;
procedure SaveSettings(); virtual;
procedure UpdateUnitActions();
public
class function Execute(const AItems: TBaseSwItemList; const AActive: TBaseSwItem = nil): TBaseSwItemList;
end;
implementation
uses
SysUtils;
const
SubFilterSeparator = ' '#187' ';
{$R *.dfm}
{ TBaseSwStyleVisitor }
procedure TBaseSwStyleVisitor.VisitItem(const AItem: TBaseSwItem);
begin
Color := clDefault;
ImageIndex := -1;
OverlayIndex := -1;
end;
{ TfrmUnSwDialog }
class function TfrmBaseSwDialog.Execute(const AItems: TBaseSwItemList;
const AActive: TBaseSwItem): TBaseSwItemList;
begin
with Self.Create(nil) do
try
FItemList := AItems;
FActiveItem := AActive;
Result := InternalExecute();
finally
Free();
end;
end;
procedure TfrmBaseSwDialog.FormResize(Sender: TObject);
begin
lstItems.Invalidate();
end;
function TfrmBaseSwDialog.InternalExecute(): TBaseSwItemList;
type
TBaseSwItemSimpleFilterClass = class of TBaseSwItemSimpleFilter;
var
iIndex: Integer;
mruText: String;
subFilterIndex: Integer;
begin
Result := nil;
FSubFilters := TStringList.Create();
// FTypeFilteredList := TUnSwUnitList.Create();
FSubFilteredList := TBaseSwItemList.Create();
FInputFilteredList := TBaseSwItemList.Create();
// FTypeFilter := TUnSwUnitTypeFilter.Create;
try
FStyleVisitor := TUnSwStyleVisitor.Create();
try
if Self.ShowModal() = mrOk then
begin
if Length(Trim(cmbSearch.Text)) > 0 then
begin
iIndex := FMRUList.IndexOf(cmbSearch.Text);
if iIndex > -1 then
FMRUList.Delete(iIndex);
while FMRUList.Count >= 10 do
FMRUList.Delete(Pred(FMRUList.Count));
mruText := cmbSearch.Text;
for subFilterIndex := Pred(FSubFilters.Count) downto 0 do
mruText := FSubFilters[subFilterIndex] + SubFilterSeparator;
FMRUList.Insert(0, mruText);
end;
Result := GetActiveUnits();
end;
SaveSettings();
finally
FreeAndNil(FStyleVisitor);
end;
finally
FreeAndNil(FInputFilter);
FreeAndNil(FSubFilter);
// FreeAndNil(FTypeFilter);
FreeAndNil(FSubFilteredList);
FreeAndNil(FInputFilteredList);
// FreeAndNil(FTypeFilteredList);
FreeAndNil(FSubFilters);
end;
end;
procedure TfrmBaseSwDialog.UpdateUnitActions();
var
bDFM: Boolean;
bUnits: Boolean;
iUnit: Integer;
pUnits: TUnSwUnitList;
pVisitor: TUnSwReadOnlyVisitor;
sStatus: String;
begin
{ Read-only status }
pUnits := GetActiveUnits();
if Assigned(pUnits) then
try
pVisitor := TUnSwReadOnlyVisitor.Create();
try
pUnits.AcceptVisitor(pVisitor);
actReadOnly.Checked := (pVisitor.ReadOnlyCount > 0);
sStatus := '';
if pVisitor.ReadOnlyCount > 0 then
if pVisitor.ReadOnlyCount = 1 then
sStatus := '1 read-only unit selected'
else
sStatus := Format('%d read-only units selected',
[pVisitor.ReadOnlyCount]);
sbStatus.Panels[0].Text := sStatus;
finally
FreeAndNil(pVisitor);
end;
finally
FreeAndNil(pUnits);
end;
{ Properties }
bDFM := False;
bUnits := False;
pUnits := GetActiveUnits();
if Assigned(pUnits) then
try
bUnits := (pUnits.Count > 0);
for iUnit := 0 to Pred(pUnits.Count) do
if (pUnits[iUnit] is TUnSwModuleUnit) and
(TUnSwModuleUnit(pUnits[iUnit]).UnitType in [swutForm, swutDataModule]) then
begin
bDFM := True;
break;
end;
finally
FreeAndNil(pUnits);
end;
actOpenFolder.Enabled := bUnits;
actOpenProperties.Enabled := bUnits;
actOpenDFMProperties.Enabled := bDFM;
end;
procedure TfrmBaseSwDialog.UpdateList();
var
activeUnit: TUnSwUnit;
activeUnits: TUnSwUnitList;
itemIndex: Integer;
listIndex: Integer;
filteredList: TUnSwUnitList;
selStart: Integer;
begin
activeUnits := GetActiveUnits();
filteredList := TUnSwUnitList.Create();
try
filteredList.Clone(FSubFilteredList);
FInputFilter.FilterList(filteredList);
if (filteredList.Count = 0) and (not Settings.Filter.AllowEmptyResult) then
begin
{ Only enforce AllowEmptyResult when adding to the filter }
if Length(FInputFilter.Filter) > Length(FLastFilter) then
begin
FInputFilter.Filter := FLastFilter;
selStart := cmbSearch.SelStart;
cmbSearch.Text := FLastFilter;
cmbSearch.SelStart := selStart;
Exit;
end;
end;
FLastFilter := FInputFilter.Filter;
FInputFilteredList.Clone(filteredList);
finally
FreeAndNil(filteredList);
end;
lstItems.Count := FInputFilteredList.Count;
if FInputFilteredList.Count > 0 then
begin
lstItems.ClearSelection();
if Assigned(activeUnits) then
try
for itemIndex := 0 to Pred(activeUnits.Count) do
begin
activeUnit := activeUnits[itemIndex];
listIndex := FInputFilteredList.IndexOf(activeUnit);
if listIndex > -1 then
lstItems.Selected[listIndex] := True;
end;
finally
FreeAndNil(activeUnits);
end;
if lstItems.SelCount = 0 then
lstItems.Selected[0] := True;
end;
if Assigned(lstItems.OnClick) then
lstItems.OnClick(nil);
end;
function SortByName(Item1, Item2: Pointer): Integer;
begin
Result := CompareText(TUnSwUnit(Item1).Name, TUnSwUnit(Item2).Name)
end;
function SortByType(Item1, Item2: Pointer): Integer;
const
Above = -1;
Equal = 0;
Below = 1;
function SortByModuleType(Item1, Item2: TUnSwUnitType): Integer;
begin
Result := Equal;
if Item1 <> Item2 then
case Item1 of
swutForm:
case Item2 of
swutDataModule: Result := Below;
swutUnit: Result := Above;
end;
swutDataModule: Result := Above;
swutUnit: Result := Below;
end;
end;
var
pItem1: TUnSwUnit;
pItem2: TUnSwUnit;
begin
// #ToDo3 Refactor SortByType
// The following order is assumed:
// Project source, DataModules, Forms, Units
Result := Equal;
pItem1 := TUnSwUnit(Item1);
pItem2 := TUnSwUnit(Item2);
if pItem1.ClassType <> pItem2.ClassType then
begin
if pItem1 is TUnSwProjectUnit then
Result := Above
else if pItem2 is TUnSwProjectUnit then
Result := Below;
end else if pItem1 is TUnSwModuleUnit then
Result := SortByModuleType(TUnSwModuleUnit(pItem1).UnitType,
TUnSwModuleUnit(pItem2).UnitType);
if Result = Equal then
Result := SortByName(Item1, Item2);
end;
procedure TfrmBaseSwDialog.UpdateTypeFilter();
begin
FTypeFilter.IncludeUnits := ((not FFormsOnly) and chkUnits.Checked);
FTypeFilter.IncludeProjectSource := ((not FFormsOnly) and chkProjectSource.Checked);
FTypeFilter.IncludeForms := chkForms.Checked;
FTypeFilter.IncludeDataModules := chkDataModules.Checked;
FTypeFilteredList.Clone(FUnitList);
FTypeFilter.FilterList(FTypeFilteredList);
if actSortByName.Checked then
FTypeFilteredList.Sort(SortByName)
else
FTypeFilteredList.Sort(SortByType);
UpdateSubFilters();
end;
procedure TfrmBaseSwDialog.PopFilter();
begin
if FSubFilters.Count > 0 then
begin
FSubFilters.Delete(Pred(FSubFilters.Count));
UpdateSubFilters();
end;
end;
procedure TfrmBaseSwDialog.UpdateSubFilters();
var
iFilter: Integer;
sFilters: String;
begin
FSubFilteredList.Clone(FTypeFilteredList);
if FSubFilters.Count > 0 then
begin
for iFilter := 0 to Pred(FSubFilters.Count) do
begin
sFilters := sFilters + FSubFilters[iFilter] + SubFilterSeparator;
FSubFilter.Filter := FSubFilters[iFilter];
FSubFilter.FilterList(FSubFilteredList);
end;
lblSubFilters.Caption := Trim(sFilters);
pnlSubFilters.Visible := True;
end else
pnlSubFilters.Visible := False;
UpdateList();
end;
function TfrmBaseSwDialog.PushFilter(const AFilter: String): Boolean;
var
sFilter: String;
begin
sFilter := Trim(AFilter);
Result := (Length(sFilter) > 0) and (FSubFilters.IndexOf(AFilter) = -1);
if Result then
begin
FSubFilters.Add(AFilter);
UpdateSubFilters();
end;
end;
function TfrmBaseSwDialog.GetActiveUnits(): TUnSwUnitList;
var
itemIndex: Integer;
begin
Result := nil;
if Assigned(FActiveUnit) then
begin
Result := TUnSwUnitList.Create();
Result.OwnsObjects := False;
Result.Add(FActiveUnit);
FActiveUnit := nil;
end else if lstItems.SelCount > 0 then
begin
Result := TUnSwUnitList.Create();
Result.OwnsObjects := False;
for itemIndex := 0 to Pred(lstItems.Items.Count) do
if lstItems.Selected[itemIndex] then
Result.Add(FInputFilteredList[itemIndex]);
end;
end;
procedure TfrmBaseSwDialog.LoadSettings();
var
dialogSettings: TUnSwDialogSettings;
begin
if FFormsOnly then
dialogSettings := Settings.FormsDialog
else
dialogSettings := Settings.UnitsDialog;
FLoading := True;
try
chkDataModules.Checked := dialogSettings.IncludeDataModules;
chkForms.Checked := dialogSettings.IncludeForms;
chkUnits.Checked := dialogSettings.IncludeUnits;
chkProjectSource.Checked := dialogSettings.IncludeProjectSource;
case dialogSettings.Sort of
dsName: actSortByName.Checked := True;
dsType: actSortByType.Checked := True;
end;
FMRUList := dialogSettings.MRUList;
cmbSearch.Items.Assign(FMRUList);
Self.ClientWidth := dialogSettings.Width;
Self.ClientHeight := dialogSettings.Height;
finally
FLoading := False;
end;
end;
procedure TfrmBaseSwDialog.SaveSettings();
var
dialogSettings: TUnSwDialogSettings;
begin
if FFormsOnly then
dialogSettings := Settings.FormsDialog
else
dialogSettings := Settings.UnitsDialog;
dialogSettings.IncludeDataModules := chkDataModules.Checked;
dialogSettings.IncludeForms := chkForms.Checked;
dialogSettings.IncludeUnits := chkUnits.Checked;
dialogSettings.IncludeProjectSource := chkProjectSource.Checked;
if actSortByName.Checked then
dialogSettings.Sort := dsName
else
dialogSettings.Sort := dsType;
dialogSettings.Width := Self.ClientWidth;
dialogSettings.Height := Self.ClientHeight;
Settings.Save();
end;
procedure TfrmBaseSwDialog.actSelectAllExecute(Sender: TObject);
begin
lstItems.SelectAll();
end;
procedure TfrmBaseSwDialog.actSelectInvertExecute(Sender: TObject);
var
iItem: Integer;
begin
for iItem := Pred(lstItems.Count) downto 0 do
lstItems.Selected[iItem] := not lstItems.Selected[iItem];
end;
procedure TfrmBaseSwDialog.SortExecute(Sender: TObject);
begin
(Sender as TAction).Checked := True;
UpdateTypeFilter();
end;
procedure TfrmBaseSwDialog.SelectMRUItem();
var
mruText: String;
begin
mruText := FMRUList[FMRUIndex];
cmbSearch.ItemIndex := FMRUIndex;
ActiveControl := cmbSearch;
cmbSearch.SelectAll();
if Assigned(cmbSearch.OnChange) then
cmbSearch.OnChange(nil);
end;
procedure TfrmBaseSwDialog.actMRUNextExecute(Sender: TObject);
begin
if FMRUIndex < Pred(FMRUList.Count) then
Inc(FMRUIndex);
SelectMRUItem();
end;
procedure TfrmBaseSwDialog.actMRUPriorExecute(Sender: TObject);
begin
if FMRUIndex >= -1 then
Dec(FMRUIndex);
SelectMRUItem();
end;
procedure TfrmBaseSwDialog.actOpenFolderExecute(Sender: TObject);
var
pUnits: TUnSwUnitList;
begin
pUnits := GetActiveUnits();
if Assigned(pUnits) then
try
pUnits.AcceptVisitor(TUnSwOpenFolderVisitor.Create());
finally
FreeAndNil(pUnits);
end;
end;
procedure TfrmBaseSwDialog.actOpenPropertiesExecute(Sender: TObject);
var
pUnits: TUnSwUnitList;
begin
pUnits := GetActiveUnits();
if Assigned(pUnits) then
try
pUnits.AcceptVisitor(TUnSwOpenPropertiesVisitor.Create());
finally
FreeAndNil(pUnits);
end;
end;
procedure TfrmBaseSwDialog.actOpenDFMPropertiesExecute(Sender: TObject);
var
pUnits: TUnSwUnitList;
begin
pUnits := GetActiveUnits();
if Assigned(pUnits) then
try
pUnits.AcceptVisitor(TUnSwOpenDFMPropertiesVisitor.Create());
finally
FreeAndNil(pUnits);
end;
end;
procedure TfrmBaseSwDialog.btnConfigurationClick(Sender: TObject);
begin
if TfrmUnSwConfiguration.Execute() then
lstItems.Invalidate();
end;
procedure TfrmBaseSwDialog.cmbSearchChange(Sender: TObject);
begin
if cmbSearch.Text <> FInputFilter.Filter then
begin
FInputFilter.Filter := cmbSearch.Text;
UpdateList();
end;
end;
procedure TfrmBaseSwDialog.cmbSearchKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if not cmbSearch.DroppedDown then
if ((Shift = []) and (Key in [VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT])) or
((Shift = [ssCtrl]) and (Key in [VK_HOME, VK_END])) or
((Shift = [ssShift]) and (Key in [VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT])) then
begin
lstItems.Perform(WM_KEYDOWN, Key, 0);
Key := 0;
end else if Shift = [ssCtrl] then
case Key of
VK_TAB:
begin
if PushFilter(cmbSearch.Text) then
cmbSearch.Text := '';
Key := 0;
end;
VK_BACK:
begin
cmbSearch.Text := '';
FInputFilter.Filter := '';
PopFilter();
Key := 0;
end;
end;
end;
procedure TfrmBaseSwDialog.cmbSearchKeyPress(Sender: TObject; var Key: Char);
begin
// Ctrl-Backspace
if Key = #127 then
Key := #0;
end;
procedure TfrmBaseSwDialog.TypeFilterChange(Sender: TObject);
begin
if not FLoading then
UpdateTypeFilter();
end;
procedure TfrmBaseSwDialog.lstItemsDblClick(Sender: TObject);
begin
btnOK.Click();
end;
procedure TfrmBaseSwDialog.lstItemsClick(Sender: TObject);
begin
UpdateUnitActions();
end;
procedure TfrmBaseSwDialog.lstItemsData(Control: TWinControl; Index: Integer;
var Data: string);
begin
Data := FInputFilteredList[Index].Name;
end;
procedure TfrmBaseSwDialog.lstItemsDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
currentUnit: TUnSwUnit;
textRect: TRect;
text: String;
begin
with TListBox(Control) do
begin
currentUnit := FInputFilteredList[Index];
currentUnit.AcceptVisitor(FStyleVisitor);
if FFormsOnly and (currentUnit is TUnSwModuleUnit) then
text := TUnSwModuleUnit(currentUnit).FormName
else
text := currentUnit.Name;
if odSelected in State then
begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText;
end else
begin
Canvas.Brush.Color := clWindow;
if Settings.Colors.Enabled then
Canvas.Font.Color := FStyleVisitor.Color
else
Canvas.Font.Color := clWindowText;
end;
Canvas.FillRect(Rect);
textRect := Rect;
InflateRect(textRect, -2, -2);
ilsTypes.Draw(Canvas, textRect.Left, textRect.Top, FStyleVisitor.ImageIndex);
if FStyleVisitor.OverlayIndex > -1 then
ilsTypes.Draw(Canvas, textRect.Left, textRect.Top, FStyleVisitor.OverlayIndex);
Inc(textRect.Left, ilsTypes.Width + 4);
DrawText(Canvas.Handle, PChar(text), Length(text), textRect, DT_SINGLELINE or
DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
end;
end;
procedure TfrmBaseSwDialog.lstItemsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
itemIndex: Integer;
begin
{ Bij rechtermuisknop het item selecteren indien deze niet al
geselecteerd was }
if Button = mbRight then
begin
itemIndex := lstItems.ItemAtPos(Point(X, Y), True);
if (itemIndex > -1) and (not lstItems.Selected[itemIndex]) then
begin
lstItems.ClearSelection;
lstItems.Selected[itemIndex] := True;
UpdateUnitActions();
end;
end;
end;
procedure TfrmBaseSwDialog.actReadOnlyExecute(Sender: TObject);
var
pUnits: TUnSwUnitList;
pVisitor: TUnSwSetReadOnlyVisitor;
begin
pUnits := GetActiveUnits();
if Assigned(pUnits) then
try
pVisitor := TUnSwSetReadOnlyVisitor.Create();
try
pVisitor.ReadOnlyFlag := not actReadOnly.Checked;
pUnits.AcceptVisitor(pVisitor);
finally
FreeAndNil(pVisitor);
end;
finally
FreeAndNil(pUnits);
lstItems.Invalidate();
UpdateUnitActions();
end;
end;
procedure TfrmBaseSwDialog.actOpenExecute(Sender: TObject);
begin
FOpenDFM := False;
ModalResult := mrOk;
end;
procedure TfrmBaseSwDialog.actOpenDFMExecute(Sender: TObject);
begin
FOpenDFM := True;
ModalResult := mrOk;
end;
procedure TfrmBaseSwDialog.btnOKClick(Sender: TObject);
begin
FOpenDFM := ((GetKeyState(VK_SHIFT) and 128) <> 0);
ModalResult := mrOk;
end;
end.

88
Source/BaseSwFilters.pas Normal file
View File

@ -0,0 +1,88 @@
{: Implements the base filtering visitors.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit BaseSwFilters;
interface
uses
Classes,
BaseSwObjects;
type
TBaseSwItemFilter = class(TInterfacedPersistent, IBaseSwVisitor)
private
FList: TBaseSwItemList;
protected
// IBaseSwVisitor
procedure VisitItem(AItem: TBaseSwItem); virtual;
procedure FilterItem(const AItem: TBaseSwItem); virtual;
public
procedure FilterList(AList: TBaseSwItemList);
end;
TBaseSwItemSimpleFilter = class(TBaseSwItemFilter)
private
FFilter: String;
procedure SetFilter(const Value: String);
public
property Filter: String read FFilter write SetFilter;
end;
TBaseSwItemSimpleNameFilter = class(TBaseSwItemSimpleFilter)
protected
procedure VisitItem(AItem: TBaseSwItem); override;
end;
implementation
uses
SysUtils;
{ TBaseSwItemFilter }
procedure TBaseSwItemFilter.FilterList(AList: TBaseSwItemList);
begin
FList := AList;
try
FList.AcceptVisitor(Self);
finally
FList := nil;
end;
end;
procedure TBaseSwItemFilter.FilterItem(const AItem: TBaseSwItem);
begin
FList.Remove(AItem);
end;
procedure TBaseSwItemFilter.VisitItem(AItem: TBaseSwItem);
begin
end;
{ TBaseSwItemSimpleFilter }
procedure TBaseSwItemSimpleFilter.SetFilter(const Value: String);
begin
FFilter := LowerCase(Value);
end;
{ TBaseSwItemSimpleNameFilter }
procedure TBaseSwItemSimpleNameFilter.VisitItem(AItem: TBaseSwItem);
begin
if (Length(Filter) > 0) and
(AnsiPos(Filter, LowerCase(AItem.Name)) = 0) then
FilterItem(AItem);
end;
end.

190
Source/BaseSwObjects.pas Normal file
View File

@ -0,0 +1,190 @@
{: Implements the base visitable list objects.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit BaseSwObjects;
{$I BaseSwDefines.inc}
interface
uses
Classes,
Contnrs;
type
// Forward declarations
TBaseSwItem = class;
IBaseSwVisitor = interface
['{B081D76E-0CC7-4160-B01D-6136AE1D6711}']
procedure VisitItem(const AItem: TBaseSwItem);
end;
IBaseSwVisited = interface
['{9540671E-184B-4DB6-A015-27B457C74C6C}']
procedure AcceptVisitor(const AVisitor: IBaseSwVisitor);
end;
TBaseSwItem = class(TInterfacedPersistent, IBaseSwVisited)
protected
function GetName(): String; virtual; abstract;
public
// IBaseSwVisited
procedure AcceptVisitor(const AVisitor: IBaseSwVisitor); virtual;
property Name: String read GetName;
end;
TBaseSwItemList = class(TInterfacedPersistent, IBaseSwVisited)
private
FItems: TObjectList;
protected
function GetOwnsObjects(): Boolean;
procedure SetOwnsObjects(const Value: Boolean);
function GetCount(): Integer;
function GetItem(Index: Integer): TBaseSwItem;
procedure SetItem(Index: Integer; Value: TBaseSwItem);
public
constructor Create();
destructor Destroy(); override;
function Add(const AItem: TBaseSwItem): Integer; virtual;
function IndexOf(const AItem: TBaseSwItem): Integer;
procedure Delete(const AIndex: Integer);
function Remove(const AItem: TBaseSwItem): Integer;
procedure Sort(Compare: TListSortCompare);
procedure Clone(const ASource: TBaseSwItemList); virtual;
procedure AcceptVisitor(const AVisitor: IBaseSwVisitor);
property Count: Integer read GetCount;
property Items[Index: Integer]: TBaseSwItem read GetItem
write SetItem; default;
property OwnsObjects: Boolean read GetOwnsObjects
write SetOwnsObjects;
end;
implementation
uses
{$IFDEF DELPHI7ORLOWER}
ActnList,
{$ENDIF}
SysUtils;
{ TBaseSwItem }
procedure TBaseSwItem.AcceptVisitor(const AVisitor: IBaseSwVisitor);
begin
AVisitor.VisitItem(Self);
end;
{ TBaseSwItemList}
constructor TBaseSwItemList.Create();
begin
inherited Create();
FItems := TObjectList.Create(True);
end;
destructor TBaseSwItemList.Destroy();
begin
FreeAndNil(FItems);
inherited;
end;
procedure TBaseSwItemList.AcceptVisitor(const AVisitor: IBaseSwVisitor);
var
itemIndex: Integer;
begin
for itemIndex := Pred(Count) downto 0 do
Items[itemIndex].AcceptVisitor(AVisitor);
end;
function TBaseSwItemList.Add(const AItem: TBaseSwItem): Integer;
begin
Result := FItems.Add(AItem);
end;
function TBaseSwItemList.IndexOf(const AItem: TBaseSwItem): Integer;
begin
Result := FItems.IndexOf(AItem);
end;
procedure TBaseSwItemList.Delete(const AIndex: Integer);
begin
FItems.Delete(AIndex);
end;
function TBaseSwItemList.Remove(const AItem: TBaseSwItem): Integer;
begin
Result := FItems.Remove(AItem);
end;
procedure TBaseSwItemList.Sort(Compare: TListSortCompare);
begin
FItems.Sort(Compare);
end;
procedure TBaseSwItemList.Clone(const ASource: TBaseSwItemList);
var
itemIndex: Integer;
begin
FItems.Clear();
FItems.OwnsObjects := False;
for itemIndex := 0 to Pred(ASource.Count) do
FItems.Add(ASource[itemIndex]);
end;
function TBaseSwItemList.GetCount(): Integer;
begin
Result := FItems.Count;
end;
function TBaseSwItemList.GetItem(Index: Integer): TBaseSwItem;
begin
Result := TBaseSwItem(FItems[Index]);
end;
procedure TBaseSwItemList.SetItem(Index: Integer; Value: TBaseSwItem);
begin
FItems[Index] := Value;
end;
function TBaseSwItemList.GetOwnsObjects(): Boolean;
begin
Result := FItems.OwnsObjects;
end;
procedure TBaseSwItemList.SetOwnsObjects(const Value: Boolean);
begin
FItems.OwnsObjects := Value;
end;
end.

213
Source/CmpSwClient.pas Normal file
View File

@ -0,0 +1,213 @@
{: Connects ComponentSwitcher to the IDE.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit CmpSwClient;
interface
uses
ActnList,
Classes,
Dialogs,
SysUtils,
ToolsAPI,
BaseSwClient;
type
TComponentSwitcherHook = class(TBaseSwitcherHook)
protected
function ActiveModule(): IOTAModule;
function ActiveEditor(): IOTAEditor;
// function ActiveFileName(): String;
// {$IFDEF DELPHI7ORLOWER}
// function ActiveGroup(): IOTAProjectGroup;
// {$ENDIF}
// function ActiveProject(): IOTAProject;
procedure NewExecute(Sender: TObject); virtual;
public
constructor Create();
end;
implementation
{ TComponentSwitcherHook}
constructor TComponentSwitcherHook.Create();
begin
inherited;
try
HookIDEAction('SearchFindCommand', NewExecute);
except
on E:EAssertionFailed do
ShowMessage('Error while loading ComponentSwitcher: ' + E.Message);
end;
end;
(*
function TUnitSwitcherHook.ActiveFileName(): String;
var
module: IOTAModule;
begin
Result := '';
module := (BorlandIDEServices as IOTAModuleServices).CurrentModule;
if Assigned(module) then
begin
if Assigned(module.CurrentEditor) then
Result := module.FileName;
end;
end;
{$IFDEF DELPHI7ORLOWER}
function TUnitSwitcherHook.ActiveGroup(): IOTAProjectGroup;
var
module: IOTAModule;
moduleServices: IOTAModuleServices;
moduleIndex: Integer;
begin
Result := nil;
moduleServices := (BorlandIDEServices as IOTAModuleServices);
for moduleIndex := 0 to Pred(moduleServices.ModuleCount) do
begin
module := moduleServices.Modules[moduleIndex];
if Supports(module, IOTAProjectGroup, Result) then
break;
end;
end;
{$ENDIF}
function TUnitSwitcherHook.ActiveProject(): IOTAProject;
{$IFDEF DELPHI7ORLOWER}
var
projectGroup: IOTAProjectGroup;
module: IOTAModule;
moduleServices: IOTAModuleServices;
moduleIndex: Integer;
{$ENDIF}
begin
{$IFDEF DELPHI7ORLOWER}
Result := nil;
projectGroup := ActiveGroup();
if not Assigned(projectGroup) then
begin
moduleServices := (BorlandIDEServices as IOTAModuleServices);
for moduleIndex := 0 to Pred(moduleServices.ModuleCount) do
begin
module := moduleServices.Modules[moduleIndex];
if Supports(module, IOTAProject, Result) then
break;
end;
end else
Result := projectGroup.ActiveProject;
{$ELSE}
Result := (BorlandIDEServices as IOTAModuleServices).GetActiveProject();
{$ENDIF}
end;
procedure TUnitSwitcherHook.NewExecute(Sender: TObject);
var
activeIndex: Integer;
activeUnit: TUnSwUnit;
itemIndex: Integer;
moduleIndex: Integer;
project: IOTAProject;
selectedUnits: TUnSwUnitList;
unitList: TUnSwUnitList;
openDFM: Boolean;
openType: TUnSwActivateType;
fileName: string;
begin
project := ActiveProject();
if not Assigned(project) then
exit;
unitList := TUnSwUnitList.Create();
try
unitList.Add(TUnSwProjectUnit.Create(project));
for moduleIndex := 0 to Pred(project.GetModuleCount) do
unitList.Add(TUnSwModuleUnit.Create(project.GetModule(moduleIndex)));
activeUnit := nil;
fileName := ActiveFileName();
if SameText(ExtractFileExt(fileName), '.dfm') then
fileName := ChangeFileExt(fileName, '.pas');
activeIndex := unitList.IndexOfFileName(fileName);
if activeIndex > -1 then
activeUnit := unitList[activeIndex];
selectedUnits := TfrmUnSwDialog.Execute(unitList, (Sender = FViewFormAction),
openDFM, activeUnit);
if Assigned(selectedUnits) then
try
openType := atSource;
if openDFM then
openType := atDFM
else if Sender = FViewFormAction then
openType := atForm;
for itemIndex := 0 to Pred(selectedUnits.Count) do
selectedUnits[itemIndex].Activate(openType);
finally
FreeAndNil(selectedUnits);
end;
finally
FreeAndNil(unitList);
end;
end;
*)
function TComponentSwitcherHook.ActiveModule(): IOTAModule;
begin
Result := (BorlandIDEServices as IOTAModuleServices).CurrentModule;
end;
function TComponentSwitcherHook.ActiveEditor(): IOTAEditor;
var
module: IOTAModule;
begin
Result := nil;
module := ActiveModule();
if Assigned(module) then
Result := activeModule.CurrentEditor;
end;
procedure TComponentSwitcherHook.NewExecute(Sender: TObject);
var
editor: IOTAEditor;
formEditor: IOTAFormEditor;
name: String;
begin
editor := ActiveEditor();
if Supports(editor, IOTAFormEditor, formEditor) then
begin
name := '';
formEditor.GetRootComponent.GetPropValueByName('Name', name);
ShowMessage(name);
end else
OldActionExecute(Sender);
end;
end.

68
Source/UnSwClient.pas
View File

@ -4,13 +4,11 @@
Revision: $Rev$ Revision: $Rev$
Author: $Author$ Author: $Author$
} }
{$ASSERTIONS ON}
unit UnSwClient; unit UnSwClient;
{$I UnSwDefines.inc} {$I BaseSwDefines.inc}
interface interface
implementation
uses uses
ActnList, ActnList,
Classes, Classes,
@ -18,16 +16,16 @@ uses
SysUtils, SysUtils,
ToolsAPI, ToolsAPI,
BaseSwClient,
UnSwDialog, UnSwDialog,
UnSwObjects; UnSwObjects;
type type
TUnitSwitcherHook = class(TObject) TUnitSwitcherHook = class(TBaseSwitcherHook)
private private
FOldUnitExecute: TNotifyEvent;
FOldFormExecute: TNotifyEvent;
FViewUnitAction: TContainedAction;
FViewFormAction: TContainedAction; FViewFormAction: TContainedAction;
FViewUnitAction: TContainedAction;
protected protected
function ActiveFileName(): String; function ActiveFileName(): String;
{$IFDEF DELPHI7ORLOWER} {$IFDEF DELPHI7ORLOWER}
@ -38,19 +36,19 @@ type
procedure NewExecute(Sender: TObject); virtual; procedure NewExecute(Sender: TObject); virtual;
public public
constructor Create(); constructor Create();
destructor Destroy(); override;
end; end;
implementation
{ TUnitSwitcherHook} { TUnitSwitcherHook}
constructor TUnitSwitcherHook.Create(); constructor TUnitSwitcherHook.Create();
var
actionIndex: Integer;
ntaServices: INTAServices;
action: TContainedAction;
begin begin
inherited;
try try
{
Assert(Assigned(BorlandIDEServices), 'BorlandIDEServices not available.'); Assert(Assigned(BorlandIDEServices), 'BorlandIDEServices not available.');
Assert(Supports(BorlandIDEServices, INTAServices, ntaServices), Assert(Supports(BorlandIDEServices, INTAServices, ntaServices),
'BorlandIDEServices does not support the ' + 'BorlandIDEServices does not support the ' +
@ -61,44 +59,16 @@ begin
Assert(Supports(BorlandIDEServices, IOTAActionServices), Assert(Supports(BorlandIDEServices, IOTAActionServices),
'BorlandIDEServices does not support the ' + 'BorlandIDEServices does not support the ' +
'IOTAActionServices interface.'); 'IOTAActionServices interface.');
}
for actionIndex := 0 to Pred(ntaServices.ActionList.ActionCount) do FViewFormAction := HookIDEAction('ViewFormCommand', NewExecute);
begin FViewUnitAction := HookIDEAction('ViewUnitCommand', NewExecute);
action := ntaServices.ActionList.Actions[actionIndex];
if action.Name = 'ViewUnitCommand' then
begin
FOldUnitExecute := action.OnExecute;
action.OnExecute := NewExecute;
FViewUnitAction := action;
end else if action.Name = 'ViewFormCommand' then
begin
FOldFormExecute := action.OnExecute;
action.OnExecute := NewExecute;
FViewFormAction := action;
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 except
on E:EAssertionFailed do on E:EAssertionFailed do
ShowMessage('Error while loading UnitSwitcher: ' + E.Message); ShowMessage('Error while loading UnitSwitcher: ' + E.Message);
end; end;
end; end;
destructor TUnitSwitcherHook.Destroy();
begin
if Assigned(FViewFormAction) then
FViewFormAction.OnExecute := FOldFormExecute;
if Assigned(FViewUnitAction) then
FViewUnitAction.OnExecute := FOldUnitExecute;
inherited;
end;
function TUnitSwitcherHook.ActiveFileName(): String; function TUnitSwitcherHook.ActiveFileName(): String;
var var
@ -218,14 +188,4 @@ begin
end; end;
end; end;
var
GUnitSwitcher: TUnitSwitcherHook;
initialization
GUnitSwitcher := TUnitSwitcherHook.Create();
finalization
FreeAndNil(GUnitSwitcher);
end. end.

53
Source/UnSwDialog.pas
View File

@ -22,17 +22,19 @@ uses
StdCtrls, StdCtrls,
Windows, Windows,
BaseSwFilters,
BaseSwObjects,
UnSwObjects, UnSwObjects,
UnSwFilters; UnSwFilters;
type type
TUnSwStyleVisitor = class(TInterfacedPersistent, IUnSwVisitor) TUnSwStyleVisitor = class(TInterfacedPersistent, IBaseSwVisitor, IUnSwVisitor)
private private
FColor: TColor; FColor: TColor;
FImageIndex: Integer; FImageIndex: Integer;
FOverlayIndex: Integer; FOverlayIndex: Integer;
protected protected
procedure VisitUnit(const AUnit: TUnSwUnit); procedure VisitItem(const AItem: TBaseSwItem);
procedure VisitModule(const AUnit: TUnSwModuleUnit); procedure VisitModule(const AUnit: TUnSwModuleUnit);
procedure VisitProject(const AUnit: TUnSwProjectUnit); procedure VisitProject(const AUnit: TUnSwProjectUnit);
public public
@ -41,6 +43,7 @@ type
property OverlayIndex: Integer read FOverlayIndex; property OverlayIndex: Integer read FOverlayIndex;
end; end;
TfrmUnSwDialog = class(TForm) TfrmUnSwDialog = class(TForm)
actMRUNext: TAction; actMRUNext: TAction;
actMRUPrior: TAction; actMRUPrior: TAction;
@ -127,8 +130,8 @@ type
FInputFilteredList: TUnSwUnitList; FInputFilteredList: TUnSwUnitList;
FTypeFilter: TUnSwUnitTypeFilter; FTypeFilter: TUnSwUnitTypeFilter;
FSubFilter: TUnSwUnitSimpleFilter; FSubFilter: TBaseSwItemSimpleFilter;
FInputFilter: TUnSwUnitSimpleFilter; FInputFilter: TBaseSwItemSimpleFilter;
FLastFilter: String; FLastFilter: String;
FStyleVisitor: TUnSwStyleVisitor; FStyleVisitor: TUnSwStyleVisitor;
@ -155,6 +158,7 @@ type
const AActive: TUnSwUnit = nil): TUnSwUnitList; const AActive: TUnSwUnit = nil): TUnSwUnitList;
end; end;
implementation implementation
uses uses
Messages, Messages,
@ -164,14 +168,16 @@ uses
UnSwConfiguration, UnSwConfiguration,
UnSwSettings; UnSwSettings;
type type
TUnSwOpenVisitor = class(TInterfacedObject, IUnSwVisitor) TUnSwOpenVisitor = class(TInterfacedPersistent, IBaseSwVisitor, IUnSwVisitor)
private private
FProcessed: TStringList; FProcessed: TStringList;
protected protected
function IsProcessed(const AFileName: String; const ARegister: Boolean = True): Boolean; function IsProcessed(const AFileName: String; const ARegister: Boolean = True): Boolean;
procedure OpenFile(const AFileName: String); virtual; abstract; procedure OpenFile(const AFileName: String); virtual; abstract;
procedure VisitItem(const AItem: TBaseSwItem); virtual;
procedure VisitModule(const AUnit: TUnSwModuleUnit); virtual; procedure VisitModule(const AUnit: TUnSwModuleUnit); virtual;
procedure VisitProject(const AUnit: TUnSwProjectUnit); virtual; procedure VisitProject(const AUnit: TUnSwProjectUnit); virtual;
public public
@ -219,6 +225,10 @@ type
end; end;
const
SubFilterSeparator = ' '#187' ';
{$R *.dfm} {$R *.dfm}
@ -263,6 +273,11 @@ begin
end; end;
procedure TUnSwOpenVisitor.VisitItem(const AItem: TBaseSwItem);
begin
end;
procedure TUnSwOpenVisitor.VisitModule(const AUnit: TUnSwModuleUnit); procedure TUnSwOpenVisitor.VisitModule(const AUnit: TUnSwModuleUnit);
begin begin
OpenFile(AUnit.FileName); OpenFile(AUnit.FileName);
@ -373,9 +388,9 @@ end;
{ TUnSwStyleVisitor } { TUnSwStyleVisitor }
procedure TUnSwStyleVisitor.VisitUnit(const AUnit: TUnSwUnit); procedure TUnSwStyleVisitor.VisitItem(const AItem: TBaseSwItem);
begin begin
if IsReadOnly(AUnit.FileName) then if (AItem is TUnSwUnit) and IsReadOnly(TUnSwUnit(AItem).FileName) then
FOverlayIndex := 5 FOverlayIndex := 5
else else
FOverlayIndex := -1; FOverlayIndex := -1;
@ -384,7 +399,7 @@ end;
procedure TUnSwStyleVisitor.VisitModule(const AUnit: TUnSwModuleUnit); procedure TUnSwStyleVisitor.VisitModule(const AUnit: TUnSwModuleUnit);
begin begin
VisitUnit(AUnit); VisitItem(AUnit);
case AUnit.UnitType of case AUnit.UnitType of
swutUnit: swutUnit:
begin begin
@ -410,7 +425,7 @@ end;
procedure TUnSwStyleVisitor.VisitProject(const AUnit: TUnSwProjectUnit); procedure TUnSwStyleVisitor.VisitProject(const AUnit: TUnSwProjectUnit);
begin begin
VisitUnit(AUnit); VisitItem(AUnit);
FColor := Settings.Colors.ProjectSource; FColor := Settings.Colors.ProjectSource;
FImageIndex := 4; FImageIndex := 4;
end; end;
@ -451,11 +466,13 @@ end;
function TfrmUnSwDialog.InternalExecute(): TUnSwUnitList; function TfrmUnSwDialog.InternalExecute(): TUnSwUnitList;
type type
TUnSwUnitSimpleFilterClass = class of TUnSwUnitSimpleFilter; TBaseSwItemSimpleFilterClass = class of TBaseSwItemSimpleFilter;
var var
iIndex: Integer; iIndex: Integer;
pClass: TUnSwUnitSimpleFilterClass; pClass: TBaseSwItemSimpleFilterClass;
mruText: String;
subFilterIndex: Integer;
begin begin
Result := nil; Result := nil;
@ -468,7 +485,7 @@ begin
if FFormsOnly then if FFormsOnly then
pClass := TUnSwUnitSimpleFormNameFilter pClass := TUnSwUnitSimpleFormNameFilter
else else
pClass := TUnSwUnitSimpleNameFilter; pClass := TBaseSwItemSimpleNameFilter;
FSubFilter := pClass.Create; FSubFilter := pClass.Create;
FInputFilter := pClass.Create; FInputFilter := pClass.Create;
@ -497,7 +514,11 @@ begin
while FMRUList.Count >= 10 do while FMRUList.Count >= 10 do
FMRUList.Delete(Pred(FMRUList.Count)); FMRUList.Delete(Pred(FMRUList.Count));
FMRUList.Insert(0, cmbSearch.Text); mruText := cmbSearch.Text;
for subFilterIndex := Pred(FSubFilters.Count) downto 0 do
mruText := FSubFilters[subFilterIndex] + SubFilterSeparator;
FMRUList.Insert(0, mruText);
end; end;
Result := GetActiveUnits(); Result := GetActiveUnits();
@ -740,7 +761,7 @@ begin
begin begin
for iFilter := 0 to Pred(FSubFilters.Count) do for iFilter := 0 to Pred(FSubFilters.Count) do
begin begin
sFilters := sFilters + FSubFilters[iFilter] + ' '#187' '; sFilters := sFilters + FSubFilters[iFilter] + SubFilterSeparator;
FSubFilter.Filter := FSubFilters[iFilter]; FSubFilter.Filter := FSubFilters[iFilter];
FSubFilter.FilterList(FSubFilteredList); FSubFilter.FilterList(FSubFilteredList);
end; end;
@ -878,7 +899,11 @@ end;
procedure TfrmUnSwDialog.SelectMRUItem(); procedure TfrmUnSwDialog.SelectMRUItem();
var
mruText: String;
begin begin
mruText := FMRUList[FMRUIndex];
cmbSearch.ItemIndex := FMRUIndex; cmbSearch.ItemIndex := FMRUIndex;
ActiveControl := cmbSearch; ActiveControl := cmbSearch;
cmbSearch.SelectAll(); cmbSearch.SelectAll();

106
Source/UnSwFilters.pas
View File

@ -10,52 +10,28 @@ interface
uses uses
Classes, Classes,
BaseSwFilters,
BaseSwObjects,
UnSwObjects; UnSwObjects;
type type
TUnSwUnitFilter = class(TInterfacedPersistent, IUnSwVisitor) TUnSwUnitSimpleFormNameFilter = class(TBaseSwItemSimpleNameFilter, IUnSwVisitor)
private
FList: TUnSwUnitList;
protected protected
// Called by default by all other Visit methods procedure VisitModule(const AUnit: TUnSwModuleUnit);
procedure VisitUnit(const AUnit: TUnSwUnit); virtual; procedure VisitProject(const AUnit: TUnSwProjectUnit);
procedure VisitModule(const AUnit: TUnSwModuleUnit); virtual;
procedure VisitProject(const AUnit: TUnSwProjectUnit); virtual;
procedure FilterUnit(const AUnit: TUnSwUnit); virtual;
public
procedure FilterList(AList: TUnSwUnitList);
end; end;
TUnSwUnitSimpleFilter = class(TUnSwUnitFilter)
private
FFilter: String;
procedure SetFilter(const Value: String); TUnSwUnitTypeFilter = class(TBaseSwItemFilter)
public
property Filter: String read FFilter write SetFilter;
end;
TUnSwUnitSimpleNameFilter = class(TUnSwUnitSimpleFilter)
protected
procedure VisitUnit(const AUnit: TUnSwUnit); override;
end;
TUnSwUnitSimpleFormNameFilter = class(TUnSwUnitSimpleNameFilter)
protected
procedure VisitModule(const AUnit: TUnSwModuleUnit); override;
end;
TUnSwUnitTypeFilter = class(TUnSwUnitFilter)
private private
FIncludeDataModules: Boolean; FIncludeDataModules: Boolean;
FIncludeForms: Boolean; FIncludeForms: Boolean;
FIncludeProjectSource: Boolean; FIncludeProjectSource: Boolean;
FIncludeUnits: Boolean; FIncludeUnits: Boolean;
protected protected
procedure VisitModule(const AUnit: TUnSwModuleUnit); override; procedure VisitModule(const AUnit: TUnSwModuleUnit);
procedure VisitProject(const AUnit: TUnSwProjectUnit); override; procedure VisitProject(const AUnit: TUnSwProjectUnit);
public public
constructor Create; constructor Create;
@ -65,68 +41,24 @@ type
property IncludeUnits: Boolean read FIncludeUnits write FIncludeUnits; property IncludeUnits: Boolean read FIncludeUnits write FIncludeUnits;
end; end;
implementation implementation
uses uses
SysUtils; SysUtils;
{ TUnSwUnitFilter }
procedure TUnSwUnitFilter.FilterList(AList: TUnSwUnitList);
begin
FList := AList;
try
FList.AcceptVisitor(Self);
finally
FList := nil;
end;
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.SetFilter(const Value: String);
begin
FFilter := LowerCase(Value);
end;
{ TUnSwUnitSimpleNameFilter }
procedure TUnSwUnitSimpleNameFilter.VisitUnit(const AUnit: TUnSwUnit);
begin
if (Length(Filter) > 0) and
(AnsiPos(Filter, LowerCase(AUnit.Name)) = 0) then
FilterUnit(AUnit);
end;
{ TUnSwUnitSimpleFormNameFilter } { TUnSwUnitSimpleFormNameFilter }
procedure TUnSwUnitSimpleFormNameFilter.VisitModule(const AUnit: TUnSwModuleUnit); procedure TUnSwUnitSimpleFormNameFilter.VisitModule(const AUnit: TUnSwModuleUnit);
begin begin
if (Length(Filter) > 0) and if (Length(Filter) > 0) and
(AnsiPos(Filter, LowerCase(AUnit.FormName)) = 0) then (AnsiPos(Filter, LowerCase(AUnit.FormName)) = 0) then
FilterUnit(AUnit); FilterItem(AUnit);
end;
procedure TUnSwUnitSimpleFormNameFilter.VisitProject(const AUnit: TUnSwProjectUnit);
begin
VisitItem(AUnit);
end; end;
@ -159,14 +91,14 @@ begin
Include(validTypes, swutUnit); Include(validTypes, swutUnit);
if not (AUnit.UnitType in validTypes) then if not (AUnit.UnitType in validTypes) then
FilterUnit(AUnit); FilterItem(AUnit);
end; end;
procedure TUnSwUnitTypeFilter.VisitProject(const AUnit: TUnSwProjectUnit); procedure TUnSwUnitTypeFilter.VisitProject(const AUnit: TUnSwProjectUnit);
begin begin
if not FIncludeProjectSource then if not FIncludeProjectSource then
FilterUnit(AUnit); FilterItem(AUnit);
end; end;
end. end.

171
Source/UnSwObjects.pas
View File

@ -6,13 +6,16 @@
} }
unit UnSwObjects; unit UnSwObjects;
{$I UnSwDefines.inc} {$I BaseSwDefines.inc}
interface interface
uses uses
Classes, Classes,
Contnrs, Contnrs,
ToolsAPI; ToolsAPI,
BaseSwObjects;
type type
// Forward declarations // Forward declarations
@ -21,33 +24,23 @@ type
TUnSwProjectUnit = class; TUnSwProjectUnit = class;
IUnSwVisitor = interface IUnSwVisitor = interface(IBaseSwVisitor)
['{A822C25B-5D0F-462F-94DD-47CD6235D79F}'] ['{A822C25B-5D0F-462F-94DD-47CD6235D79F}']
procedure VisitModule(const AUnit: TUnSwModuleUnit); procedure VisitModule(const AUnit: TUnSwModuleUnit);
procedure VisitProject(const AUnit: TUnSwProjectUnit); procedure VisitProject(const AUnit: TUnSwProjectUnit);
end; end;
IUnSwVisited = interface
['{9540671E-184B-4DB6-A015-27B457C74C6C}']
procedure AcceptVisitor(const AVisitor: IUnSwVisitor);
end;
TUnSwActivateType = (atForm, atSource, atDFM); TUnSwActivateType = (atForm, atSource, atDFM);
TUnSwUnit = class(TInterfacedPersistent, IUnSwVisited) TUnSwUnit = class(TBaseSwItem)
protected protected
function GetName(): String; virtual;
function GetFileName(): String; virtual; function GetFileName(): String; virtual;
procedure OpenModule(const AModule: IOTAModule; const AType: TUnSwActivateType); virtual; procedure OpenModule(const AModule: IOTAModule; const AType: TUnSwActivateType); virtual;
public public
// IUnSwVisited
procedure AcceptVisitor(const AVisitor: IUnSwVisitor); virtual; abstract;
procedure Activate(const AType: TUnSwActivateType); virtual; abstract; procedure Activate(const AType: TUnSwActivateType); virtual; abstract;
property Name: String read GetName;
property FileName: String read GetFileName; property FileName: String read GetFileName;
end; end;
@ -82,7 +75,8 @@ type
function GetUnitType(): TUnSwUnitType; function GetUnitType(): TUnSwUnitType;
public public
constructor Create(const AModule: IOTAModuleInfo); constructor Create(const AModule: IOTAModuleInfo);
procedure AcceptVisitor(const AVisitor: IUnSwVisitor); override;
procedure AcceptVisitor(const AVisitor: IBaseSwVisitor); override;
procedure Activate(const AType: TUnSwActivateType); override; procedure Activate(const AType: TUnSwActivateType); override;
@ -90,6 +84,7 @@ type
property UnitType: TUnSwUnitType read GetUnitType; property UnitType: TUnSwUnitType read GetUnitType;
end; end;
TUnSwProjectUnit = class(TUnSwUnit) TUnSwProjectUnit = class(TUnSwUnit)
private private
FProject: IOTAProject; FProject: IOTAProject;
@ -98,44 +93,25 @@ type
function GetFileName(): String; override; function GetFileName(): String; override;
public public
constructor Create(const AProject: IOTAProject); constructor Create(const AProject: IOTAProject);
procedure AcceptVisitor(const AVisitor: IUnSwVisitor); override;
procedure AcceptVisitor(const AVisitor: IBaseSwVisitor); override;
procedure Activate(const AType: TUnSwActivateType); override; procedure Activate(const AType: TUnSwActivateType); override;
end; end;
TUnSwUnitList = class(TInterfacedPersistent, IUnSwVisited) TUnSwUnitList = class(TBaseSwItemList)
private protected
FItems: TObjectList;
function GetOwnsObjects(): Boolean;
procedure SetOwnsObjects(const Value: Boolean);
function GetCount(): Integer;
function GetItem(Index: Integer): TUnSwUnit; function GetItem(Index: Integer): TUnSwUnit;
procedure SetItem(Index: Integer; Value: TUnSwUnit); procedure SetItem(Index: Integer; Value: TUnSwUnit);
public public
constructor Create();
destructor Destroy(); override;
function Add(const AUnit: TUnSwUnit): Integer; virtual;
function IndexOf(const AUnit: TUnSwUnit): Integer;
function IndexOfFileName(const AFileName: String): Integer; 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 AcceptVisitor(const AVisitor: IUnSwVisitor);
property Count: Integer read GetCount;
property Items[Index: Integer]: TUnSwUnit read GetItem property Items[Index: Integer]: TUnSwUnit read GetItem
write SetItem; default; write SetItem; default;
property OwnsObjects: Boolean read GetOwnsObjects
write SetOwnsObjects;
end; end;
implementation implementation
uses uses
{$IFDEF DELPHI7ORLOWER} {$IFDEF DELPHI7ORLOWER}
@ -146,11 +122,6 @@ uses
{ TUnSwUnit } { TUnSwUnit }
function TUnSwUnit.GetName(): String;
begin
Result := '';
end;
function TUnSwUnit.GetFileName(): String; function TUnSwUnit.GetFileName(): String;
begin begin
Result := ''; Result := '';
@ -193,6 +164,7 @@ begin
FModule := AModule; FModule := AModule;
end; end;
procedure TUnSwModuleUnit.Activate(const AType: TUnSwActivateType); procedure TUnSwModuleUnit.Activate(const AType: TUnSwActivateType);
var var
dfmFile: string; dfmFile: string;
@ -222,26 +194,37 @@ begin
end; end;
end; end;
procedure TUnSwModuleUnit.AcceptVisitor(const AVisitor: IUnSwVisitor);
procedure TUnSwModuleUnit.AcceptVisitor(const AVisitor: IBaseSwVisitor);
var
unitVisitor: IUnSwVisitor;
begin begin
AVisitor.VisitModule(Self); if Supports(AVisitor, IUnSwVisitor, unitVisitor) then
unitVisitor.VisitModule(Self)
else
inherited;
end; end;
function TUnSwModuleUnit.GetName(): String; function TUnSwModuleUnit.GetName(): String;
begin begin
Result := FModule.Name; Result := FModule.Name;
end; end;
function TUnSwModuleUnit.GetFormName(): String; function TUnSwModuleUnit.GetFormName(): String;
begin begin
Result := FModule.FormName; Result := FModule.FormName;
end; end;
function TUnSwModuleUnit.GetFileName(): String; function TUnSwModuleUnit.GetFileName(): String;
begin begin
Result := FModule.FileName; Result := FModule.FileName;
end; end;
function TUnSwModuleUnit.GetUnitType(): TUnSwUnitType; function TUnSwModuleUnit.GetUnitType(): TUnSwUnitType;
begin begin
Result := TUnSwUnitType(FModule.ModuleType); Result := TUnSwUnitType(FModule.ModuleType);
@ -265,6 +248,7 @@ begin
FProject := AProject; FProject := AProject;
end; end;
procedure TUnSwProjectUnit.Activate(const AType: TUnSwActivateType); procedure TUnSwProjectUnit.Activate(const AType: TUnSwActivateType);
{$IFDEF DELPHI7ORLOWER} {$IFDEF DELPHI7ORLOWER}
var var
@ -292,16 +276,25 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure TUnSwProjectUnit.AcceptVisitor(const AVisitor: IUnSwVisitor);
procedure TUnSwProjectUnit.AcceptVisitor(const AVisitor: IBaseSwVisitor);
var
unitVisitor: IUnSwVisitor;
begin begin
AVisitor.VisitProject(Self); if Supports(AVisitor, IUnSwVisitor, unitVisitor) then
unitVisitor.VisitProject(Self)
else
inherited;
end; end;
function TUnSwProjectUnit.GetName(): String; function TUnSwProjectUnit.GetName(): String;
begin begin
Result := ChangeFileExt(ExtractFileName(FProject.FileName), ''); Result := ChangeFileExt(ExtractFileName(FProject.FileName), '');
end; end;
function TUnSwProjectUnit.GetFileName(): String; function TUnSwProjectUnit.GetFileName(): String;
begin begin
Result := FProject.FileName; Result := FProject.FileName;
@ -309,41 +302,6 @@ end;
{ TUnSwUnitList} { TUnSwUnitList}
constructor TUnSwUnitList.Create();
begin
inherited Create();
FItems := TObjectList.Create(True);
end;
destructor TUnSwUnitList.Destroy();
begin
FreeAndNil(FItems);
inherited;
end;
procedure TUnSwUnitList.AcceptVisitor(const AVisitor: IUnSwVisitor);
var
itemIndex: Integer;
begin
for itemIndex := Pred(Count) downto 0 do
Items[itemIndex].AcceptVisitor(AVisitor);
end;
function TUnSwUnitList.Add(const AUnit: TUnSwUnit): Integer;
begin
Result := FItems.Add(AUnit);
end;
function TUnSwUnitList.IndexOf(const AUnit: TUnSwUnit): Integer;
begin
Result := FItems.IndexOf(AUnit);
end;
function TUnSwUnitList.IndexOfFileName(const AFileName: String): Integer; function TUnSwUnitList.IndexOfFileName(const AFileName: String): Integer;
var var
itemIndex: Integer; itemIndex: Integer;
@ -361,57 +319,16 @@ begin
end; end;
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);
var
itemIndex: Integer;
begin
FItems.Clear();
FItems.OwnsObjects := False;
for itemIndex := 0 to Pred(ASource.Count) do
FItems.Add(ASource[itemIndex]);
end;
function TUnSwUnitList.GetCount(): Integer;
begin
Result := FItems.Count;
end;
function TUnSwUnitList.GetItem(Index: Integer): TUnSwUnit; function TUnSwUnitList.GetItem(Index: Integer): TUnSwUnit;
begin begin
Result := TUnSwUnit(FItems[Index]); Result := TUnSwUnit(inherited GetItem(Index));
end; end;
procedure TUnSwUnitList.SetItem(Index: Integer; Value: TUnSwUnit); procedure TUnSwUnitList.SetItem(Index: Integer; Value: TUnSwUnit);
begin begin
FItems[Index] := Value; inherited SetItem(Index, Value);
end;
function TUnSwUnitList.GetOwnsObjects(): Boolean;
begin
Result := FItems.OwnsObjects;
end;
procedure TUnSwUnitList.SetOwnsObjects(const Value: Boolean);
begin
FItems.OwnsObjects := Value;
end; end;
end. end.

26
Source/UnSwReg.pas Normal file
View File

@ -0,0 +1,26 @@
unit UnSwReg;
interface
implementation
uses
SysUtils,
CmpSwClient,
UnSwClient;
var
GComponentSwitcher: TComponentSwitcherHook;
GUnitSwitcher: TUnitSwitcherHook;
initialization
GComponentSwitcher := TComponentSwitcherHook.Create();
GUnitSwitcher := TUnitSwitcherHook.Create();
finalization
FreeAndNil(GUnitSwitcher);
FreeAndNil(GComponentSwitcher);
end.