1
0
mirror of synced 2024-11-15 00:43:50 +00:00

Fixed: Issue #157

Fixed: Issue #159
Fixed: Issue #170
Fixed: Issue #171
This commit is contained in:
Mark van Renswoude 2006-01-26 19:40:23 +00:00
parent 105050b957
commit e4bfc5b840
6 changed files with 517 additions and 12 deletions

View File

@ -268,7 +268,7 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
Top = 23 Top = 23
Width = 54 Width = 54
Height = 13 Height = 13
Caption = 'Version 0.3' Caption = 'Version 0.4'
end end
object TLabel object TLabel
Left = 135 Left = 135
@ -317,6 +317,21 @@ object frmUnSwConfiguration: TfrmUnSwConfiguration
ParentFont = False ParentFont = False
OnClick = lblBugReportClick OnClick = lblBugReportClick
end 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
end end
object btnCancel: TButton object btnCancel: TButton

View File

@ -39,6 +39,8 @@ type
pnlCustomColor: TPanel; pnlCustomColor: TPanel;
tsAbout: TTabSheet; tsAbout: TTabSheet;
tsGeneral: TTabSheet; tsGeneral: TTabSheet;
lblShortcutKeys: TLabel;
procedure lblShortcutKeysClick(Sender: TObject);
procedure btnDefaultClick(Sender: TObject); procedure btnDefaultClick(Sender: TObject);
procedure chkCustomColorClick(Sender: TObject); procedure chkCustomColorClick(Sender: TObject);
@ -60,7 +62,8 @@ uses
ShellAPI, ShellAPI,
Windows, Windows,
UnSwSettings; UnSwSettings,
UnSwShortcuts;
{$R *.dfm} {$R *.dfm}
@ -98,6 +101,11 @@ begin
ShellExecute(0, 'open', 'http://projects.kamadev.net/', nil, nil, SW_SHOWNORMAL); ShellExecute(0, 'open', 'http://projects.kamadev.net/', nil, nil, SW_SHOWNORMAL);
end; end;
procedure TfrmUnSwConfiguration.lblShortcutKeysClick(Sender: TObject);
begin
TfrmUnSwShortcuts.Execute();
end;
procedure TfrmUnSwConfiguration.LoadSettings(); procedure TfrmUnSwConfiguration.LoadSettings();
begin begin
chkCustomColor.Checked := Settings.Colors.Enabled; chkCustomColor.Checked := Settings.Colors.Enabled;

View File

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

View File

