Fixed: Issue #157

Fixed: Issue #159 Fixed: Issue #170 Fixed: Issue #171
2024-11-23 11:53:50 +00:00 · 2006-01-26 19:40:23 +00:00 · 2006-01-26 19:40:23 +00:00 · e4bfc5b840
commit e4bfc5b840
parent 105050b957
6 changed files with 517 additions and 12 deletions
--- a/Source/UnSwConfiguration.dfm
+++ b/Source/UnSwConfiguration.dfm
@ -268,7 +268,7 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
        Top = 23
        Width = 54
        Height = 13
-        Caption = 'Version 0.3'
+        Caption = 'Version 0.4'
      end
      object TLabel
        Left = 135
@ -317,6 +317,21 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
        ParentFont = False
        OnClick = lblBugReportClick
      end
+      object lblShortcutKeys: TLabel
+        Left = 56
+        Top = 141
+        Width = 127
+        Height = 13
+        Cursor = crHandPoint
+        Caption = 'Overview of shortcut keys'
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clBlue
+        Font.Height = -11
+        Font.Name = 'Tahoma'
+        Font.Style = [fsUnderline]
+        ParentFont = False
+        OnClick = lblShortcutKeysClick
+      end
    end
  end
  object btnCancel: TButton
--- a/Source/UnSwConfiguration.pas
+++ b/Source/UnSwConfiguration.pas
@ -39,6 +39,8 @@ type
    pnlCustomColor:                             TPanel;
    tsAbout:                                    TTabSheet;
    tsGeneral:                                  TTabSheet;
+    lblShortcutKeys: TLabel;
+    procedure lblShortcutKeysClick(Sender: TObject);

    procedure btnDefaultClick(Sender: TObject);
    procedure chkCustomColorClick(Sender: TObject);
@ -60,7 +62,8 @@ uses
  ShellAPI,
  Windows,

-  UnSwSettings;
+  UnSwSettings,
+  UnSwShortcuts;

 {$R *.dfm}

@ -98,6 +101,11 @@ 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;
--- a/Source/UnSwDialog.dfm
+++ b/Source/UnSwDialog.dfm
@ -1,10 +1,10 @@
 object frmUnSwDialog: TfrmUnSwDialog
  Left = 187
  Top = 83
-  Width = 320
-  Height = 425
  BorderIcons = [biSystemMenu]
  Caption = 'UnitSwitcher'
+  ClientHeight = 398
+  ClientWidth = 312
  Color = clBtnFace
  Constraints.MinHeight = 240
  Constraints.MinWidth = 290
@ -65,7 +65,9 @@ object frmUnSwDialog: TfrmUnSwDialog
        Top = 0
        Width = 304
        Height = 21
+        AutoComplete = False
        Anchors = [akLeft, akTop, akRight]
+        DropDownCount = 10
        ItemHeight = 13
        TabOrder = 0
        OnChange = cmbSearchChange
@ -84,6 +86,7 @@ object frmUnSwDialog: TfrmUnSwDialog
      MultiSelect = True
      PopupMenu = pmnUnits
      TabOrder = 1
+      OnClick = lstUnitsClick
      OnData = lstUnitsData
      OnDblClick = lstUnitsDblClick
      OnDrawItem = lstUnitsDrawItem
@ -637,10 +640,15 @@ object frmUnSwDialog: TfrmUnSwDialog
      OnExecute = actOpenFolderExecute
    end
    object actOpenProperties: TAction
-      Caption = '&Properties'
+      Caption = '.PAS &Properties'
      ShortCut = 49165
      OnExecute = actOpenPropertiesExecute
    end
+    object actOpenDFMProperties: TAction
+      Caption = '&.DFM Properties'
+      ShortCut = 24589
+      OnExecute = actOpenDFMPropertiesExecute
+    end
    object actMRUPrior: TAction
      Caption = 'actMRUPrior'
      ShortCut = 16422
@ -653,6 +661,7 @@ object frmUnSwDialog: TfrmUnSwDialog
    end
  end
  object pmnUnits: TPopupMenu
+    OnPopup = pmnUnitsPopup
    Left = 72
    Top = 264
    object pmnUnitsSelectAll: TMenuItem
