diff --git a/Lib/D7/UnitSwitcherD7.bpl b/Lib/D7/UnitSwitcherD7.bpl index 6e6a8ee..6c75a88 100644 Binary files a/Lib/D7/UnitSwitcherD7.bpl and b/Lib/D7/UnitSwitcherD7.bpl differ diff --git a/Source/UnSwClient.pas b/Source/UnSwClient.pas index 8183e26..d097805 100644 --- a/Source/UnSwClient.pas +++ b/Source/UnSwClient.pas @@ -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; diff --git a/Source/UnSwConfiguration.dfm b/Source/UnSwConfiguration.dfm index 2548be1..eb15acf 100644 --- a/Source/UnSwConfiguration.dfm +++ b/Source/UnSwConfiguration.dfm @@ -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] diff --git a/Source/UnSwConfiguration.pas b/Source/UnSwConfiguration.pas index e661783..a6caaf0 100644 --- a/Source/UnSwConfiguration.pas +++ b/Source/UnSwConfiguration.pas @@ -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; diff --git a/Source/UnSwDialog.dfm b/Source/UnSwDialog.dfm index bdbec98..e2deee4 100644 --- a/Source/UnSwDialog.dfm +++ b/Source/UnSwDialog.dfm @@ -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 diff --git a/Source/UnSwDialog.pas b/Source/UnSwDialog.pas index 77ecead..8e579d8 100644 --- a/Source/UnSwDialog.pas +++ b/Source/UnSwDialog.pas @@ -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. diff --git a/Source/UnSwFilters.pas b/Source/UnSwFilters.pas index 807ca84..7f4e5a6 100644 --- a/Source/UnSwFilters.pas +++ b/Source/UnSwFilters.pas @@ -8,10 +8,12 @@ unit UnSwFilters; interface uses + Classes, + UnSwObjects; type - TUnSwUnitFilter = class(TUnSwNoRefIntfObject, IUnSwVisitor) + TUnSwUnitFilter = class(TInterfacedPersistent, IUnSwVisitor) private FList: TUnSwUnitList; protected diff --git a/Source/UnSwObjects.pas b/Source/UnSwObjects.pas index a552104..f48e364 100644 --- a/Source/UnSwObjects.pas +++ b/Source/UnSwObjects.pas @@ -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; diff --git a/Source/UnSwSettings.pas b/Source/UnSwSettings.pas index 02360d5..d74751c 100644 --- a/Source/UnSwSettings.pas +++ b/Source/UnSwSettings.pas @@ -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();