GitHub-Mirror/unitswitcher
1
0
Fork 0
mirror of synced 2024-11-21 19:03:51 +00:00
Code Issues Projects Releases Wiki Activity

Fixed: Issue #123

Browse Source 
Fixed: Issue #124
Fixed: Issue #128
Fixed: Issue #133
Fixed: Issue #136
This commit is contained in:
Mark van Renswoude 2006-01-07 19:56:40 +00:00
parent d0fe05e179
commit 61a4f9c651
13 changed files with 1083 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Packages/D2006/UnitSwitcher.bdsproj
View File

@ -120,7 +120,7 @@
</Linker>
<Directories>
<Directories Name="OutputDir"></Directories>
<Directories Name="UnitOutputDir"></Directories>
<Directories Name="UnitOutputDir">..\..\Lib\D2006</Directories>
<Directories Name="PackageDLLOutputDir">..\..\Lib\D2006</Directories>
<Directories Name="PackageDCPOutputDir"></Directories>
<Directories Name="SearchPath"></Directories>

1
Packages/D2006/UnitSwitcher.cfg
View File

@ -31,6 +31,7 @@
-M
-$M16384,1048576
-K$00400000
-N0"..\..\Lib\D2006"
-LE"..\..\Lib\D2006"
-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
-Z

4
Packages/D2006/UnitSwitcher.dpk
View File

@ -35,6 +35,8 @@ contains
UnSwClient in '..\..\Source\UnSwClient.pas',
UnSwObjects in '..\..\Source\UnSwObjects.pas',
UnSwDialog in '..\..\Source\UnSwDialog.pas' {frmUnSwDialog},
UnSwFilters in '..\..\Source\UnSwFilters.pas';
UnSwFilters in '..\..\Source\UnSwFilters.pas',
UnSwConfiguration in '..\..\Source\UnSwConfiguration.pas' {frmUnSwConfiguration},
UnSwSettings in '..\..\Source\UnSwSettings.pas';
end.

3
Packages/D7/UnitSwitcher.cfg
View File

@ -31,8 +31,9 @@
-M
-$M16384,1048576
-K$00400000
-N0"..\..\Lib\D7"
-LE"..\..\Lib\D7"
-LN"c:\program files\borland\delphi7\Projects\Bpl"
-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
-Z
-w-UNSAFE_TYPE
-w-UNSAFE_CODE

BIN
Resources/About.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 766 B

122
Source/UnSwClient.pas
View File

