GitHub-Mirror/unitswitcher
1
0
Fork 0
mirror of synced 2024-11-24 04:13:51 +00:00
Code Issues Projects Releases Wiki Activity

Browse Source
This commit is contained in:
Mark van Renswoude 2007-02-16 17:19:22 +00:00
parent 79b18c0bf6
commit 82485ca0a0
9 changed files with 176 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Lib/D7/UnitSwitcherD7.bpl
View File

Binary file not shown.

22
Source/UnSwClient.pas
View File

@ -58,11 +58,9 @@ begin
Assert(Supports(BorlandIDEServices, IOTAModuleServices),
'BorlandIDEServices does not support the ' +
'IOTAModuleServices interface.');
{$IFDEF DELPHI7ORLOWER}
Assert(Supports(BorlandIDEServices, IOTAActionServices),
'BorlandIDEServices does not support the ' +
'IOTAActionServices interface.');
{$ENDIF}
for actionIndex := 0 to Pred(ntaServices.ActionList.ActionCount) do
begin
@ -174,6 +172,9 @@ var
project: IOTAProject;
selectedUnits: TUnSwUnitList;
unitList: TUnSwUnitList;
openDFM: Boolean;
openType: TUnSwActivateType;
fileName: string;
begin
project := ActiveProject();
@ -188,16 +189,27 @@ begin
unitList.Add(TUnSwModuleUnit.Create(project.GetModule(moduleIndex)));
activeUnit := nil;
activeIndex := unitList.IndexOfFileName(ActiveFileName());
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),
activeUnit);
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((Sender = FViewUnitAction));
selectedUnits[itemIndex].Activate(openType);
finally
FreeAndNil(selectedUnits);
end;

31
Source/UnSwConfiguration.dfm
View File

@ -4,7 +4,7 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'UnitSwitcher Configuration'
ClientHeight = 250
ClientHeight = 272
ClientWidth = 303
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@ -16,14 +16,14 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
Position = poScreenCenter
DesignSize = (
303
250)
272)
PixelsPerInch = 96
TextHeight = 13
object pcConfiguration: TPageControl
Left = 4
Top = 4
Width = 295
Height = 209
Height = 231
ActivePage = tsGeneral
Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 0
@ -204,20 +204,28 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
end
object btnDefault: TButton
Left = 8
Top = 135
Top = 167
Width = 109
Height = 25
Caption = 'Reset to &default'
TabOrder = 2
OnClick = btnDefaultClick
end
object chkAllowEmptyResults: TCheckBox
Left = 8
Top = 136
Width = 273
Height = 17
Caption = 'Allow &empty results'
TabOrder = 3
end
end
object tsAbout: TTabSheet
Caption = 'About...'
ImageIndex = 1
DesignSize = (
287
181)
203)
object imgAbout: TImage
Left = 8
Top = 8
@ -275,7 +283,7 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
Top = 23
Width = 145
Height = 13
Anchors = [akLeft, akBottom]
Anchors = [akTop, akRight]
Caption = 'Copyright '#169' 2006 X'#178'Software'
end
object TLabel
@ -283,7 +291,6 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
Top = 90
Width = 225
Height = 41
Anchors = [akLeft, akRight, akBottom]
AutoSize = False
Caption =
'UnitSwitcher is released as open-source under the zlib/libpng OS' +
@ -304,10 +311,11 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
end
object lblBugReport: TLabel
Left = 56
Top = 156
Top = 177
Width = 75
Height = 13
Cursor = crHandPoint
Anchors = [akLeft, akBottom]
Caption = 'Report a bug...'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
@ -319,10 +327,11 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
end
object lblShortcutKeys: TLabel
Left = 56
Top = 141
Top = 162
Width = 127
Height = 13
Cursor = crHandPoint
Anchors = [akLeft, akBottom]
Caption = 'Overview of shortcut keys'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
@ -336,7 +345,7 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
end
object btnCancel: TButton
Left = 224
Top = 219
Top = 241
Width = 75
Height = 25
Anchors = [akRight, akBottom]
@ -347,7 +356,7 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
end
object btnOk: TButton
Left = 143
Top = 219
Top = 241
Width = 75
Height = 25
Anchors = [akRight, akBottom]

