diff --git a/Packages/D2006/UnitSwitcher.bdsproj b/Packages/D2006/UnitSwitcher.bdsproj index 3449fc1..291ec25 100644 --- a/Packages/D2006/UnitSwitcher.bdsproj +++ b/Packages/D2006/UnitSwitcher.bdsproj @@ -120,7 +120,7 @@ - + ..\..\Lib\D2006 ..\..\Lib\D2006 diff --git a/Packages/D2006/UnitSwitcher.cfg b/Packages/D2006/UnitSwitcher.cfg index 78d6549..7974a03 100644 --- a/Packages/D2006/UnitSwitcher.cfg +++ b/Packages/D2006/UnitSwitcher.cfg @@ -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 diff --git a/Packages/D2006/UnitSwitcher.dpk b/Packages/D2006/UnitSwitcher.dpk index b184c53..9f7a258 100644 --- a/Packages/D2006/UnitSwitcher.dpk +++ b/Packages/D2006/UnitSwitcher.dpk @@ -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. diff --git a/Packages/D7/UnitSwitcher.cfg b/Packages/D7/UnitSwitcher.cfg index 50eb60d..0562327 100644 --- a/Packages/D7/UnitSwitcher.cfg +++ b/Packages/D7/UnitSwitcher.cfg @@ -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 diff --git a/Resources/About.ico b/Resources/About.ico new file mode 100644 index 0000000..f38d0fd Binary files /dev/null and b/Resources/About.ico differ diff --git a/Source/UnSwClient.pas b/Source/UnSwClient.pas index 621d17e..1d4a4f2 100644 --- a/Source/UnSwClient.pas +++ b/Source/UnSwClient.pas @@ -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 + Result := ''; + 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 + Result := nil; + 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 + Result := nil; + 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; diff --git a/Source/UnSwConfiguration.dfm b/Source/UnSwConfiguration.dfm new file mode 100644 index 0000000..ae13662 --- /dev/null +++ b/Source/UnSwConfiguration.dfm @@ -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 diff --git a/Source/UnSwConfiguration.pas b/Source/UnSwConfiguration.pas new file mode 100644 index 0000000..e65bb34 --- /dev/null +++ b/Source/UnSwConfiguration.pas @@ -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. diff --git a/Source/UnSwDialog.dfm b/Source/UnSwDialog.dfm index abc29d2..42d43a9 100644 --- a/Source/UnSwDialog.dfm +++ b/Source/UnSwDialog.dfm @@ -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 diff --git a/Source/UnSwDialog.pas b/Source/UnSwDialog.pas index 1a97783..9e7f4f2 100644 --- a/Source/UnSwDialog.pas +++ b/Source/UnSwDialog.pas @@ -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 - FImageIndex := 0; + 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; - - begin - if pSettings.ValueExists(AName) then - Result := pSettings.ReadInteger(AName) - else - Result := ADefault; - end; - -var - sKey: String; + dialogSettings: TUnSwDialogSettings; begin - pSettings := TUnSwRegistry.Create(); - with pSettings do + if FFormsOnly then + dialogSettings := Settings.FormsDialog + else + dialogSettings := Settings.UnitsDialog; + + FLoading := True; try - FLoading := True; - RootKey := HKEY_CURRENT_USER; + chkDataModules.Checked := dialogSettings.IncludeDataModules; + chkForms.Checked := dialogSettings.IncludeForms; + chkProjectSource.Checked := dialogSettings.IncludeProjectSource; - 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' - else - sKey := 'Units'; - - Self.ClientWidth := ReadIntegerDef(sKey + 'DialogWidth', Self.ClientWidth); - Self.ClientHeight := ReadIntegerDef(sKey + 'DialogHeight', Self.ClientHeight); - Self.Caption := 'UnitSwitcher - View ' + sKey; - - 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 FFormsOnly then + dialogSettings := Settings.FormsDialog + else + dialogSettings := Settings.UnitsDialog; - if OpenIDEKey() then - begin - WriteBool('IncludeForms', chkForms.Checked); - WriteBool('IncludeDataModules', chkDataModules.Checked); - WriteBool('IncludeProjectSource', chkProjectSource.Checked); + dialogSettings.IncludeDataModules := chkForms.Checked; + dialogSettings.IncludeForms := chkDataModules.Checked; + dialogSettings.IncludeProjectSource := chkProjectSource.Checked; - if FFormsOnly then - sKey := 'Forms' - else - sKey := 'Units'; + dialogSettings.Width := Self.ClientWidth; + dialogSettings.Height := Self.ClientHeight; - WriteInteger(sKey + 'DialogWidth', Self.ClientWidth); - WriteInteger(sKey + 'DialogHeight', Self.ClientHeight); - - CloseKey(); - end; - finally - FLoading := False; - Free(); - end; + 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; - Canvas.Font.Color := clWindowText; + 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; diff --git a/Source/UnSwFilters.pas b/Source/UnSwFilters.pas index 09f9201..5e7c3b6 100644 --- a/Source/UnSwFilters.pas +++ b/Source/UnSwFilters.pas @@ -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; diff --git a/Source/UnSwObjects.pas b/Source/UnSwObjects.pas index 94af594..15f6079 100644 --- a/Source/UnSwObjects.pas +++ b/Source/UnSwObjects.pas @@ -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 - 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; - end; + 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. diff --git a/Source/UnSwSettings.pas b/Source/UnSwSettings.pas new file mode 100644 index 0000000..2f85439 --- /dev/null +++ b/Source/UnSwSettings.pas @@ -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.