@ -1,3 +1,9 @@
{: Connects UnitSwitcher to the IDE.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
{$ASSERTIONS ON}
unit UnSwClient;
@ -39,14 +45,14 @@ type
{ TUnitSwitcherHook}
constructor TUnitSwitcherHook.Create();
var
iAction: Integer;
ifNTA: INTAServices;
pAction: TContainedAction;
actionIndex: Integer;
ntaServices: INTAServices;
action: TContainedAction;
begin
try
Assert(Assigned(BorlandIDEServices), 'BorlandIDEServices not available.');
Assert(Supports(BorlandIDEServices, INTAServices, ifNTA),
Assert(Supports(BorlandIDEServices, INTAServices, ntaServices),
'BorlandIDEServices does not support the ' +
'INTAServices interface.');
Assert(Supports(BorlandIDEServices, IOTAModuleServices),
@ -58,19 +64,19 @@ begin
'IOTAActionServices interface.');
{$ENDIF}
for iAction := 0 to Pred(ifNTA.ActionList.ActionCount) do
for actionIndex := 0 to Pred(ntaServices.ActionList.ActionCount) do
begin
pAction := ifNTA.ActionList.Actions[iAction];
if pAction.Name = 'ViewUnitCommand' then
action := ntaServices.ActionList.Actions[actionIndex];
if action.Name = 'ViewUnitCommand' then
begin
FOldUnitExecute := pAction.OnExecute;
pAction.OnExecute := NewExecute;
FViewUnitAction := pAction;
end else if pAction.Name = 'ViewFormCommand' then
FOldUnitExecute := action.OnExecute;
action.OnExecute := NewExecute;
FViewUnitAction := action;
end else if action.Name = 'ViewFormCommand' then
begin
FOldFormExecute := pAction.OnExecute;
pAction.OnExecute := NewExecute;
FViewFormAction := pAction;
FOldFormExecute := action.OnExecute;
action.OnExecute := NewExecute;
FViewFormAction := action;
end;
end;
@ -98,32 +104,32 @@ end;
function TUnitSwitcherHook.ActiveFileName(): String;
var
ifModule: IOTAModule;
module: IOTAModule;
begin
Result := '';
ifModule := (BorlandIDEServices as IOTAModuleServices).CurrentModule;
if Assigned(ifModule) then
module := (BorlandIDEServices as IOTAModuleServices).CurrentModule;
if Assigned(module) then
begin
if Assigned(ifModule.CurrentEditor) then
Result := ifModule.FileName;
if Assigned(module.CurrentEditor) then
Result := module.FileName;
end;
end;
{$IFDEF DELPHI7}
function TUnitSwitcherHook.ActiveGroup(): IOTAProjectGroup;
var
ifModule: IOTAModule;
ifModules: IOTAModuleServices;
iModule: Integer;
module: IOTAModule;
moduleServices: IOTAModuleServices;
moduleIndex: Integer;
begin
Result := nil;
ifModules := (BorlandIDEServices as IOTAModuleServices);
for iModule := 0 to Pred(ifModules.ModuleCount) do
moduleServices := (BorlandIDEServices as IOTAModuleServices);
for moduleIndex := 0 to Pred(moduleServices.ModuleCount) do
begin
ifModule := ifModules.Modules[iModule];
if Supports(ifModule, IOTAProjectGroup, Result) then
module := moduleServices.Modules[moduleIndex];
if Supports(module, IOTAProjectGroup, Result) then
break;
end;
end;
@ -132,64 +138,64 @@ end;
function TUnitSwitcherHook.ActiveProject(): IOTAProject;
{$IFDEF DELPHI7}
var
ifGroup: IOTAProjectGroup;
ifModule: IOTAModule;
ifModules: IOTAModuleServices;
iModule: Integer;
projectGroup: IOTAProjectGroup;
module: IOTAModule;
moduleServices: IOTAModuleServices;
moduleIndex: Integer;
{$ENDIF}
begin
{$IFDEF DELPHI7}
Result := nil;
ifGroup := ActiveGroup();
if not Assigned(ifGroup) then
projectGroup := ActiveGroup();
if not Assigned(projectGroup) then
begin
ifModules := (BorlandIDEServices as IOTAModuleServices);
for iModule := 0 to Pred(ifModules.ModuleCount) do
moduleServices := (BorlandIDEServices as IOTAModuleServices);
for moduleIndex := 0 to Pred(moduleServices.ModuleCount) do
begin
ifModule := ifModules.Modules[iModule];
if Supports(ifModule, IOTAProject, Result) then
module := moduleServices.Modules[moduleIndex];
if Supports(module, IOTAProject, Result) then
break;
end;
end else
Result := ifGroup.ActiveProject;
Result := projectGroup.ActiveProject;
{$ELSE}
Result := (BorlandIDEServices as IOTAModuleServices).GetActiveProject
Result := (BorlandIDEServices as IOTAModuleServices).GetActiveProject();
{$ENDIF}
end;
procedure TUnitSwitcherHook.NewExecute(Sender: TObject);
var
iActive: Integer;
ifProject: IOTAProject;
iModule: Integer;
pActive: TUnSwUnit;
pUnits: TUnSwUnitList;
activeIndex: Integer;
project: IOTAProject;
moduleIndex: Integer;
activeUnit: TUnSwUnit;
unitList: TUnSwUnitList;
begin
ifProject := ActiveProject();
if not Assigned(ifProject) then
project := ActiveProject();
if not Assigned(project) then
exit;
pUnits := TUnSwUnitList.Create();
unitList := TUnSwUnitList.Create();
try
pUnits.Add(TUnSwProjectUnit.Create(ifProject));
unitList.Add(TUnSwProjectUnit.Create(project));
for iModule := 0 to Pred(ifProject.GetModuleCount) do
pUnits.Add(TUnSwModuleUnit.Create(ifProject.GetModule(iModule)));
for moduleIndex := 0 to Pred(project.GetModuleCount) do
unitList.Add(TUnSwModuleUnit.Create(project.GetModule(moduleIndex)));
pActive := nil;
iActive := pUnits.IndexOfFileName(ActiveFileName());
if iActive > -1 then
pActive := pUnits[iActive];
activeUnit := nil;
activeIndex := unitList.IndexOfFileName(ActiveFileName());
if activeIndex > -1 then
activeUnit := unitList[activeIndex];
pActive := TfrmUnSwDialog.Execute(pUnits, (Sender = FViewFormAction),
pActive);
if Assigned(pActive) then
pActive.Activate((Sender = FViewUnitAction));
activeUnit := TfrmUnSwDialog.Execute(unitList, (Sender = FViewFormAction),
activeUnit);
if Assigned(activeUnit) then
activeUnit.Activate((Sender = FViewUnitAction));
finally
FreeAndNil(pUnits);
FreeAndNil(unitList);
end;
end;

327
Source/UnSwConfiguration.dfm Normal file
View File

@ -0,0 +1,327 @@
object frmUnSwConfiguration: TfrmUnSwConfiguration
Left = 279
Top = 170
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'UnitSwitcher Configuration'
ClientHeight = 250
ClientWidth = 303
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
DesignSize = (
303
250)
PixelsPerInch = 96
TextHeight = 13
object pcConfiguration: TPageControl
Left = 4
Top = 4
Width = 295
Height = 209
ActivePage = tsGeneral
Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 0
ExplicitHeight = 299
object tsGeneral: TTabSheet
Caption = 'General'
object chkCustomColor: TCheckBox
Left = 8
Top = 8
Width = 249
Height = 17
Caption = 'Use custom text &colors to indicate the unit type:'
Checked = True
State = cbChecked
TabOrder = 0
OnClick = chkCustomColorClick
end
object pnlCustomColor: TPanel
Left = 8
Top = 31
Width = 273
Height = 98
BevelOuter = bvNone
BorderStyle = bsSingle
Color = clWindow
TabOrder = 1
object TImage
Left = 8
Top = 8
Width = 16
Height = 16
Picture.Data = {
055449636F6E0000010001001010100001000400280100001600000028000000
1000000020000000010004000000000080000000000000000000000000000000
0000000000000000000080000080000000808000800000008000800080800000
80808000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000
FFFFFF0000000000000000000000F777777777700000FF8F8F8F8F700000F8F8
F8F8F8700000FF0000000F700000F8F8F8F8F8700000F999999999700400F9FF
FFFFF9700000F999999999700000F8F8F8F8F8700000FF0000008F700000F8F8
F8F8F7700000FF00008F00000000F8F8F8F80F000000FFFFFFFF000000000000
00000000E0000000E0000000E0000000E0000000E00000006000000020000000
000000002000000060000000E0000000E0000000E0000000E0010000E0030000
E0070000}
end
object TImage
Left = 8
Top = 68
Width = 16
Height = 16
Picture.Data = {
055449636F6E0000010001001010100001000400280100001600000028000000
1000000020000000010004000000000080000000000000000000000000000000
0000000000000000000080000080000000808000800000008000800080800000
80808000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000
FFFFFF0000000000000000000F777777777770000FF8F8F8F8F870000F8F8F80
000000000FF8F8F0F77777700F8F8F80FF8F8F700FF8F8F0F8F8F8700F8F8F80
FFFFFFF00FF8F8F0000000000F8F8F80CCCCC0800FF8F8F0000000000F8F8F8F
8F8F70000FFFFFFFFFFFF00000000000000000000CCCCCC08080800000000000
0000000000030000000300000003000000000000000000000000000000000000
0000000000000000000000000000000000030000000300000003000000030000
00030000}
end
object TImage
Left = 8
Top = 48
Width = 16
Height = 16
Picture.Data = {
055449636F6E0000010001001010100001000400280100001600000028000000
1000000020000000010004000000000080000000000000000000000000000000
0000000000000000000080000080000000808000800000008000800080800000
80808000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000
FFFFFF0000040070000000000444407888800000040400777077000004000000
700000000000000000000000700000000000000077000F777777777000000F8F
8F8F8F7000000FF89998F87000000F8F998F8F7000000FF89899F87000000F8F
8F8F8F7000000FFFFFFFFFF0000000000000000000000CCCC080808000000000
00000000EC0F0000840F0000AC0F0000BF3F0000FFFF00001000000010000000
B0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000
F0000000}
end
object TImage
Left = 8
Top = 28
Width = 16
Height = 16
Picture.Data = {
055449636F6E0000010001001010100001000400280100001600000028000000
1000000020000000010004000000000080000000000000000000000000000000
0000000000000000000080000080000000808000800000008000800080800000
80808000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000
FFFFFF000000000000000000000000000000000000000000000000000F777777
777777700FF8F8F8F8F8F8700F8F8F8F8F8F8F700FF8F8F8F8F8F8700F8F8F8F
8F8F8F700FF8F8F8F8F8F8700F8F8F8F8F8F8F700FFFFFFFFFFFFFF000000000
000000000CCCCCCCC08080800000000000000000000000000000000000000000
00000000FFFF0000FFFF00000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000000000FFFF0000
FFFF0000}
end
object lblUnitColor: TLabel
Tag = 1
Left = 32
Top = 10
Width = 19
Height = 13
Cursor = crHandPoint
Caption = 'Unit'
OnClick = PickColor
end
object lblFormColor: TLabel
Tag = 2
Left = 32
Top = 30
Width = 24
Height = 13
Cursor = crHandPoint
Caption = 'Form'
OnClick = PickColor
end
object lblDataModuleColor: TLabel
Tag = 3
Left = 32
Top = 50
Width = 60
Height = 13
Cursor = crHandPoint
Caption = 'Data Module'
OnClick = PickColor
end
object lblProjectColor: TLabel
Tag = 4
Left = 32
Top = 70
Width = 70
Height = 13
Cursor = crHandPoint
Caption = 'Project Source'
OnClick = PickColor
end
object btnUnitColor: TButton
Tag = 1
Left = 240
Top = 8
Width = 23
Height = 18
Caption = '...'
TabOrder = 0
OnClick = PickColor
end
object btnFormColor: TButton
Tag = 2
Left = 240
Top = 28
Width = 23
Height = 18
Caption = '...'
TabOrder = 1
OnClick = PickColor
end
object btnDataModuleColor: TButton
Tag = 3
Left = 240
Top = 48
Width = 23
Height = 18
Caption = '...'
TabOrder = 2
OnClick = PickColor
end
object btnProjectColor: TButton
Tag = 4
Left = 240
Top = 68
Width = 23
Height = 18
Caption = '...'
TabOrder = 3
OnClick = PickColor
end
end
end
object tsAbout: TTabSheet
Caption = 'About...'
ImageIndex = 1
DesignSize = (
287
181)
object imgAbout: TImage
Left = 8
Top = 8
Width = 32
Height = 32
Picture.Data = {
055449636F6E0000010001002020100001000400E80200001600000028000000
2000000040000000010004000000000000020000000000000000000000000000
0000000000000000000080000080000000808000800000008000800080800000
80808000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000
FFFFFF0000000000000000000000000000000000000000000000000000000000
00000000000000F7777777777777777777777700000000F8F8F8F8F8F8F8F8F8
F8F8F700000000FF8F8F8F8F8F8F8F8F8F8F8700000000F8F8F8F8F8F8F8F8F8
F8F8F700000000FF8F8F8F8F8F8F8F8F8F8F8700000000F8F000000000000000
0008F700000000FF8F8F8F8F8F8F8F8F8F8F8700000000F8F8F8F8F8F8F8F8F8
F8F8F700000000FF8F8F8F8F8F8F8F8F8F8F8700000000F8F000000000000000
0008F700000000FF8F8F8F8F8F8F8F8F8F8F87000C0000F99999999999999999
999997000CC000F99999999999999999999997000CCE00F99FFFFFFFFFFFFFFF
FFF997000CE000F99999999999999999999997000E0000F99999999999999999
99999700000000FF8F8F8F8F8F8F8F8F8F8F8700000000F8F000000000000000
0008F700000000FF8F8F8F8F8F8F8F8F8F8F8700000000F8F8F8F8F8F8F8F8F8
F8F8F700000000FF8F8F8F8F8F8F8F8F8F8F8700000000F8F0000000000008F8
77777700000000FF8F8F8F8F8F8F8F8000000000000000F8F8F8F8F8F8F8F8F0
FFFFF000000000FF8F8F8F8F8F8F8F80FFFF0000000000F8F0000000000008F0
FFF00000000000FF8F8F8F8F8F8F8F80FF000000000000F8F8F8F8F8F8F8F8F0
F0000000000000FFFFFFFFFFFFFFFFF000000000000000000000000000000000
00000000FFFFFFFFF8000001F8000001F8000001F8000001F8000001F8000001
F8000001F8000001F8000001F800000178000001380000011800000108000001
0000000108000001180000013800000178000001F8000001F8000001F8000001
F8000001F8000001F8000003F8000007F800000FF800001FF800003FF800007F
F80000FF}
end
object TLabel
Left = 56
Top = 8
Width = 82
Height = 16
Caption = 'UnitSwitcher'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object lblVersion: TLabel
Left = 56
Top = 23
Width = 54
Height = 13
Caption = 'Version 0.2'
end
object TLabel
Left = 56
Top = 106
Width = 145
Height = 13
Anchors = [akLeft, akBottom]
Caption = 'Copyright '#169' 2006 X'#178'Software'
ExplicitTop = 196
end
object TLabel
Left = 56
Top = 130
Width = 225
Height = 41
Anchors = [akLeft, akRight, akBottom]
AutoSize = False
Caption =
'UnitSwitcher is released as open-source under the zlib/libpng OS' +
'I-approved license. See license.txt for details.'
WordWrap = True
ExplicitTop = 220
end
object TLabel
Left = 56
Top = 56
Width = 225
Height = 29
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption =
'Many thanks to Richard L. for the idea, feedback and beta testin' +
'g.'
WordWrap = True
end
end
end
object btnCancel: TButton
Left = 224
Top = 219
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object btnOk: TButton
Left = 143
Top = 219
Width = 75
Height = 25
Anchors = [akRight, akBottom]
Caption = 'OK'
ModalResult = 1
TabOrder = 2
end
object dlgColor: TColorDialog
Options = [cdFullOpen]
Left = 8
Top = 216
end
end

129
Source/UnSwConfiguration.pas Normal file
View File

@ -0,0 +1,129 @@
{: Contains the configuration dialog.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit UnSwConfiguration;
interface
uses
Classes,
ComCtrls,
Controls,
Dialogs,
ExtCtrls,
Forms,
Graphics,
StdCtrls;
type
TfrmUnSwConfiguration = class(TForm)
btnCancel: TButton;
btnDataModuleColor: TButton;
btnFormColor: TButton;
btnOk: TButton;
btnProjectColor: TButton;
btnUnitColor: TButton;
chkCustomColor: TCheckBox;
dlgColor: TColorDialog;
imgAbout: TImage;
lblDataModuleColor: TLabel;
lblFormColor: TLabel;
lblProjectColor: TLabel;
lblUnitColor: TLabel;
lblVersion: TLabel;
pcConfiguration: TPageControl;
pnlCustomColor: TPanel;
tsAbout: TTabSheet;
tsGeneral: TTabSheet;
procedure chkCustomColorClick(Sender: TObject);
procedure PickColor(Sender: TObject);
private
FLabels: array[0..3] of TLabel;
function InternalExecute(): Boolean;
procedure LoadSettings();
procedure SaveSettings();
public
class function Execute(): Boolean;
end;
implementation
uses
UnSwSettings;
{$R *.dfm}
{ TfrmUnSwConfiguration }
class function TfrmUnSwConfiguration.Execute(): Boolean;
begin
with Self.Create(nil) do
try
Result := InternalExecute();
finally
Free();
end;
end;
function TfrmUnSwConfiguration.InternalExecute(): Boolean;
var
iLabel: Integer;
begin
for iLabel := 0 to Pred(pnlCustomColor.ControlCount) do
with pnlCustomColor do
if (Controls[iLabel] is TLabel) and
(Controls[iLabel].Tag > 0) then
FLabels[Pred(Controls[iLabel].Tag)] := TLabel(Controls[iLabel]);
LoadSettings();
Result := (ShowModal() = mrOk);
if Result then
SaveSettings();
end;
procedure TfrmUnSwConfiguration.LoadSettings();
begin
chkCustomColor.Checked := Settings.Colors.Enabled;
lblDataModuleColor.Font.Color := Settings.Colors.DataModules;
lblFormColor.Font.Color := Settings.Colors.Forms;
lblProjectColor.Font.Color := Settings.Colors.ProjectSource;
lblUnitColor.Font.Color := Settings.Colors.Units;
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.Save();
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;
begin
typeLabel := FLabels[Pred((Sender as TComponent).Tag)];
dlgColor.Color := typeLabel.Font.Color;
if dlgColor.Execute() then
typeLabel.Font.Color := dlgColor.Color;
end;
end.

78
Source/UnSwDialog.dfm
View File

@ -3,37 +3,47 @@ object frmUnSwDialog: TfrmUnSwDialog
Top = 83
BorderIcons = [biSystemMenu]
Caption = 'UnitSwitcher'
ClientHeight = 400
ClientWidth = 320
ClientHeight = 398
ClientWidth = 292
Color = clBtnFace
Constraints.MinHeight = 240
Constraints.MinWidth = 172
Constraints.MinWidth = 270
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 = 381
Width = 320
Top = 379
Width = 292
Height = 19
Panels = <
item
Width = 50
end>
ExplicitTop = 408
ExplicitWidth = 299
end
object pnlMain: TPanel
Left = 0
Top = 0
Width = 320
Height = 290
Width = 292
Height = 288
Align = alClient
BevelOuter = bvNone
BorderWidth = 4
@ -43,57 +53,52 @@ object frmUnSwDialog: TfrmUnSwDialog
object pnlSearch: TPanel
Left = 4
Top = 4
Width = 312
Width = 284
Height = 25
Align = alTop
BevelOuter = bvNone
TabOrder = 0
ExplicitWidth = 291
DesignSize = (
312
284
25)
object edtSearch: TEdit
Left = 0
Top = 0
Width = 312
Width = 284
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 0
OnChange = edtSearchChange
OnKeyDown = edtSearchKeyDown
ExplicitWidth = 291
end
end
object lstUnits: TListBox
Left = 4
Top = 29
Width = 312
Height = 257
Width = 284
Height = 255
Style = lbVirtualOwnerDraw
Align = alClient
ItemHeight = 20
TabOrder = 1
OnData = lstUnitsData
OnDblClick = lstUnitsDblClick
OnDrawItem = lstUnitsDrawItem
ExplicitWidth = 291
ExplicitHeight = 284
end
end
object pnlButtons: TPanel
Left = 0
Top = 345
Width = 320
Top = 343
Width = 292
Height = 36
Align = alBottom
BevelOuter = bvNone
TabOrder = 2
ExplicitTop = 372
ExplicitWidth = 299
DesignSize = (
320
292
36)
object btnCancel: TButton
Left = 241
Left = 213
Top = 5
Width = 75
Height = 25
@ -102,10 +107,9 @@ object frmUnSwDialog: TfrmUnSwDialog
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
ExplicitLeft = 220
end
object btnOK: TButton
Left = 160
Left = 132
Top = 5
Width = 75
Height = 25
@ -114,23 +118,29 @@ object frmUnSwDialog: TfrmUnSwDialog
Default = True
ModalResult = 1
TabOrder = 0
ExplicitLeft = 139
end
object btnConfiguration: TButton
Left = 4
Top = 5
Width = 85
Height = 25
Caption = '&Configuration'
TabOrder = 2
OnClick = btnConfigurationClick
end
end
object pnlIncludeTypes: TPanel
Left = 0
Top = 290
Width = 320
Top = 288
Width = 292
Height = 55
Align = alBottom
BevelOuter = bvNone
TabOrder = 1
ExplicitTop = 317
ExplicitWidth = 299
object chkDataModules: TCheckBox
Left = 4
Top = 19
Width = 291
Width = 137
Height = 17
Caption = 'Show &DataModule units'
TabOrder = 1
@ -139,7 +149,7 @@ object frmUnSwDialog: TfrmUnSwDialog
object chkForms: TCheckBox
Left = 4
Top = 2
Width = 291
Width = 101
Height = 17
Caption = 'Show &Form units'
TabOrder = 0
@ -148,7 +158,7 @@ object frmUnSwDialog: TfrmUnSwDialog
object chkProjectSource: TCheckBox
Left = 4
Top = 36
Width = 291
Width = 121
Height = 17
Caption = 'Show &Project source'
TabOrder = 2

195
Source/UnSwDialog.pas
View File

@ -1,3 +1,9 @@
{: Contains the UnitSwitcher main dialog.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit UnSwDialog;
interface
@ -7,6 +13,7 @@ uses
Controls,
ExtCtrls,
Forms,
Graphics,
ImgList,
StdCtrls,
Windows,
@ -15,18 +22,21 @@ uses
UnSwFilters;
type
TUnSwIconVisitor = class(TUnSwNoRefIntfObject, IUnSwVisitor)
TUnSwStyleVisitor = class(TUnSwNoRefIntfObject, IUnSwVisitor)
private
FColor: TColor;
FImageIndex: Integer;
protected
procedure VisitModule(const AUnit: TUnSwModuleUnit);
procedure VisitProject(const AUnit: TUnSwProjectUnit);
public
property Color: TColor read FColor;
property ImageIndex: Integer read FImageIndex;
end;
TfrmUnSwDialog = class(TForm)
btnCancel: TButton;
btnConfiguration: TButton;
btnOK: TButton;
chkDataModules: TCheckBox;
chkForms: TCheckBox;
@ -40,9 +50,12 @@ type
pnlSearch: TPanel;
sbStatus: TStatusBar;
procedure FormResize(Sender: TObject);
procedure btnConfigurationClick(Sender: TObject);
procedure edtSearchChange(Sender: TObject);
procedure edtSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure TypeFilterChange(Sender: TObject);
procedure lstUnitsDblClick(Sender: TObject);
procedure lstUnitsData(Control: TWinControl; Index: Integer; var Data: string);
procedure lstUnitsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
private
@ -57,7 +70,7 @@ type
FTypeFilter: TUnSwUnitTypeFilter;
FInputFilter: TUnSwUnitSimpleFilter;
FIconVisitor: TUnSwIconVisitor;
FStyleVisitor: TUnSwStyleVisitor;
function InternalExecute(): TUnSwUnit;
procedure UpdateTypeFilter();
@ -75,28 +88,44 @@ type
implementation
uses
Graphics,
Messages,
SysUtils;
SysUtils,
UnSwConfiguration,
UnSwSettings;
{$R *.dfm}
{ TUnSwIconVisitor }
procedure TUnSwIconVisitor.VisitModule(const AUnit: TUnSwModuleUnit);
{ TUnSwStyleVisitor }
procedure TUnSwStyleVisitor.VisitModule(const AUnit: TUnSwModuleUnit);
begin
case AUnit.UnitType of
swutUnit: FImageIndex := 1;
swutForm: FImageIndex := 2;
swutDataModule: FImageIndex := 3;
swutUnit:
begin
FColor := Settings.Colors.Units;
FImageIndex := 1;
end;
swutForm:
begin
FColor := Settings.Colors.Forms;
FImageIndex := 2;
end;
swutDataModule:
begin
FColor := Settings.Colors.DataModules;
FImageIndex := 3;
end
else
FColor := clWindowText;
FImageIndex := 0;
end;
end;
procedure TUnSwIconVisitor.VisitProject(const AUnit: TUnSwProjectUnit);
procedure TUnSwStyleVisitor.VisitProject(const AUnit: TUnSwProjectUnit);
begin
FColor := Settings.Colors.ProjectSource;
FImageIndex := 4;
end;
@ -117,6 +146,11 @@ begin
end;
end;
procedure TfrmUnSwDialog.FormResize(Sender: TObject);
begin
lstUnits.Invalidate();
end;
function SortByName(Item1, Item2: Pointer): Integer;
begin
Result := CompareText(TUnSwUnit(Item1).Name, TUnSwUnit(Item2).Name)
@ -137,18 +171,22 @@ begin
LoadSettings();
if FFormsOnly then
begin
pnlIncludeTypes.Visible := False;
Self.Caption := 'UnitSwitcher - View Form';
end else
Self.Caption := 'UnitSwitcher - View Unit';
UpdateTypeFilter();
FIconVisitor := TUnSwIconVisitor.Create();
FStyleVisitor := TUnSwStyleVisitor.Create();
try
if Self.ShowModal() = mrOk then
Result := GetActiveUnit();
SaveSettings();
finally
FreeAndNil(FIconVisitor);
FreeAndNil(FStyleVisitor);
end;
finally
FreeAndNil(FInputFilter);
@ -160,10 +198,10 @@ end;
procedure TfrmUnSwDialog.UpdateList();
var
pActive: TUnSwUnit;
activeUnit: TUnSwUnit;
begin
pActive := GetActiveUnit();
activeUnit := GetActiveUnit();
FInputFilteredList.Clone(FTypeFilteredList);
FInputFilteredList.AcceptVisitor(FInputFilter);
@ -171,8 +209,8 @@ begin
lstUnits.Count := FInputFilteredList.Count;
if FInputFilteredList.Count > 0 then
begin
if Assigned(pActive) then
lstUnits.ItemIndex := FInputFilteredList.IndexOf(pActive);
if Assigned(activeUnit) then
lstUnits.ItemIndex := FInputFilteredList.IndexOf(activeUnit);
if lstUnits.ItemIndex = -1 then
lstUnits.ItemIndex := 0;
@ -206,91 +244,54 @@ end;
procedure TfrmUnSwDialog.LoadSettings();
var
pSettings: TUnSwRegistry;
function ReadBoolDef(const AName: String; const ADefault: Boolean): Boolean;
begin
if pSettings.ValueExists(AName) then
Result := pSettings.ReadBool(AName)
else
Result := ADefault;
end;
function ReadIntegerDef(const AName: String; const ADefault: Integer): Integer;
dialogSettings: TUnSwDialogSettings;
begin
if pSettings.ValueExists(AName) then
Result := pSettings.ReadInteger(AName)
else
Result := ADefault;
end;
var
sKey: String;
begin
pSettings := TUnSwRegistry.Create();
with pSettings do
try
FLoading := True;
RootKey := HKEY_CURRENT_USER;
if OpenIDEKey() then
begin
chkForms.Checked := ReadBoolDef('IncludeForms', FTypeFilter.IncludeForms);
chkDataModules.Checked := ReadBoolDef('IncludeDataModules', FTypeFilter.IncludeDataModules);
chkProjectSource.Checked := ReadBoolDef('IncludeProjectSource', FTypeFilter.IncludeProjectSource);
if FFormsOnly then
sKey := 'Forms'
dialogSettings := Settings.FormsDialog
else
sKey := 'Units';
dialogSettings := Settings.UnitsDialog;
Self.ClientWidth := ReadIntegerDef(sKey + 'DialogWidth', Self.ClientWidth);
Self.ClientHeight := ReadIntegerDef(sKey + 'DialogHeight', Self.ClientHeight);
Self.Caption := 'UnitSwitcher - View ' + sKey;
FLoading := True;
try
chkDataModules.Checked := dialogSettings.IncludeDataModules;
chkForms.Checked := dialogSettings.IncludeForms;
chkProjectSource.Checked := dialogSettings.IncludeProjectSource;
CloseKey();
end;
Self.ClientWidth := dialogSettings.Width;
Self.ClientHeight := dialogSettings.Height;
finally
FLoading := False;
FreeAndNil(pSettings);
end;
end;
procedure TfrmUnSwDialog.SaveSettings();
var
sKey: String;
dialogSettings: TUnSwDialogSettings;
begin
with TUnSwRegistry.Create() do
try
FLoading := True;
RootKey := HKEY_CURRENT_USER;
if OpenIDEKey() then
begin
WriteBool('IncludeForms', chkForms.Checked);
WriteBool('IncludeDataModules', chkDataModules.Checked);
WriteBool('IncludeProjectSource', chkProjectSource.Checked);
if FFormsOnly then
sKey := 'Forms'
dialogSettings := Settings.FormsDialog
else
sKey := 'Units';
dialogSettings := Settings.UnitsDialog;
WriteInteger(sKey + 'DialogWidth', Self.ClientWidth);
WriteInteger(sKey + 'DialogHeight', Self.ClientHeight);
dialogSettings.IncludeDataModules := chkForms.Checked;
dialogSettings.IncludeForms := chkDataModules.Checked;
dialogSettings.IncludeProjectSource := chkProjectSource.Checked;
CloseKey();
end;
finally
FLoading := False;
Free();
end;
dialogSettings.Width := Self.ClientWidth;
dialogSettings.Height := Self.ClientHeight;
Settings.Save();
end;
procedure TfrmUnSwDialog.btnConfigurationClick(Sender: TObject);
begin
if TfrmUnSwConfiguration.Execute() then
lstUnits.Invalidate();
end;
procedure TfrmUnSwDialog.edtSearchChange(Sender: TObject);
begin
FInputFilter.Filter := edtSearch.Text;
@ -310,6 +311,11 @@ begin
UpdateTypeFilter();
end;
procedure TfrmUnSwDialog.lstUnitsDblClick(Sender: TObject);
begin
btnOK.Click();
end;
procedure TfrmUnSwDialog.lstUnitsData(Control: TWinControl; Index: Integer;
var Data: string);
begin
@ -319,18 +325,20 @@ end;
procedure TfrmUnSwDialog.lstUnitsDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
pUnit: TUnSwUnit;
rText: TRect;
sText: String;
currentUnit: TUnSwUnit;
textRect: TRect;
text: String;
begin
with TListBox(Control) do
begin
pUnit := FInputFilteredList[Index];
if FFormsOnly and (pUnit is TUnSwModuleUnit) then
sText := TUnSwModuleUnit(pUnit).FormName
currentUnit := FInputFilteredList[Index];
currentUnit.AcceptVisitor(FStyleVisitor);
if FFormsOnly and (currentUnit is TUnSwModuleUnit) then
text := TUnSwModuleUnit(currentUnit).FormName
else
sText := pUnit.Name;
text := currentUnit.Name;
if odSelected in State then
begin
@ -339,18 +347,19 @@ begin
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);
rText := Rect;
InflateRect(rText, -2, -2);
textRect := Rect;
InflateRect(textRect, -2, -2);
ilsTypes.Draw(Canvas, textRect.Left, textRect.Top, FStyleVisitor.ImageIndex);
pUnit.AcceptVisitor(FIconVisitor);
ilsTypes.Draw(Canvas, rText.Left, rText.Top, FIconVisitor.ImageIndex);
Inc(rText.Left, ilsTypes.Width + 4);
DrawText(Canvas.Handle, PChar(sText), Length(sText), rText, DT_SINGLELINE or
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;

18
Source/UnSwFilters.pas
View File

@ -1,3 +1,9 @@
{: Implements unit filtering visitors.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit UnSwFilters;
interface
@ -129,21 +135,21 @@ end;
procedure TUnSwUnitTypeFilter.VisitModule(const AUnit: TUnSwModuleUnit);
var
eValidTypes: TUnSwUnitTypes;
validTypes: TUnSwUnitTypes;
begin
eValidTypes := [];
validTypes := [];
if FIncludeDataModules then
Include(eValidTypes, swutDataModule);
Include(validTypes, swutDataModule);
if FIncludeForms then
Include(eValidTypes, swutForm);
Include(validTypes, swutForm);
if FIncludeUnits then
Include(eValidTypes, swutUnit);
Include(validTypes, swutUnit);
if not (AUnit.UnitType in eValidTypes) then
if not (AUnit.UnitType in validTypes) then
FilterUnit(AUnit);
end;

93
Source/UnSwObjects.pas
View File

@ -1,3 +1,9 @@
{: Implements unit handling.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit UnSwObjects;
{$I UnSwDefines.inc}
@ -6,7 +12,6 @@ interface
uses
Classes,
Contnrs,
Registry,
ToolsAPI;
type
@ -133,13 +138,11 @@ type
write SetItem; default;
end;
TUnSwRegistry = class(TRegistry)
public
function OpenIDEKey(): Boolean;
end;
implementation
uses
{$IFDEF DELPHI7}
ActnList,
{$ENDIF}
SysUtils;
@ -178,27 +181,27 @@ end;
procedure TUnSwUnit.OpenModule(const AModule: IOTAModule; const ASource: Boolean);
{$IFDEF DELPHI7}
var
ifEditor: IOTAEditor;
iModule: Integer;
editor: IOTAEditor;
formEditor: IOTAFormEditor;
moduleIndex: Integer;
{$ENDIF}
begin
{$IFDEF DELPHI7}
for iModule := 0 to Pred(AModule.ModuleFileCount) do
if Supports(AModule.ModuleFileEditors[iModule], IOTAFormEditor,
ifEditor) then
for moduleIndex := 0 to Pred(AModule.ModuleFileCount) do
begin
editor := AModule.ModuleFileEditors[moduleIndex];
if not ASource then
begin
ifEditor.Show();
break;
end;
if not Assigned(formEditor) then
Supports(editor, IOTAFormEditor, formEditor);
end else
if ASource then
begin
AModule.ModuleFileEditors[iModule].Show();
break;
editor.Show();
end;
if Assigned(formEditor) then
formEditor.Show();
{$ELSE}
if ASource then
AModule.ShowFilename(AModule.FileName)
@ -270,8 +273,30 @@ begin
end;
procedure TUnSwProjectUnit.Activate(const ASource: Boolean);
{$IFDEF DELPHI7}
var
actionIndex: Integer;
ntaServices: INTAServices;
action: TContainedAction;
{$ENDIF}
begin
OpenModule(FProject, False);
{$IFDEF DELPHI7}
// Bit of a hack, but opening the file itself will result in Delphi 7
// reloading the project...
ntaServices := (BorlandIDEServices as INTAServices);
for actionIndex := 0 to Pred(ntaServices.ActionList.ActionCount) do
begin
action := ntaServices.ActionList.Actions[actionIndex];
if action.Name = 'ProjectViewSourceCommand' then
begin
action.Execute();
break;
end;
end;
{$ELSE}
OpenModule(FProject, True);
{$ENDIF}
end;
procedure TUnSwProjectUnit.AcceptVisitor(const AVisitor: IUnSwVisitor);
@ -286,7 +311,7 @@ end;
function TUnSwProjectUnit.GetFileName(): String;
begin
Result := FProject.FileName;
end;
@ -309,11 +334,11 @@ end;
procedure TUnSwUnitList.AcceptVisitor(const AVisitor: IUnSwVisitor);
var
iItem: Integer;
itemIndex: Integer;
begin
for iItem := Pred(Count) downto 0 do
Items[iItem].AcceptVisitor(AVisitor);
for itemIndex := Pred(Count) downto 0 do
Items[itemIndex].AcceptVisitor(AVisitor);
end;
function TUnSwUnitList.Add(const AUnit: TUnSwUnit): Integer;
@ -328,17 +353,17 @@ end;
function TUnSwUnitList.IndexOfFileName(const AFileName: String): Integer;
var
iItem: Integer;
itemIndex: Integer;
begin
Result := -1;
if Length(AFileName) = 0 then
exit;
for iItem := Pred(Count) downto 0 do
if SameText(Items[iItem].FileName, AFileName) then
for itemIndex := Pred(Count) downto 0 do
if SameText(Items[itemIndex].FileName, AFileName) then
begin
Result := iItem;
Result := itemIndex;
break;
end;
end;
@ -360,14 +385,14 @@ end;
procedure TUnSwUnitList.Clone(const ASource: TUnSwUnitList);
var
iItem: Integer;
itemIndex: Integer;
begin
FItems.Clear();
FItems.OwnsObjects := False;
for iItem := 0 to Pred(ASource.Count) do
FItems.Add(ASource[iItem]);
for itemIndex := 0 to Pred(ASource.Count) do
FItems.Add(ASource[itemIndex]);
end;
@ -386,12 +411,4 @@ begin
FItems[Index] := Value;
end;
{ TUnSwRegistry }
function TUnSwRegistry.OpenIDEKey(): Boolean;
begin
Result := OpenKey((BorlandIDEServices as IOTAServices).GetBaseRegistryKey() +
'\UnitSwitcher', True);
end;
end.

332
Source/UnSwSettings.pas Normal file
View File

@ -0,0 +1,332 @@
{: Encapsulates the settings.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit UnSwSettings;
interface
uses
Graphics,
Registry;
type
TUnSwBaseSettings = class(TObject)
protected
procedure Load(const ARegistry: TRegistry); virtual; abstract;
procedure Save(const ARegistry: TRegistry); virtual; abstract;
function GetKeyName(const AName: String): String; virtual;
procedure ReadBoolDef(const ARegistry: TRegistry; var AValue: Boolean; const AName: String);
procedure ReadIntegerDef(const ARegistry: TRegistry; var AValue: Integer; const AName: String);
procedure ReadColorDef(const ARegistry: TRegistry; var AValue: TColor; const AName: String);
procedure WriteBool(const ARegistry: TRegistry; const AValue: Boolean; const AName: String);
procedure WriteInteger(const ARegistry: TRegistry; const AValue: Integer; const AName: String);
procedure WriteColor(const ARegistry: TRegistry; const AValue: TColor; const AName: String);
end;
TUnSwDialogSettings = class(TUnSwBaseSettings)
private
FHeight: Integer;
FIncludeDataModules: Boolean;
FIncludeForms: Boolean;
FIncludeProjectSource: Boolean;
FIncludeUnits: Boolean;
FPrefix: String;
FWidth: Integer;
protected
function GetKeyName(const AName: String): String; override;
procedure Load(const ARegistry: TRegistry); override;
procedure Save(const ARegistry: TRegistry); override;
public
constructor Create(const APrefix: String);
property Height: Integer read FHeight write FHeight;
property IncludeDataModules: Boolean read FIncludeDataModules write FIncludeDataModules;
property IncludeForms: Boolean read FIncludeForms write FIncludeForms;
property IncludeProjectSource: Boolean read FIncludeProjectSource write FIncludeProjectSource;
property IncludeUnits: Boolean read FIncludeUnits write FIncludeUnits;
property Width: Integer read FWidth write FWidth;
end;
TUnSwColorSettings = class(TUnSwBaseSettings)
private
FDataModules: TColor;
FEnabled: Boolean;
FForms: TColor;
FProjectSource: TColor;
FUnits: TColor;
protected
procedure Load(const ARegistry: TRegistry); override;
procedure Save(const ARegistry: TRegistry); override;
public
property DataModules: TColor read FDataModules write FDataModules;
property Enabled: Boolean read FEnabled write FEnabled;
property Forms: TColor read FForms write FForms;
property ProjectSource: TColor read FProjectSource write FProjectSource;
property Units: TColor read FUnits write FUnits;
end;
TUnSwSettings = class(TObject)
private
FColors: TUnSwColorSettings;
FFormsDialog: TUnSwDialogSettings;
FUnitsDialog: TUnSwDialogSettings;
FRegistryKey: String;
protected
procedure Load();
public
constructor Create();
destructor Destroy(); override;
procedure ResetDefaults();
procedure Save();
property Colors: TUnSwColorSettings read FColors write FColors;
property FormsDialog: TUnSwDialogSettings read FFormsDialog write FFormsDialog;
property UnitsDialog: TUnSwDialogSettings read FUnitsDialog write FUnitsDialog;
end;
function Settings(): TUnSwSettings;
implementation
uses
SysUtils,
ToolsAPI,
Windows;
var
GSettings: TUnSwSettings;
function Settings(): TUnSwSettings;
begin
if not Assigned(GSettings) then
GSettings := TUnSwSettings.Create();
Result := GSettings;
end;
{ TUnSwBaseSettings }
function TUnSwBaseSettings.GetKeyName(const AName: String): String;
begin
Result := AName;
end;
procedure TUnSwBaseSettings.ReadBoolDef(const ARegistry: TRegistry;
var AValue: Boolean;
const AName: String);
begin
if ARegistry.ValueExists(GetKeyName(AName)) then
AValue := ARegistry.ReadBool(GetKeyName(AName));
end;
procedure TUnSwBaseSettings.ReadColorDef(const ARegistry: TRegistry;
var AValue: TColor;
const AName: String);
begin
if ARegistry.ValueExists(GetKeyName(AName)) then
AValue := TColor(ARegistry.ReadInteger(GetKeyName(AName)));
end;
procedure TUnSwBaseSettings.ReadIntegerDef(const ARegistry: TRegistry;
var AValue: Integer;
const AName: String);
begin
if ARegistry.ValueExists(GetKeyName(AName)) then
AValue := ARegistry.ReadInteger(GetKeyName(AName));
end;
procedure TUnSwBaseSettings.WriteBool(const ARegistry: TRegistry;
const AValue: Boolean;
const AName: String);
begin
ARegistry.WriteBool(GetKeyName(AName), AValue);
end;
procedure TUnSwBaseSettings.WriteColor(const ARegistry: TRegistry;
const AValue: TColor;
const AName: String);
begin
WriteInteger(ARegistry, Integer(AValue), AName);
end;
procedure TUnSwBaseSettings.WriteInteger(const ARegistry: TRegistry;
const AValue: Integer;
const AName: String);
begin
ARegistry.WriteInteger(GetKeyName(AName), AValue);
end;
{ TUnSwDialogSettings }
constructor TUnSwDialogSettings.Create(const APrefix: String);
begin
inherited Create();
FPrefix := APrefix;
end;
function TUnSwDialogSettings.GetKeyName(const AName: String): String;
begin
Result := FPrefix + AName;
end;
procedure TUnSwDialogSettings.Load(const ARegistry: TRegistry);
begin
// Conversion v0.1 -> v0.2
if ARegistry.ValueExists('IncludeDataModules') then
begin
ARegistry.RenameValue('IncludeDataModules', 'UnitsIncludeDataModules');
ARegistry.RenameValue('IncludeForms', 'UnitsIncludeForms');
ARegistry.RenameValue('IncludeProjectSource', 'UnitsIncludeProjectSource');
ARegistry.RenameValue('FormsDialogHeight', 'FormsHeight');
ARegistry.RenameValue('FormsDialogWidth', 'FormsWidth');
ARegistry.RenameValue('UnitsDialogHeight', 'UnitsHeight');
ARegistry.RenameValue('UnitsDialogWidth', 'UnitsWidth');
end;
ReadBoolDef(ARegistry, FIncludeDataModules, 'IncludeDataModules');
ReadBoolDef(ARegistry, FIncludeForms, 'IncludeForms');
ReadBoolDef(ARegistry, FIncludeProjectSource, 'IncludeProjectSource');
ReadBoolDef(ARegistry, FIncludeUnits, 'IncludeUnits');
ReadIntegerDef(ARegistry, FWidth, 'Width');
ReadIntegerDef(ARegistry, FHeight, 'Height');
end;
procedure TUnSwDialogSettings.Save(const ARegistry: TRegistry);
begin
WriteBool(ARegistry, FIncludeDataModules, 'IncludeDataModules');
WriteBool(ARegistry, FIncludeForms, 'IncludeForms');
WriteBool(ARegistry, FIncludeProjectSource, 'IncludeProjectSource');
WriteBool(ARegistry, FIncludeUnits, 'IncludeUnits');
WriteInteger(ARegistry, FWidth, 'Width');
WriteInteger(ARegistry, FHeight, 'Height');
end;
{ TUnSwColorSettings }
procedure TUnSwColorSettings.Load(const ARegistry: TRegistry);
begin
ReadBoolDef(ARegistry, FEnabled, 'ColorEnabled');
ReadColorDef(ARegistry, FDataModules, 'ColorDataModules');
ReadColorDef(ARegistry, FForms, 'ColorForms');
ReadColorDef(ARegistry, FProjectSource, 'ColorProjectSource');
ReadColorDef(ARegistry, FUnits, 'ColorUnits');
end;
procedure TUnSwColorSettings.Save(const ARegistry: TRegistry);
begin
WriteBool(ARegistry, FEnabled, 'ColorEnabled');
WriteColor(ARegistry, FDataModules, 'ColorDataModules');
WriteColor(ARegistry, FForms, 'ColorForms');
WriteColor(ARegistry, FProjectSource, 'ColorProjectSource');
WriteColor(ARegistry, FUnits, 'ColorUnits');
end;
{ TUnSwSettings }
constructor TUnSwSettings.Create();
begin
inherited Create();
FRegistryKey := (BorlandIDEServices as IOTAServices).GetBaseRegistryKey() +
'\UnitSwitcher';
FColors := TUnSwColorSettings.Create();
FFormsDialog := TUnSwDialogSettings.Create('Forms');
FUnitsDialog := TUnSwDialogSettings.Create('Units');
ResetDefaults();
end;
destructor TUnSwSettings.Destroy();
begin
FreeAndNil(FUnitsDialog);
FreeAndNil(FFormsDialog);
FreeAndNil(FColors);
inherited;
end;
procedure TUnSwSettings.ResetDefaults();
procedure ResetDialog(const ADialog: TUnSwDialogSettings);
begin
ADialog.IncludeDataModules := True;
ADialog.IncludeForms := True;
ADialog.IncludeProjectSource := True;
ADialog.IncludeUnits := True;
ADialog.Width := 300;
ADialog.Height := 425;
end;
begin
ResetDialog(FFormsDialog);
ResetDialog(FUnitsDialog);
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;
procedure TUnSwSettings.Load();
var
ideRegistry: TRegistry;
begin
ideRegistry := TRegistry.Create();
with ideRegistry do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(FRegistryKey, False) then
begin
FColors.Load(ideRegistry);
FFormsDialog.Load(ideRegistry);
FUnitsDialog.Load(ideRegistry);
CloseKey();
end;
finally
Free();
end;
end;
procedure TUnSwSettings.Save();
var
ideRegistry: TRegistry;
begin
ideRegistry := TRegistry.Create();
with ideRegistry do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(FRegistryKey, True) then
begin
FColors.Save(ideRegistry);
FFormsDialog.Save(ideRegistry);
FUnitsDialog.Save(ideRegistry);
CloseKey();
end;
finally
Free();
end;
end;
initialization
finalization
FreeAndNil(GSettings);
end.