@ -679,5 +688,8 @@ object frmUnSwDialog: TfrmUnSwDialog
    object pmnUnitsOpenProperties: TMenuItem
      Action = actOpenProperties
    end
+    object pmnUnitsOpenDFMProperties: TMenuItem
+      Action = actOpenDFMProperties
+    end
  end
 end
--- a/Source/UnSwDialog.pas
+++ b/Source/UnSwDialog.pas
@ -6,6 +6,8 @@
 }
 unit UnSwDialog;

+{$WARN SYMBOL_PLATFORM OFF}
+
 interface
 uses
  ActnList,
@ -39,6 +41,7 @@ type
  TfrmUnSwDialog = class(TForm)
    actMRUNext:                                 TAction;
    actMRUPrior:                                TAction;
+    actOpenDFMProperties:                       TAction;
    actOpenFolder:                              TAction;
    actOpenProperties:                          TAction;
    actSelectAll:                               TAction;
@ -58,6 +61,7 @@ type
    lblSubFilters:                              TLabel;
    lstUnits:                                   TListBox;
    pmnUnits:                                   TPopupMenu;
+    pmnUnitsOpenDFMProperties:                  TMenuItem;
    pmnUnitsOpenFolder:                         TMenuItem;
    pmnUnitsOpenProperties:                     TMenuItem;
    pmnUnitsSelectAll:                          TMenuItem;
@ -72,10 +76,10 @@ type
    pnlSearch:                                  TPanel;
    pnlSubFilters:                              TPanel;
    sbStatus:                                   TStatusBar;
-    procedure cmbSearchKeyPress(Sender: TObject; var Key: Char);

    procedure actMRUNextExecute(Sender: TObject);
    procedure actMRUPriorExecute(Sender: TObject);
+    procedure actOpenDFMPropertiesExecute(Sender: TObject);
    procedure actOpenFolderExecute(Sender: TObject);
    procedure actOpenPropertiesExecute(Sender: TObject);
    procedure actSelectAllExecute(Sender: TObject);
@ -83,11 +87,14 @@ type
    procedure btnConfigurationClick(Sender: TObject);
    procedure cmbSearchChange(Sender: TObject);
    procedure cmbSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure cmbSearchKeyPress(Sender: TObject; var Key: Char);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
+    procedure lstUnitsClick(Sender: TObject);
    procedure lstUnitsData(Control: TWinControl; Index: Integer; var Data: string);
    procedure lstUnitsDblClick(Sender: TObject);
    procedure lstUnitsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
+    procedure pmnUnitsPopup(Sender: TObject);
    procedure SortExecute(Sender: TObject);
    procedure TypeFilterChange(Sender: TObject);
  private
@ -135,33 +142,48 @@ uses
  SysUtils,

  UnSwConfiguration,
-  UnSwSettings, Dialogs;
+  UnSwSettings;

 type
-  TUnSwOpenVisitor            = class(TInterfacedObject, IUnSwVisitor)
+  TUnSwOpenVisitor = class(TInterfacedObject, IUnSwVisitor)
  private
    FProcessed:     TStringList;
  protected
    function IsProcessed(const AFileName: String; const ARegister: Boolean = True): Boolean;
    procedure OpenFile(const AFileName: String); virtual; abstract;

-    procedure VisitModule(const AUnit: TUnSwModuleUnit);
-    procedure VisitProject(const AUnit: TUnSwProjectUnit);
+    procedure VisitModule(const AUnit: TUnSwModuleUnit); virtual;
+    procedure VisitProject(const AUnit: TUnSwProjectUnit); virtual;
  public
    constructor Create();
    destructor Destroy(); override;
  end;

-  TUnSwOpenFolderVisitor      = class(TUnSwOpenVisitor)
+  TUnSwOpenFolderVisitor = class(TUnSwOpenVisitor)
  protected
    procedure OpenFile(const AFileName: String); override;
  end;

-  TUnSwOpenPropertiesVisitor  = class(TUnSwOpenVisitor)
+  TUnSwOpenPropertiesVisitor = class(TUnSwOpenVisitor)
  protected
    procedure OpenFile(const AFileName: String); override;
  end;