@ -6,6 +6,8 @@
} }
unit UnSwDialog; unit UnSwDialog;
{$WARN SYMBOL_PLATFORM OFF}
interface interface
uses uses
ActnList, ActnList,
@ -39,6 +41,7 @@ type
TfrmUnSwDialog = class(TForm) TfrmUnSwDialog = class(TForm)
actMRUNext: TAction; actMRUNext: TAction;
actMRUPrior: TAction; actMRUPrior: TAction;
actOpenDFMProperties: TAction;
actOpenFolder: TAction; actOpenFolder: TAction;
actOpenProperties: TAction; actOpenProperties: TAction;
actSelectAll: TAction; actSelectAll: TAction;
@ -58,6 +61,7 @@ type
lblSubFilters: TLabel; lblSubFilters: TLabel;
lstUnits: TListBox; lstUnits: TListBox;
pmnUnits: TPopupMenu; pmnUnits: TPopupMenu;
pmnUnitsOpenDFMProperties: TMenuItem;
pmnUnitsOpenFolder: TMenuItem; pmnUnitsOpenFolder: TMenuItem;
pmnUnitsOpenProperties: TMenuItem; pmnUnitsOpenProperties: TMenuItem;
pmnUnitsSelectAll: TMenuItem; pmnUnitsSelectAll: TMenuItem;
@ -72,10 +76,10 @@ type
pnlSearch: TPanel; pnlSearch: TPanel;
pnlSubFilters: TPanel; pnlSubFilters: TPanel;
sbStatus: TStatusBar; sbStatus: TStatusBar;
procedure cmbSearchKeyPress(Sender: TObject; var Key: Char);
procedure actMRUNextExecute(Sender: TObject); procedure actMRUNextExecute(Sender: TObject);
procedure actMRUPriorExecute(Sender: TObject); procedure actMRUPriorExecute(Sender: TObject);
procedure actOpenDFMPropertiesExecute(Sender: TObject);
procedure actOpenFolderExecute(Sender: TObject); procedure actOpenFolderExecute(Sender: TObject);
procedure actOpenPropertiesExecute(Sender: TObject); procedure actOpenPropertiesExecute(Sender: TObject);
procedure actSelectAllExecute(Sender: TObject); procedure actSelectAllExecute(Sender: TObject);
@ -83,11 +87,14 @@ type
procedure btnConfigurationClick(Sender: TObject); procedure btnConfigurationClick(Sender: TObject);
procedure cmbSearchChange(Sender: TObject); procedure cmbSearchChange(Sender: TObject);
procedure cmbSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure cmbSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure cmbSearchKeyPress(Sender: TObject; var Key: Char);
procedure FormResize(Sender: TObject); procedure FormResize(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure lstUnitsClick(Sender: TObject);
procedure lstUnitsData(Control: TWinControl; Index: Integer; var Data: string); procedure lstUnitsData(Control: TWinControl; Index: Integer; var Data: string);
procedure lstUnitsDblClick(Sender: TObject); procedure lstUnitsDblClick(Sender: TObject);
procedure lstUnitsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure lstUnitsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure pmnUnitsPopup(Sender: TObject);
procedure SortExecute(Sender: TObject); procedure SortExecute(Sender: TObject);
procedure TypeFilterChange(Sender: TObject); procedure TypeFilterChange(Sender: TObject);
private private
@ -135,7 +142,7 @@ uses
SysUtils, SysUtils,
UnSwConfiguration, UnSwConfiguration,
UnSwSettings, Dialogs; UnSwSettings;
type type
TUnSwOpenVisitor = class(TInterfacedObject, IUnSwVisitor) TUnSwOpenVisitor = class(TInterfacedObject, IUnSwVisitor)
@ -145,8 +152,8 @@ type
function IsProcessed(const AFileName: String; const ARegister: Boolean = True): Boolean; function IsProcessed(const AFileName: String; const ARegister: Boolean = True): Boolean;
procedure OpenFile(const AFileName: String); virtual; abstract; procedure OpenFile(const AFileName: String); virtual; abstract;
procedure VisitModule(const AUnit: TUnSwModuleUnit); procedure VisitModule(const AUnit: TUnSwModuleUnit); virtual;
procedure VisitProject(const AUnit: TUnSwProjectUnit); procedure VisitProject(const AUnit: TUnSwProjectUnit); virtual;
public public
constructor Create(); constructor Create();
destructor Destroy(); override; destructor Destroy(); override;
@ -162,6 +169,21 @@ type
procedure OpenFile(const AFileName: String); override; procedure OpenFile(const AFileName: String); override;
end; 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} {$R *.dfm}
@ -245,6 +267,32 @@ begin
end; 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 } { TUnSwStyleVisitor }
procedure TUnSwStyleVisitor.VisitModule(const AUnit: TUnSwModuleUnit); procedure TUnSwStyleVisitor.VisitModule(const AUnit: TUnSwModuleUnit);
begin begin
@ -407,6 +455,9 @@ begin
if lstUnits.SelCount = 0 then if lstUnits.SelCount = 0 then
lstUnits.Selected[0] := True; lstUnits.Selected[0] := True;
end; end;
if Assigned(lstUnits.OnClick) then
lstUnits.OnClick(nil);
end; end;
function SortByName(Item1, Item2: Pointer): Integer; function SortByName(Item1, Item2: Pointer): Integer;
@ -684,6 +735,20 @@ begin
end; end;
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); procedure TfrmUnSwDialog.btnConfigurationClick(Sender: TObject);
begin begin
@ -744,6 +809,37 @@ begin
btnOK.Click(); btnOK.Click();
end; 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; procedure TfrmUnSwDialog.lstUnitsData(Control: TWinControl; Index: Integer;
var Data: string); var Data: string);
begin begin
@ -792,4 +888,36 @@ begin
end; end;
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. end.

302
Source/UnSwShortcuts.dfm Normal file
View File

@ -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

40
Source/UnSwShortcuts.pas Normal file
View File

@ -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.