29
Source/UnSwConfiguration.pas
View File

@ -26,6 +26,7 @@ type
btnOk: TButton;
btnProjectColor: TButton;
btnUnitColor: TButton;
chkAllowEmptyResults: TCheckBox;
chkCustomColor: TCheckBox;
dlgColor: TColorDialog;
imgAbout: TImage;
@ -65,21 +66,24 @@ uses
UnSwSettings,
UnSwShortcuts;
{$R *.dfm}
{ TfrmUnSwConfiguration }
class function TfrmUnSwConfiguration.Execute(): Boolean;
begin
with Self.Create(nil) do
try
pcConfiguration.ActivePage := tsGeneral;
Result := InternalExecute();
finally
Free();
end;
end;
function TfrmUnSwConfiguration.InternalExecute(): Boolean;
var
iLabel: Integer;
@ -103,11 +107,13 @@ begin
ShellExecute(0, 'open', 'http://projects.kamadev.net/', nil, nil, SW_SHOWNORMAL);
end;
procedure TfrmUnSwConfiguration.lblShortcutKeysClick(Sender: TObject);
begin
TfrmUnSwShortcuts.Execute();
end;
procedure TfrmUnSwConfiguration.LoadSettings();
begin
chkCustomColor.Checked := Settings.Colors.Enabled;
@ -115,40 +121,45 @@ begin
lblFormColor.Font.Color := Settings.Colors.Forms;
lblProjectColor.Font.Color := Settings.Colors.ProjectSource;
lblUnitColor.Font.Color := Settings.Colors.Units;
chkAllowEmptyResults.Checked := Settings.Filter.AllowEmptyResult;
end;
procedure TfrmUnSwConfiguration.SaveSettings();
begin
Settings.Colors.Enabled := chkCustomColor.Checked;
Settings.Colors.DataModules := lblDataModuleColor.Font.Color;
Settings.Colors.Forms := lblFormColor.Font.Color;
Settings.Colors.ProjectSource := lblProjectColor.Font.Color;
Settings.Colors.Units := lblUnitColor.Font.Color;
Settings.Colors.Enabled := chkCustomColor.Checked;
Settings.Colors.DataModules := lblDataModuleColor.Font.Color;
Settings.Colors.Forms := lblFormColor.Font.Color;
Settings.Colors.ProjectSource := lblProjectColor.Font.Color;
Settings.Colors.Units := lblUnitColor.Font.Color;
Settings.Filter.AllowEmptyResult := chkAllowEmptyResults.Checked;
Settings.Save();
end;
procedure TfrmUnSwConfiguration.btnDefaultClick(Sender: TObject);
begin
if MessageBox(Self.Handle, 'Are you sure you want to revert the color ' +
if MessageBox(Self.Handle, 'Are you sure you want to revert the ' +
'settings? This action can not be undone.',
'Reset to default', MB_YESNO or MB_ICONQUESTION) = ID_YES then
begin
Settings.ResetDefaults(True);
Settings.ResetDefaults();
Settings.Save();
LoadSettings();
end;
end;
procedure TfrmUnSwConfiguration.chkCustomColorClick(Sender: TObject);
const
Colors: array[Boolean] of TColor = (clBtnFace, clWindow);
begin
pnlCustomColor.Enabled := chkCustomColor.Checked;
pnlCustomColor.Color := Colors[pnlCustomColor.Enabled];
end;
procedure TfrmUnSwConfiguration.PickColor(Sender: TObject);
var
typeLabel: TLabel;

33
Source/UnSwDialog.dfm
View File

@ -1,6 +1,6 @@
object frmUnSwDialog: TfrmUnSwDialog
Left = 187
Top = 83
Left = 284
Top = 120
Width = 320
Height = 425
BorderIcons = [biSystemMenu]
@ -145,8 +145,8 @@ object frmUnSwDialog: TfrmUnSwDialog
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 1
OnClick = btnOKClick
end
object btnConfiguration: TButton
Left = 4
@ -646,7 +646,7 @@ object frmUnSwDialog: TfrmUnSwDialog
OnExecute = actOpenPropertiesExecute
end
object actOpenDFMProperties: TAction
Caption = '&.DFM Properties'
Caption = '.&DFM Properties'
ShortCut = 24589
OnExecute = actOpenDFMPropertiesExecute
end
@ -665,17 +665,36 @@ object frmUnSwDialog: TfrmUnSwDialog
ShortCut = 49234
OnExecute = actReadOnlyExecute
end
object actOpen: TAction
Caption = '&Open'
ShortCut = 13
OnExecute = actOpenExecute
end
object actOpenDFM: TAction
Caption = 'Open D&FM'
ShortCut = 8205
OnExecute = actOpenDFMExecute
end
end
object pmnUnits: TPopupMenu
Left = 140
Top = 228
object pmnUnitsOpen: TMenuItem
Action = actOpen
end
object pmnUnitsOpenDFM: TMenuItem
Action = actOpenDFM
end
object pmnUnitsSep1: TMenuItem
Caption = '-'
end
object pmnUnitsSelectAll: TMenuItem
Action = actSelectAll
end
object pmnUnitsSelectInvert: TMenuItem
Action = actSelectInvert
end
object pmnUnitsSep1: TMenuItem
object pmnUnitsSep2: TMenuItem
Caption = '-'
end
object pmnUnitsSortByName: TMenuItem
@ -684,13 +703,13 @@ object frmUnSwDialog: TfrmUnSwDialog
object pmnUnitsSortByType: TMenuItem
Action = actSortByType
end
object pmnUnitsSep2: TMenuItem
object pmnUnitsSep3: TMenuItem
Caption = '-'
end
object pmnUnitsReadOnly: TMenuItem
Action = actReadOnly
end
object pmnUnitsSep3: TMenuItem
object pmnUnitsSep4: TMenuItem
Caption = '-'
end
object pmnUnitsOpenFolder: TMenuItem

38
Source/UnSwDialog.pas
View File

@ -26,7 +26,7 @@ uses
UnSwFilters;
type
TUnSwStyleVisitor = class(TUnSwNoRefIntfObject, IUnSwVisitor)
TUnSwStyleVisitor = class(TInterfacedPersistent, IUnSwVisitor)
private
FColor: TColor;
FImageIndex: Integer;
@ -44,6 +44,8 @@ type
TfrmUnSwDialog = class(TForm)
actMRUNext: TAction;
actMRUPrior: TAction;
actOpen: TAction;
actOpenDFM: TAction;
actOpenDFMProperties: TAction;
actOpenFolder: TAction;
actOpenProperties: TAction;
@ -65,6 +67,8 @@ type
lblSubFilters: TLabel;
lstUnits: TListBox;
pmnUnits: TPopupMenu;
pmnUnitsOpen: TMenuItem;
pmnUnitsOpenDFM: TMenuItem;
pmnUnitsOpenDFMProperties: TMenuItem;
pmnUnitsOpenFolder: TMenuItem;
pmnUnitsOpenProperties: TMenuItem;
@ -74,6 +78,7 @@ type
pmnUnitsSep1: TMenuItem;
pmnUnitsSep2: TMenuItem;
pmnUnitsSep3: TMenuItem;
pmnUnitsSep4: TMenuItem;
pmnUnitsSortByName: TMenuItem;
pmnUnitsSortByType: TMenuItem;
pnlButtons: TPanel;
@ -104,6 +109,9 @@ type
procedure lstUnitsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SortExecute(Sender: TObject);
procedure TypeFilterChange(Sender: TObject);
procedure actOpenExecute(Sender: TObject);
procedure actOpenDFMExecute(Sender: TObject);
procedure btnOKClick(Sender: TObject);
private
FLoading: Boolean;
FUnitList: TUnSwUnitList;
@ -112,6 +120,7 @@ type
FMRUList: TStrings;
FMRUIndex: Integer;
FSubFilters: TStringList;
FOpenDFM: Boolean;
FTypeFilteredList: TUnSwUnitList;
FSubFilteredList: TUnSwUnitList;
@ -142,6 +151,7 @@ type
public
class function Execute(const AUnits: TUnSwUnitList;
const AFormsOnly: Boolean;
out AOpenDFM: Boolean;
const AActive: TUnSwUnit = nil): TUnSwUnitList;
end;
@ -409,6 +419,7 @@ end;
{ TfrmUnSwDialog }
class function TfrmUnSwDialog.Execute(const AUnits: TUnSwUnitList;
const AFormsOnly: Boolean;
out AOpenDFM: Boolean;
const AActive: TUnSwUnit): TUnSwUnitList;
begin
with Self.Create(nil) do
@ -416,7 +427,9 @@ begin
FUnitList := AUnits;
FActiveUnit := AActive;
FFormsOnly := AFormsOnly;
Result := InternalExecute();
AOpenDFM := FOpenDFM;
finally
Free();
end;
@ -486,7 +499,7 @@ begin
FMRUList.Insert(0, cmbSearch.Text);
end;
Result := GetActiveUnits();
end;
@ -773,6 +786,7 @@ begin
begin
Result := TUnSwUnitList.Create();
Result.OwnsObjects := False;
for itemIndex := 0 to Pred(lstUnits.Items.Count) do
if lstUnits.Selected[itemIndex] then
Result.Add(FInputFilteredList[itemIndex]);
@ -1108,4 +1122,24 @@ begin
end;
end;
procedure TfrmUnSwDialog.actOpenExecute(Sender: TObject);
begin
FOpenDFM := False;
ModalResult := mrOk;
end;
procedure TfrmUnSwDialog.actOpenDFMExecute(Sender: TObject);
begin
FOpenDFM := True;
ModalResult := mrOk;
end;
procedure TfrmUnSwDialog.btnOKClick(Sender: TObject);
begin
FOpenDFM := ((GetKeyState(VK_SHIFT) and 128) <> 0);
ModalResult := mrOk;
end;
end.

4
Source/UnSwFilters.pas
View File

@ -8,10 +8,12 @@ unit UnSwFilters;
interface
uses
Classes,
UnSwObjects;
type
TUnSwUnitFilter = class(TUnSwNoRefIntfObject, IUnSwVisitor)
TUnSwUnitFilter = class(TInterfacedPersistent, IUnSwVisitor)
private
FList: TUnSwUnitList;
protected

77
Source/UnSwObjects.pas
View File

@ -33,26 +33,19 @@ type
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;
TUnSwActivateType = (atForm, atSource, atDFM);
TUnSwUnit = class(TUnSwNoRefIntfObject, IUnSwVisited)
TUnSwUnit = class(TInterfacedPersistent, IUnSwVisited)
protected
function GetName(): String; virtual;
function GetFileName(): String; virtual;
procedure OpenModule(const AModule: IOTAModule; const ASource: Boolean); virtual;
procedure OpenModule(const AModule: IOTAModule; const AType: TUnSwActivateType); virtual;
public
// IUnSwVisited
procedure AcceptVisitor(const AVisitor: IUnSwVisitor); virtual; abstract;
procedure Activate(const ASource: Boolean); virtual; abstract;
procedure Activate(const AType: TUnSwActivateType); virtual; abstract;
property Name: String read GetName;
property FileName: String read GetFileName;
@ -91,7 +84,7 @@ type
constructor Create(const AModule: IOTAModuleInfo);
procedure AcceptVisitor(const AVisitor: IUnSwVisitor); override;
procedure Activate(const ASource: Boolean); override;
procedure Activate(const AType: TUnSwActivateType); override;
property FormName: String read GetFormName;
property UnitType: TUnSwUnitType read GetUnitType;
@ -107,11 +100,11 @@ type
constructor Create(const AProject: IOTAProject);
procedure AcceptVisitor(const AVisitor: IUnSwVisitor); override;
procedure Activate(const ASource: Boolean); override;
procedure Activate(const AType: TUnSwActivateType); override;
end;
TUnSwUnitList = class(TUnSwNoRefIntfObject, IUnSwVisited)
TUnSwUnitList = class(TInterfacedPersistent, IUnSwVisited)
private
FItems: TObjectList;
@ -151,25 +144,6 @@ 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 }
function TUnSwUnit.GetName(): String;
@ -183,7 +157,7 @@ begin
end;
procedure TUnSwUnit.OpenModule(const AModule: IOTAModule; const ASource: Boolean);
procedure TUnSwUnit.OpenModule(const AModule: IOTAModule; const AType: TUnSwActivateType);
var
editor: IOTAEditor;
formEditor: IOTAFormEditor;
@ -191,17 +165,19 @@ var
moduleIndex: Integer;
begin
Assert(AType <> atDFM, 'atDFM can not be handled by the OpenModule method');
formEditor := nil;
for moduleIndex := 0 to Pred(AModule.ModuleFileCount) do
begin
editor := AModule.ModuleFileEditors[moduleIndex];
isForm := Supports(editor, IOTAFormEditor);
if (not ASource) and (isForm) and (not Assigned(formEditor)) then
if (AType = atForm) and isForm and (not Assigned(formEditor)) then
formEditor := (editor as IOTAFormEditor);
if not isForm then
editor.Show();
editor.Show;
end;
if Assigned(formEditor) then
@ -217,14 +193,33 @@ begin
FModule := AModule;
end;
procedure TUnSwModuleUnit.Activate(const ASource: Boolean);
procedure TUnSwModuleUnit.Activate(const AType: TUnSwActivateType);
var
dfmFile: string;
ifModule: IOTAModule;
handled: Boolean;
begin
ifModule := FModule.OpenModule();
if Assigned(ifModule) then
OpenModule(ifModule, ASource);
handled := False;
{ Don't use OpenModule for DFM files; can't have a reference to the
IOTAModule or there'll be errors all over the place. }
if AType = atDFM then
begin
dfmFile := ChangeFileExt(FModule.FileName, '.dfm');
if FileExists(dfmFile) then
begin
(BorlandIDEServices as IOTAActionServices).OpenFile(dfmFile);
handled := True;
end;
end;
if not handled then
begin
ifModule := FModule.OpenModule();
if Assigned(ifModule) then
OpenModule(ifModule, AType);
end;
end;
procedure TUnSwModuleUnit.AcceptVisitor(const AVisitor: IUnSwVisitor);
@ -270,7 +265,7 @@ begin
FProject := AProject;
end;
procedure TUnSwProjectUnit.Activate(const ASource: Boolean);
procedure TUnSwProjectUnit.Activate(const AType: TUnSwActivateType);
{$IFDEF DELPHI7ORLOWER}
var
actionIndex: Integer;

30
Source/UnSwSettings.pas
View File

@ -91,6 +91,8 @@ type
property AllowEmptyResult: Boolean read FAllowEmptyResults write FAllowEmptyResults;
end;
TUnSwResetSetting = (rsColors, rsFilter, rsForms, rsUnits);
TUnSwResetSettings = set of TUnSwResetSetting;
TUnSwSettings = class(TObject)
private
@ -106,7 +108,7 @@ type
constructor Create();
destructor Destroy(); override;
procedure ResetDefaults(const AColorsOnly: Boolean = False);
procedure ResetDefaults(const ASettings: TUnSwResetSettings = [rsColors, rsFilter]);
procedure Save();
property Colors: TUnSwColorSettings read FColors write FColors;
@ -352,7 +354,7 @@ begin
end;
procedure TUnSwSettings.ResetDefaults(const AColorsOnly: Boolean);
procedure TUnSwSettings.ResetDefaults(const ASettings: TUnSwResetSettings);
procedure ResetDialog(const ADialog: TUnSwDialogSettings);
begin
@ -365,21 +367,25 @@ procedure TUnSwSettings.ResetDefaults(const AColorsOnly: Boolean);
ADialog.Height := 425;
end;
begin
if not AColorsOnly then
begin
if rsForms in ASettings then
ResetDialog(FFormsDialog);
if rsUnits in ASettings then
ResetDialog(FUnitsDialog);
if rsColors in ASettings then
begin
FColors.Enabled := True;
FColors.DataModules := RGB( 35, 120, 35); // Green
FColors.Forms := RGB( 50, 70, 120); // Blue
FColors.ProjectSource := RGB(120, 120, 35); // Yellow
FColors.Units := RGB(150, 35, 35); // Red
end;
FColors.Enabled := True;
FColors.DataModules := RGB( 35, 120, 35); // Green
FColors.Forms := RGB( 50, 70, 120); // Blue
FColors.ProjectSource := RGB(120, 120, 35); // Yellow
FColors.Units := RGB(150, 35, 35); // Red
FFilter.AllowEmptyResult := False;
if rsFilter in ASettings then
FFilter.AllowEmptyResult := False;
end;
procedure TUnSwSettings.Load();