+  TUnSwOpenDFMPropertiesVisitor = class(TUnSwOpenPropertiesVisitor)
+  protected
+    procedure VisitModule(const AUnit: TUnSwModuleUnit); override;
+    procedure VisitProject(const AUnit: TUnSwProjectUnit); override;
+  end;
+
+  TUnSwReadOnlyVisitor = class(TUnSwOpenVisitor)
+  private
+    FReadOnlyCount: Integer;
+  protected
+    procedure OpenFile(const AFileName: String); override;
+  public
+    property ReadOnlyCount:     Integer read FReadOnlyCount;
+  end;
+

 {$R *.dfm}

@ -245,6 +267,32 @@ begin
 end;


+{ TUnSwOpenDFMPropertiesVisitor }
+procedure TUnSwOpenDFMPropertiesVisitor.VisitModule(const AUnit: TUnSwModuleUnit);
+begin
+  OpenFile(ChangeFileExt(AUnit.FileName, '.dfm'));
+end;
+
+procedure TUnSwOpenDFMPropertiesVisitor.VisitProject(const AUnit: TUnSwProjectUnit);
+begin
+end;
+
+
+{ TUnSwReadOnlyVisitor }
+procedure TUnSwReadOnlyVisitor.OpenFile(const AFileName: String);
+var
+  iAttr:      Integer;
+
+begin
+  if not IsProcessed(AFileName) then
+  begin
+    iAttr := FileGetAttr(AFileName);
+    if (iAttr and faReadOnly) <> 0 then
+      Inc(FReadOnlyCount);
+  end;
+end;
+
+
 { TUnSwStyleVisitor }
 procedure TUnSwStyleVisitor.VisitModule(const AUnit: TUnSwModuleUnit);
 begin
@ -407,6 +455,9 @@ begin
    if lstUnits.SelCount = 0 then
      lstUnits.Selected[0]  := True;
  end;
+
+  if Assigned(lstUnits.OnClick) then
+    lstUnits.OnClick(nil);
 end;

 function SortByName(Item1, Item2: Pointer): Integer;
@ -684,6 +735,20 @@ begin
  end;
 end;

+procedure TfrmUnSwDialog.actOpenDFMPropertiesExecute(Sender: TObject);
+var
+  pUnits:     TUnSwUnitList;
+
+begin
+  pUnits  := GetActiveUnits();
+  if Assigned(pUnits) then
+  try
+    pUnits.AcceptVisitor(TUnSwOpenDFMPropertiesVisitor.Create());
+  finally
+    FreeAndNil(pUnits);
+  end;
+end;
+

 procedure TfrmUnSwDialog.btnConfigurationClick(Sender: TObject);
 begin
@ -744,6 +809,37 @@ begin
  btnOK.Click();
 end;

+procedure TfrmUnSwDialog.lstUnitsClick(Sender: TObject);
+var
+  pUnits:     TUnSwUnitList;
+  pVisitor:   TUnSwReadOnlyVisitor;
+  sStatus:    String;
+
+begin
+  pUnits  := GetActiveUnits();
+  if Assigned(pUnits) then
+  try
+    pVisitor  := TUnSwReadOnlyVisitor.Create();
+    try
+      pUnits.AcceptVisitor(pVisitor);
+
+      sStatus := '';
+      if pVisitor.ReadOnlyCount > 0 then
+        if pVisitor.ReadOnlyCount = 1 then
+          sStatus := '1 read-only unit selected'
+        else
+          sStatus := Format('%d read-only units selected',
+                            [pVisitor.ReadOnlyCount]);
+
+      sbStatus.Panels[0].Text := sStatus;
+    finally
+      FreeAndNil(pVisitor);
+    end;
+  finally
+    FreeAndNil(pUnits);
+  end;
+end;
+
 procedure TfrmUnSwDialog.lstUnitsData(Control: TWinControl; Index: Integer;
                                      var Data: string);
 begin
@ -792,4 +888,36 @@ begin
  end;
 end;

+procedure TfrmUnSwDialog.pmnUnitsPopup(Sender: TObject);
+var
+  bDFM:       Boolean;
+  bUnits:     Boolean;
+  iUnit:      Integer;
+  pUnits:     TUnSwUnitList;
+
+begin
+  bDFM      := False;
+  bUnits    := False;
+
+  pUnits    := GetActiveUnits();
+  if Assigned(pUnits) then
+  try
+    bUnits  := (pUnits.Count > 0);
+
+    for iUnit := 0 to Pred(pUnits.Count) do
+      if (pUnits[iUnit] is TUnSwModuleUnit) and
+         (TUnSwModuleUnit(pUnits[iUnit]).UnitType in [swutForm, swutDataModule]) then
+      begin
+        bDFM  := True;
+        break;
+      end;
+  finally
+    FreeAndNil(pUnits);
+  end;
+
+  actOpenFolder.Enabled         := bUnits;
+  actOpenProperties.Enabled     := bUnits;
+  actOpenDFMProperties.Enabled  := bDFM;
+end;
+
 end.
--- a/Source/UnSwShortcuts.dfm
+++ b/Source/UnSwShortcuts.dfm
@ -0,0 +1,302 @@
+object frmUnSwShortcuts: TfrmUnSwShortcuts
+  Left = 188
+  Top = 81
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsDialog
+  Caption = 'UnitSwitcher Shortcut keys'
+  ClientHeight = 470
+  ClientWidth = 354
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poScreenCenter
+  PixelsPerInch = 96
+  TextHeight = 13
+  object lblHeader: TLabel
+    Left = 8
+    Top = 8
+    Width = 105
+    Height = 13
+    Caption = 'Navigating the list:'
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -11
+    Font.Name = 'Tahoma'
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object TLabel
+    Left = 28
+    Top = 28
+    Width = 110
+    Height = 13
+    Caption = 'Up / Down arrow keys:'
+  end
+  object TLabel
+    Left = 168
+    Top = 28
+    Width = 145
+    Height = 13
+    Caption = 'Select the previous / next unit'
+  end
+  object TLabel
+    Left = 28
+    Top = 44
+    Width = 110
+    Height = 13
+    Caption = 'Page-Up / Page-Down:'
+  end
+  object TLabel
+    Left = 168
+    Top = 44
+    Width = 122
+    Height = 13
+    Caption = 'Jump through the unit list'
+  end
+  object TLabel
+    Left = 28
+    Top = 60
+    Width = 101
+    Height = 13
+    Caption = 'Ctrl-Home / Ctrl-End:'
+  end
+  object TLabel
+    Left = 168
+    Top = 60
+    Width = 118
+    Height = 13
+    Caption = 'Select the first / last unit'
+  end
+  object TLabel
+    Left = 8
+    Top = 89
+    Width = 70
+    Height = 13
+    Caption = 'Multi-select:'
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -11
+    Font.Name = 'Tahoma'
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object TLabel
+    Left = 28
+    Top = 108
+    Width = 285
+    Height = 25
+    AutoSize = False
+    Caption = 
+      'Hold Shift while using the navigation keys to select more than o' +
+      'ne unit, or hold Ctrl while clicking with the mouse.'
+    WordWrap = True
+  end
+  object TLabel
+    Left = 28
+    Top = 144
+    Width = 32
+    Height = 13
+    Caption = 'Ctrl-A:'
+  end
+  object TLabel
+    Left = 168
+    Top = 145
+    Width = 152
+    Height = 13
+    Caption = 'Select all units in the current list'
+  end
+  object TLabel
+    Left = 28
+    Top = 160
+    Width = 29
+    Height = 13
+    Caption = 'Ctrl-I:'
+  end
+  object TLabel
+    Left = 168
+    Top = 160
+    Width = 94
+    Height = 13
+    Caption = 'Invert the selection'
+  end
+  object TLabel
+    Left = 8
+    Top = 188
+    Width = 62
+    Height = 13
+    Caption = 'Sub-filters:'
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -11
+    Font.Name = 'Tahoma'
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object TLabel
+    Left = 28
+    Top = 208
+    Width = 43
+    Height = 13
+    Caption = 'Ctrl-Tab:'
+  end
+  object TLabel
+    Left = 168
+    Top = 208
+    Width = 169
+    Height = 13
+    Caption = 'Start a new filter on the current list'
+  end
+  object TLabel
+    Left = 28
+    Top = 224
+    Width = 75
+    Height = 13
+    Caption = 'Ctrl-Backspace:'
+  end
+  object TLabel
+    Left = 168
+    Top = 224
+    Width = 118
+    Height = 13
+    Caption = 'Revert the last sub-filter'
+  end
+  object TLabel
+    Left = 8
+    Top = 316
+    Width = 35
+    Height = 13
+    Caption = 'Other:'
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -11
+    Font.Name = 'Tahoma'
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object TLabel
+    Left = 28
+    Top = 336
+    Width = 49
+    Height = 13
+    Caption = 'Ctrl-Alt-N:'
+  end
+  object TLabel
+    Left = 168
+    Top = 336
+    Width = 99
+    Height = 13
+    Caption = 'Sort the list by name'
+  end
+  object TLabel
+    Left = 28
+    Top = 352
+    Width = 48
+    Height = 13
+    Caption = 'Ctrl-Alt-T:'
+  end
+  object TLabel
+    Left = 168
+    Top = 352
+    Width = 95
+    Height = 13
+    Caption = 'Sort the list by type'
+  end
+  object TLabel
+    Left = 28
+    Top = 367
+    Width = 48
+    Height = 13
+    Caption = 'Ctrl-Alt-F:'
+  end
+  object TLabel
+    Left = 168
+    Top = 368
+    Width = 109
+    Height = 13
+    Caption = 'Open containing folder'
+  end
+  object TLabel
+    Left = 28
+    Top = 384
+    Width = 68
+    Height = 13
+    Caption = 'Ctrl-Alt-Enter:'
+  end
+  object TLabel
+    Left = 168
+    Top = 384
+    Width = 95
+    Height = 13
+    Caption = 'Open file properties'
+  end
+  object TLabel
+    Left = 8
+    Top = 252
+    Width = 119
+    Height = 13
+    Caption = 'Most-Recently-Used:'
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -11
+    Font.Name = 'Tahoma'
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object TLabel
+    Left = 28
+    Top = 288
+    Width = 38
+    Height = 13
+    Caption = 'Ctrl-Up:'
+  end
+  object TLabel
+    Left = 168
+    Top = 288
+    Width = 93
+    Height = 13
+    Caption = 'Use later MRU filter'
+  end
+  object TLabel
+    Left = 28
+    Top = 272
+    Width = 52
+    Height = 13
+    Caption = 'Ctrl-Down:'
+  end
+  object TLabel
+    Left = 168
+    Top = 272
+    Width = 101
+    Height = 13
+    Caption = 'Use earlier MRU filter'
+  end
+  object TLabel
+    Left = 28
+    Top = 400
+    Width = 77
+    Height = 13
+    Caption = 'Ctrl-Shift-Enter:'
+  end
+  object TLabel
+    Left = 168
+    Top = 400
+    Width = 156
+    Height = 13
+    Caption = 'Open file properties for the .dfm'
+  end
+  object btnOk: TButton
+    Left = 139
+    Top = 437
+    Width = 75
+    Height = 25
+    Cancel = True
+    Caption = 'OK'
+    Default = True
+    ModalResult = 1
+    TabOrder = 0
+  end
+end
--- a/Source/UnSwShortcuts.pas
+++ b/Source/UnSwShortcuts.pas
@ -0,0 +1,40 @@
+unit UnSwShortcuts;
+
+interface
+uses
+  Classes,
+  Controls,
+  Forms,
+  StdCtrls;
+
+type
+  TfrmUnSwShortcuts = class(TForm)
+    btnOk:                                      TButton;
+    lblHeader:                                  TLabel;
+  private
+    procedure InternalExecute();
+  public
+    class procedure Execute();
+  end;
+
+implementation
+
+{$R *.dfm}
+
+{ TfrmUnSwShortcuts }
+class procedure TfrmUnSwShortcuts.Execute();
+begin
+  with Self.Create(nil) do
+  try
+    InternalExecute();
+  finally
+    Free();
+  end;
+end;
+
+procedure TfrmUnSwShortcuts.InternalExecute();
+begin
+  ShowModal();
+end;
+
+end.