Added: class name filter

This commit is contained in:
Mark van Renswoude 2007-12-11 19:41:46 +00:00
parent e3822bae54
commit f4faf35c60
10 changed files with 1029 additions and 114 deletions

Binary file not shown.

View File

@ -49,6 +49,9 @@ contains
BaseSwFilters in '..\..\Source\BaseSwFilters.pas',
BaseSwDialog in '..\..\Source\BaseSwDialog.pas' {frmBaseSwDialog},
CmpSwObjects in '..\..\Source\CmpSwObjects.pas',
CmpSwDialog in '..\..\Source\CmpSwDialog.pas' {frmCmpSwDialog};
CmpSwDialog in '..\..\Source\CmpSwDialog.pas' {frmCmpSwDialog},
CmpSwFilters in '..\..\Source\CmpSwFilters.pas',
BaseSwSettings in '..\..\Source\BaseSwSettings.pas',
CmpSwSettings in '..\..\Source\CmpSwSettings.pas';
end.

View File

@ -1,10 +1,10 @@
object frmBaseSwDialog: TfrmBaseSwDialog
Left = 284
Top = 120
Width = 320
Height = 425
BorderIcons = [biSystemMenu]
Caption = 'UnitSwitcher'
ClientHeight = 398
ClientWidth = 312
Color = clBtnFace
Constraints.MinHeight = 240
Constraints.MinWidth = 290

95
Source/BaseSwSettings.pas Normal file
View File

@ -0,0 +1,95 @@
{: Encapsulates the settings.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit BaseSwSettings;
interface
uses
Graphics,
Registry;
type
TBaseSwSettings = 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;
implementation
{ TBaseSwSettings }
function TBaseSwSettings.GetKeyName(const AName: String): String;
begin
Result := AName;
end;
procedure TBaseSwSettings.ReadBoolDef(const ARegistry: TRegistry;
var AValue: Boolean;
const AName: String);
begin
if ARegistry.ValueExists(GetKeyName(AName)) then
AValue := ARegistry.ReadBool(GetKeyName(AName));
end;
procedure TBaseSwSettings.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 TBaseSwSettings.ReadIntegerDef(const ARegistry: TRegistry;
var AValue: Integer;
const AName: String);
begin
if ARegistry.ValueExists(GetKeyName(AName)) then
AValue := ARegistry.ReadInteger(GetKeyName(AName));
end;
procedure TBaseSwSettings.WriteBool(const ARegistry: TRegistry;
const AValue: Boolean;
const AName: String);
begin
ARegistry.WriteBool(GetKeyName(AName), AValue);
end;
procedure TBaseSwSettings.WriteColor(const ARegistry: TRegistry;
const AValue: TColor;
const AName: String);
begin
WriteInteger(ARegistry, Integer(AValue), AName);
end;
procedure TBaseSwSettings.WriteInteger(const ARegistry: TRegistry;
const AValue: Integer;
const AName: String);
begin
ARegistry.WriteInteger(GetKeyName(AName), AValue);
end;
end.

View File

@ -1,11 +1,94 @@
inherited frmCmpSwDialog: TfrmCmpSwDialog
Width = 358
Height = 557
Caption = 'ComponentSwitcher'
ExplicitHeight = 425
PixelsPerInch = 96
TextHeight = 13
inherited sbStatus: TStatusBar
Top = 511
Width = 350
end
inherited pnlMain: TPanel
Width = 350
Height = 402
inherited pnlSearch: TPanel
Width = 342
inherited cmbSearch: TComboBox
Width = 342
end
end
inherited lstItems: TListBox
ExplicitTop = 45
Width = 342
Height = 349
end
inherited pnlSubFilters: TPanel
Width = 342
inherited lblSubFilters: TLabel
Width = 343
end
end
end
inherited pnlButtons: TPanel
Top = 475
Width = 350
inherited btnCancel: TButton
Left = 271
end
inherited btnOK: TButton
Left = 190
end
end
object pnlFilters: TPanel [3]
Left = 0
Top = 402
Width = 350
Height = 73
Align = alBottom
BevelOuter = bvNone
BorderWidth = 4
TabOrder = 3
object gbFilters: TGroupBox
Left = 4
Top = 4
Width = 342
Height = 65
Align = alClient
Caption = ' Filter '
TabOrder = 0
DesignSize = (
342
65)
object btnMoreFilters: TButton
Left = 304
Top = 32
Width = 31
Height = 25
Anchors = [akRight, akBottom]
Caption = '>>'
TabOrder = 0
OnClick = btnMoreFiltersClick
end
end
end
inherited alMain: TActionList
object actFilterSelected: TAction
Caption = '&Filter selected class(es)'
Enabled = False
end
end
inherited pmnItems: TPopupMenu
object pmnItemsFilters: TMenuItem [0]
Caption = 'Filters'
end
object pmnItemsFilterSelected: TMenuItem [1]
Action = actFilterSelected
end
object pmnItemsSep1: TMenuItem [2]
Caption = '-'
end
end
object pmnMoreFilters: TPopupMenu
Left = 192
Top = 228
end
end

View File

@ -5,6 +5,7 @@ uses
ActnList,
Classes,
ComCtrls,
Contnrs,
Controls,
ExtCtrls,
Graphics,
@ -37,18 +38,41 @@ type
TfrmCmpSwDialog = class(TfrmBaseSwDialog)
pmnItemsSep1: TMenuItem;
pmnItemsFilters: TMenuItem;
pmnItemsFilterSelected: TMenuItem;
actFilterSelected: TAction;
pnlFilters: TPanel;
gbFilters: TGroupBox;
btnMoreFilters: TButton;
pmnMoreFilters: TPopupMenu;
procedure btnMoreFiltersClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
FClassFilteredList: TBaseSwItemList;
FClassFilter: TCmpSwComponentClassFilter;
FFilterCheckBoxes: TObjectList;
protected
function InternalExecute(): TBaseSwItemList; override;
function CreateStyleVisitor(): TBaseSwStyleVisitor; override;
function GetBaseItemList(): TBaseSwItemList; override;
procedure DrawItemText(ACanvas: TCanvas; AItem: TBaseSwItem; ARect: TRect); override;
procedure LoadSettings(); override;
procedure SaveSettings(); override;
procedure DrawItemText(ACanvas: TCanvas; AItem: TBaseSwItem; ARect: TRect); override;
procedure UpdateClassFilter();
procedure BuildFilterCheckboxes();
function CreateFilterMenuItem(AParent: TMenuItem; AGroup: TCmpSwFilterGroup; AItemIndex: Integer): TMenuItem;
procedure FilterCheckBoxClick(Sender: TObject);
procedure FilterMenuItemClick(Sender: TObject);
property ClassFilter: TCmpSwComponentClassFilter read FClassFilter;
end;
@ -57,7 +81,8 @@ uses
SysUtils,
ToolsAPI,
CmpSwObjects;
CmpSwObjects,
CmpSwSettings;
{$R *.dfm}
@ -207,16 +232,24 @@ function TfrmCmpSwDialog.InternalExecute(): TBaseSwItemList;
begin
FClassFilteredList := TBaseSwItemList.Create();
FClassFilter := TCmpSwComponentClassFilter.Create();
FFilterCheckBoxes := TObjectList.Create();
try
UpdateClassFilter();
Result := inherited InternalExecute();
finally
FreeAndNil(FFilterCheckBoxes);
FreeAndNil(FClassFilter);
FreeAndNil(FClassFilteredList);
end;
end;
procedure TfrmCmpSwDialog.FormShow(Sender: TObject);
begin
UpdateClassFilter();
inherited;
end;
function TfrmCmpSwDialog.CreateStyleVisitor(): TBaseSwStyleVisitor;
begin
Result := TCmpSwStyleVisitor.Create(ilsTypes);
@ -225,30 +258,264 @@ end;
procedure TfrmCmpSwDialog.DrawItemText(ACanvas: TCanvas; AItem: TBaseSwItem; ARect: TRect);
var
text: String;
text: String;
textRect: TRect;
begin
inherited;
{ Calculate item text rectangle }
text := GetItemDisplayName(AItem);
textRect := ARect;
DrawText(ACanvas.Handle, PChar(text), Length(text), textRect, DT_SINGLELINE or
DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS or DT_CALCRECT);
textRect.Left := textRect.Right;
textRect.Right := ARect.Right;
{ Draw component class text }
ACanvas.Font.Color := clGrayText;
text := (AItem as TCmpSwComponent).ComponentClass;
DrawText(ACanvas.Handle, PChar(text), Length(text), ARect, DT_SINGLELINE or
DT_RIGHT or DT_VCENTER);
DrawText(ACanvas.Handle, PChar(text), Length(text), textRect, DT_SINGLELINE or
DT_RIGHT or DT_VCENTER or DT_END_ELLIPSIS);
end;
procedure TfrmCmpSwDialog.UpdateClassFilter();
var
groupIndex: Integer;
itemIndex: Integer;
begin
// FClassFilteredList.Clone(ItemList);
// FClassFilter.FilterList(FClassFilteredList);
if ClassFilter.Groups.Count = 0 then
begin
with ClassFilter.Groups.Add() do
begin
Name := 'Actions';
Filter.Add('TAction');
Visible := True;
end;
with ClassFilter.Groups.Add() do
begin
Name := 'Menu items';
Filter.Add('TMenuItem');
Visible := True;
end;
with ClassFilter.Groups.Add() do
begin
Name := 'Dataset fields';
Filter.Add('TField');
Filter.Add('T*Field');
Visible := True;
end;
with ClassFilter.Groups.Add() do
begin
Name := 'DevEx Grid columns';
Filter.Add('TcxGridDBColumn');
Filter.Add('TcxGridColumn');
end;
// with ClassFilter.Groups.Add() do
// begin
// Name := 'Toolbar2000 items';
// Enabled := True;
//
// Filter.Add('TTBXItem');
// Filter.Add('TTBItem');
// Filter.Add('TTBXSeparatorItem');
// Filter.Add('TTBXNoPrefixItem');
// Filter.Add('TTBXNoPrefixSubmenuItem');
// Filter.Add('TTBXSubmenuItem');
// end;
// with ClassFilter.Groups.Add() do
// begin
// Name := 'X2Software items';
// Enabled := True;
//
// Filter.Add('TX2GraphicContainerItem');
// end;
end;
pnlFilters.Visible := (ClassFilter.Groups.Count > 0);
{ Update / extend the menu }
itemIndex := 0;
for groupIndex := 0 to Pred(ClassFilter.Groups.Count) do
begin
if ClassFilter.Groups[groupIndex].Visible then
begin
CreateFilterMenuItem(pmnItemsFilters, ClassFilter.Groups[groupIndex], itemIndex);
Inc(itemIndex);
end;
end;
{ Remove excess menu items }
for groupIndex := Pred(pmnItemsFilters.Count) downto itemIndex do
pmnItemsFilters.Delete(groupIndex);
itemIndex := 0;
for groupIndex := 0 to Pred(ClassFilter.Groups.Count) do
begin
if not ClassFilter.Groups[groupIndex].Visible then
begin
CreateFilterMenuItem(pmnMoreFilters.Items, ClassFilter.Groups[groupIndex], itemIndex);
Inc(itemIndex);
end;
end;
for groupIndex := Pred(pmnMoreFilters.Items.Count) downto itemIndex do
pmnMoreFilters.Items.Delete(groupIndex);
BuildFilterCheckboxes();
btnMoreFilters.Visible := (pmnMoreFilters.Items.Count > 0);
FClassFilteredList.Clone(ItemList);
ClassFilter.FilterList(FClassFilteredList);
end;
function TfrmCmpSwDialog.GetBaseItemList(): TBaseSwItemList;
begin
// Result := FClassFilteredList;
Result := inherited GetBaseItemList;
Result := FClassFilteredList;
end;
procedure TfrmCmpSwDialog.BuildFilterCheckboxes();
var
checkBox: TCheckBox;
checkBoxTop: Integer;
childIndex: Integer;
group: TCmpSwFilterGroup;
groupIndex: Integer;
begin
for childIndex := Pred(gbFilters.ControlCount) downto 0 do
if gbFilters.Controls[childIndex] is TCheckBox then
gbFilters.Controls[childIndex].Free;
// #ToDo3 (MvR) 11-12-2007: get rid of a few "magic" numbers
checkBoxTop := 16;
for groupIndex := 0 to Pred(ClassFilter.Groups.Count) do
begin
group := ClassFilter.Groups[groupIndex];
if group.Visible then
begin
checkBox := TCheckBox.Create(Self);
checkBox.Top := checkBoxTop;
checkBox.Left := 12;
checkBox.Caption := StringReplace(group.Name, '&', '&&', [rfReplaceAll]);
checkBox.Checked := group.Enabled;
checkBox.Tag := Integer(group);
checkBox.OnClick := FilterCheckBoxClick;
checkBox.Parent := gbFilters;
Inc(checkBoxTop, 20);
end;
end;
pnlFilters.Height := (2 * pnlFilters.BorderWidth) + checkBoxTop + 11;
end;
function TfrmCmpSwDialog.CreateFilterMenuItem(AParent: TMenuItem; AGroup: TCmpSwFilterGroup; AItemIndex: Integer): TMenuItem;
begin
if (AItemIndex = -1) or (AItemIndex >= AParent.Count) then
begin
Result := TMenuItem.Create(Self);
Result.OnClick := FilterMenuItemClick;
AParent.Add(Result);
end else
Result := AParent[AItemIndex];
Result.Caption := StringReplace(AGroup.Name, '&', '&&', [rfReplaceAll]);
Result.Checked := AGroup.Enabled;
Result.Tag := Integer(AGroup);
end;
procedure TfrmCmpSwDialog.FilterCheckBoxClick(Sender: TObject);
var
checkBox: TCheckBox;
group: TCmpSwFilterGroup;
begin
checkBox := (Sender as TCheckBox);
group := TCmpSwFilterGroup(checkBox.Tag);
if checkBox.Checked <> group.Enabled then
begin
group.Enabled := checkBox.Checked;
UpdateClassFilter();
UpdateSubFilters();
end;
end;
procedure TfrmCmpSwDialog.FilterMenuItemClick(Sender: TObject);
var
menuItem: TMenuItem;
group: TCmpSwFilterGroup;
begin
menuItem := (Sender as TMenuItem);
group := TCmpSwFilterGroup(menuItem.Tag);
menuItem.Checked := not menuItem.Checked;
group.Enabled := menuItem.Checked;
UpdateClassFilter();
UpdateSubFilters();
end;
procedure TfrmCmpSwDialog.btnMoreFiltersClick(Sender: TObject);
var
buttonPos: TPoint;
begin
buttonPos := btnMoreFilters.ClientToScreen(Point(btnMoreFilters.Width, 0));
pmnMoreFilters.Popup(buttonPos.X, buttonPos.Y);
end;
procedure TfrmCmpSwDialog.LoadSettings();
begin
Self.ClientWidth := Settings.Dialog.Width;
Self.ClientHeight := Settings.Dialog.Height;
MRUList.Assign(Settings.Dialog.MRUList);
Settings.LoadFilter(ClassFilter.Groups);
inherited LoadSettings();
end;
procedure TfrmCmpSwDialog.SaveSettings();
begin
Settings.Dialog.Width := Self.ClientWidth;
Settings.Dialog.Height := Self.ClientHeight;
Settings.Dialog.MRUList.Assign(MRUList);
Settings.Save();
Settings.SaveFilter(ClassFilter.Groups);
inherited SaveSettings();
end;
end.

View File

@ -2,42 +2,240 @@ unit CmpSwFilters;
interface
uses
Classes,
Contnrs,
BaseSwFilters,
BaseSwObjects;
type
TCmpSwComponentClassFilter = class(TBaseSwItemSimpleFilter)
// #ToDo3 (MvR) 11-12-2007: "Include descendants" option
TCmpSwFilterGroup = class(TCollectionItem)
private
FEnabled: Boolean;
FFilter: TStrings;
FFilterChanged: Boolean;
FFilterMasks: TObjectList;
FName: String;
FVisible: Boolean;
protected
procedure FilterChange(Sender: TObject);
function ContainsMask(const AFilter: String): Boolean;
procedure UpdateFilters();
property FilterMasks: TObjectList read FFilterMasks;
public
constructor Create(Collection: TCollection); override;
destructor Destroy(); override;
function Matches(const AValue: String): Boolean;
property Enabled: Boolean read FEnabled write FEnabled;
property Filter: TStrings read FFilter;
property Name: String read FName write FName;
property Visible: Boolean read FVisible write FVisible;
end;
TCmpSwFilterGroups = class(TCollection)
private
function GetItem(Index: Integer): TCmpSwFilterGroup;
procedure SetItem(Index: Integer; Value: TCmpSwFilterGroup);
public
constructor Create();
function Add(): TCmpSwFilterGroup;
function Matches(const AValue: String): Boolean;
property Items[Index: Integer]: TCmpSwFilterGroup read GetItem write SetItem; default;
end;
TCmpSwComponentClassFilter = class(TBaseSwItemFilter)
private
FGroups: TCmpSwFilterGroups;
protected
procedure VisitItem(const AItem: TBaseSwItem); override;
public
constructor Create();
destructor Destroy(); override;
property Groups: TCmpSwFilterGroups read FGroups;
end;
implementation
uses
Masks,
SysUtils,
CmpSwObjects;
{ TCmpSwComponentClassFilter }
procedure TCmpSwComponentClassFilter.VisitItem(const AItem: TBaseSwItem);
const
MaskChars = ['*', '?', '['];
{ TCmpSwFilterGroup }
constructor TCmpSwFilterGroup.Create(Collection: TCollection);
begin
inherited;
FFilterMasks := TObjectList.Create(True);
FFilter := TStringList.Create();
TStringList(FFilter).OnChange := FilterChange;
FEnabled := True;
FVisible := False;
end;
destructor TCmpSwFilterGroup.Destroy();
begin
FreeAndNil(FFilter);
FreeAndNil(FFilterMasks);
inherited;
end;
function TCmpSwFilterGroup.Matches(const AValue: String): Boolean;
var
componentClass: String;
filterIndex: Integer;
begin
componentClass := TCmpSwComponent(AItem).ComponentClass;
Result := False;
UpdateFilters();
// #ToDo1 (MvR) 10-12-2007: use a configurable list
if SameText(componentClass, 'TMenuItem') or
SameText(componentClass, 'TAction') or
SameText(componentClass, 'TTBXItem') or
SameText(componentClass, 'TTBItem') or
SameText(componentClass, 'TTBXSeparatorItem') or
SameText(componentClass, 'TTBXNoPrefixItem') or
SameText(componentClass, 'TTBXNoPrefixSubmenuItem') or
SameText(componentClass, 'TTBXSubmenuItem') or
SameText(componentClass, 'TX2GraphicContainerItem') then
for filterIndex := Pred(Filter.Count) downto 0 do
begin
if Assigned(Filter.Objects[filterIndex]) then
Result := TMask(Filter.Objects[filterIndex]).Matches(AValue)
else
Result := SameText(Filter[filterIndex], AValue);
if Result then
Break;
end;
end;
procedure TCmpSwFilterGroup.FilterChange(Sender: TObject);
begin
FFilterChanged := True;
end;
function TCmpSwFilterGroup.ContainsMask(const AFilter: String): Boolean;
var
charIndex: Integer;
begin
Result := False;
for charIndex := Length(AFilter) downto 1 do
if AFilter[charIndex] in MaskChars then
begin
Result := True;
Break;
end;
end;
procedure TCmpSwFilterGroup.UpdateFilters();
var
filterIndex: Integer;
mask: TMask;
begin
if not FFilterChanged then
Exit;
FilterMasks.Clear();
for filterIndex := Pred(Filter.Count) downto 0 do
begin
if ContainsMask(Filter[filterIndex]) then
begin
mask := TMask.Create(Filter[filterIndex]);
FilterMasks.Add(mask);
Filter.Objects[filterIndex] := mask;
end else
Filter.Objects[filterIndex] := nil;
end;
FFilterChanged := False;
end;
{ TCmpSwFilterGroups }
constructor TCmpSwFilterGroups.Create;
begin
inherited Create(TCmpSwFilterGroup);
end;
function TCmpSwFilterGroups.Add: TCmpSwFilterGroup;
begin
Result := TCmpSwFilterGroup(inherited Add);
end;
function TCmpSwFilterGroups.GetItem(Index: Integer): TCmpSwFilterGroup;
begin
Result := TCmpSwFilterGroup(inherited GetItem(Index));
end;
procedure TCmpSwFilterGroups.SetItem(Index: Integer; Value: TCmpSwFilterGroup);
begin
inherited SetItem(Index, Value);
end;
function TCmpSwFilterGroups.Matches(const AValue: String): Boolean;
var
itemIndex: Integer;
begin
Result := False;
for itemIndex := Pred(Count) downto 0 do
begin
if Items[itemIndex].Enabled then
begin
Result := Items[itemIndex].Matches(AValue);
if Result then
Break;
end;
end;
end;
{ TCmpSwComponentClassFilter }
constructor TCmpSwComponentClassFilter.Create();
begin
inherited;
FGroups := TCmpSwFilterGroups.Create();
end;
destructor TCmpSwComponentClassFilter.Destroy();
begin
FreeAndNil(FGroups);
inherited;
end;
procedure TCmpSwComponentClassFilter.VisitItem(const AItem: TBaseSwItem);
begin
if Groups.Matches(TCmpSwComponent(AItem).ComponentClass) then
FilterItem(AItem);
end;

342
Source/CmpSwSettings.pas Normal file
View File

@ -0,0 +1,342 @@
{: Encapsulates the ComponentSwitcher settings.
Last changed: $Date$
Revision: $Rev$
Author: $Author$
}
unit CmpSwSettings;
interface
uses
Classes,
Registry,
BaseSwSettings,
CmpSwFilters;
type
TCmpSwDialogSettings = class(TBaseSwSettings)
private
FHeight: Integer;
FMRUList: TStrings;
FWidth: Integer;
protected
procedure Load(const ARegistry: TRegistry); override;
procedure Save(const ARegistry: TRegistry); override;
public
constructor Create();
destructor Destroy(); override;
public
property Height: Integer read FHeight write FHeight;
property MRUList: TStrings read FMRUList write FMRUList;
property Width: Integer read FWidth write FWidth;
end;
TCmpSwSettings = class(TObject)
private
FDialog: TCmpSwDialogSettings;
FRegistryKey: String;
protected
procedure Load();
procedure LoadFilterGroup(ARegistry: TRegistry; AGroup: TCmpSwFilterGroup);
procedure SaveFilterGroup(ARegistry: TRegistry; AGroup: TCmpSwFilterGroup);
public
constructor Create();
destructor Destroy(); override;
procedure ResetDefaults();
procedure Save();
procedure LoadFilter(AGroups: TCmpSwFilterGroups);
procedure SaveFilter(AGroups: TCmpSwFilterGroups);
property Dialog: TCmpSwDialogSettings read FDialog write FDialog;
end;
function Settings(): TCmpSwSettings;
implementation
uses
SysUtils,
ToolsAPI,
Windows;
var
GSettings: TCmpSwSettings;
function Settings(): TCmpSwSettings;
begin
if not Assigned(GSettings) then
GSettings := TCmpSwSettings.Create();
Result := GSettings;
end;
{ TCmpSwDialogSettings }
constructor TCmpSwDialogSettings.Create();
begin
inherited Create();
FMRUList := TStringList.Create();
TStringList(FMRUList).CaseSensitive := False
end;
destructor TCmpSwDialogSettings.Destroy();
begin
FreeAndNil(FMRUList);
inherited;
end;
procedure TCmpSwDialogSettings.Load(const ARegistry: TRegistry);
var
sMRU: String;
begin
ReadIntegerDef(ARegistry, FWidth, 'Width');
ReadIntegerDef(ARegistry, FHeight, 'Height');
if ARegistry.ValueExists(GetKeyName('MRU')) then
begin
SetLength(sMRU, ARegistry.GetDataSize(GetKeyName('MRU')));
if Length(sMRU) > 0 then
begin
ARegistry.ReadBinaryData(GetKeyName('MRU'), PChar(sMRU)^, Length(sMRU));
FMRUList.Text := Trim(sMRU);
end;
end;
end;
procedure TCmpSwDialogSettings.Save(const ARegistry: TRegistry);
var
sMRU: String;
begin
WriteInteger(ARegistry, FWidth, 'Width');
WriteInteger(ARegistry, FHeight, 'Height');
if FMRUList.Count > 0 then
begin
sMRU := FMRUList.Text;
ARegistry.WriteBinaryData(GetKeyName('MRU'), PChar(sMRU)^, Length(sMRU));
end else
ARegistry.DeleteValue(GetKeyName('MRU'));
end;
{ TCmpSwSettings }
constructor TCmpSwSettings.Create();
begin
inherited;
FRegistryKey := (BorlandIDEServices as IOTAServices).GetBaseRegistryKey() +
'\ComponentSwitcher';
FDialog := TCmpSwDialogSettings.Create();
ResetDefaults();
Load();
end;
destructor TCmpSwSettings.Destroy();
begin
FreeAndNil(FDialog);
inherited;
end;
procedure TCmpSwSettings.Load();
var
ideRegistry: TRegistry;
begin
ideRegistry := TRegistry.Create();
with ideRegistry do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(FRegistryKey, False) then
begin
FDialog.Load(ideRegistry);
CloseKey();
end;
finally
Free();
end;
end;
procedure TCmpSwSettings.ResetDefaults();
begin
Dialog.Width := 350;
Dialog.Height := 530;
end;
procedure TCmpSwSettings.Save();
var
ideRegistry: TRegistry;
begin
ideRegistry := TRegistry.Create();
with ideRegistry do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(FRegistryKey, True) then
begin
FDialog.Save(ideRegistry);
CloseKey();
end;
finally
Free();
end;
end;
procedure TCmpSwSettings.LoadFilter(AGroups: TCmpSwFilterGroups);
var
ideRegistry: TRegistry;
groupCount: Integer;
groupIndex: Integer;
group: TCmpSwFilterGroup;
begin
ideRegistry := TRegistry.Create();
with ideRegistry do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(FRegistryKey + '\Filter', False) then
begin
AGroups.Clear();
groupCount := 0;
if ValueExists('Count') then
groupCount := ReadInteger('Count');
CloseKey();
for groupIndex := 0 to Pred(groupCount) do
begin
if OpenKey(FRegistryKey + Format('\Filter\Item%d', [groupIndex]), False) then
begin
group := AGroups.Add();
LoadFilterGroup(ideRegistry, group);
CloseKey();
end;
end;
end;
finally
Free();
end;
end;
procedure TCmpSwSettings.SaveFilter(AGroups: TCmpSwFilterGroups);
var
ideRegistry: TRegistry;
subKeys: TStringList;
keyIndex: Integer;
groupIndex: Integer;
begin
ideRegistry := TRegistry.Create();
with ideRegistry do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(FRegistryKey + '\Filter', True) then
begin
subKeys := TStringList.Create();
try
GetKeyNames(subKeys);
for keyIndex := 0 to Pred(subKeys.Count) do
if SameText(Copy(subKeys[keyIndex], 0, 4), 'Item') then
begin
DeleteKey(subKeys[keyIndex]);
end;
finally
FreeAndNil(subKeys);
end;
WriteInteger('Count', AGroups.Count);
CloseKey();
for groupIndex := 0 to Pred(AGroups.Count) do
begin
if OpenKey(FRegistryKey + Format('\Filter\Item%d', [groupIndex]), True) then
begin
SaveFilterGroup(ideRegistry, AGroups[groupIndex]);
CloseKey();
end;
end;
CloseKey();
end;
finally
Free();
end;
end;
procedure TCmpSwSettings.LoadFilterGroup(ARegistry: TRegistry; AGroup: TCmpSwFilterGroup);
var
filterText: String;
begin
AGroup.Name := ARegistry.ReadString('Name');
AGroup.Enabled := ARegistry.ReadBool('Enabled');
AGroup.Visible := ARegistry.ReadBool('Visible');
if ARegistry.ValueExists('Filter') then
begin
SetLength(filterText, ARegistry.GetDataSize('Filter'));
if Length(filterText) > 0 then
begin
ARegistry.ReadBinaryData('Filter', PChar(filterText)^, Length(filterText));
AGroup.Filter.Text := Trim(filterText);
end;
end;
end;
procedure TCmpSwSettings.SaveFilterGroup(ARegistry: TRegistry; AGroup: TCmpSwFilterGroup);
var
filterText: String;
begin
ARegistry.WriteString('Name', AGroup.Name);
ARegistry.WriteBool('Enabled', AGroup.Enabled);
ARegistry.WriteBool('Visible', AGroup.Visible);
if AGroup.Filter.Count > 0 then
begin
filterText := AGroup.Filter.Text;
ARegistry.WriteBinaryData('Filter', PChar(filterText)^, Length(filterText));
end else
ARegistry.DeleteValue('Filter');
end;
initialization
finalization
FreeAndNil(GSettings);
end.

View File

@ -3,10 +3,8 @@ inherited frmUnSwDialog: TfrmUnSwDialog
TextHeight = 13
inherited pnlMain: TPanel
Height = 307
ExplicitHeight = 307
inherited lstItems: TListBox
Height = 254
ExplicitHeight = 254
end
end
inherited pnlButtons: TPanel
@ -71,7 +69,7 @@ inherited frmUnSwDialog: TfrmUnSwDialog
end
inherited ilsTypes: TImageList
Bitmap = {
494C010106000900040010001000FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600
494C010106000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000003000000001002000000000000030
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
@ -471,7 +469,8 @@ inherited frmUnSwDialog: TfrmUnSwDialog
E000E0000000AC0FE000E0000000BF3FE000E0000000FFFFE000600000001000
E000200000001000E00000000000B000E00020000000F000E00060000000F000
E000E0000000F000E000E0000000F000E000E0000000F000E001E0010000F000
E003E003FFFFF000E007E007FFFFF000}
E003E003FFFFF000E007E007FFFFF00000000000000000000000000000000000
000000000000}
end
inherited alMain: TActionList
object actSortByName: TAction

View File

@ -1,4 +1,4 @@
{: Encapsulates the settings.
{: Encapsulates the UnitSwitcher settings.
Last changed: $Date$
Revision: $Rev$
@ -10,29 +10,15 @@ interface
uses
Classes,
Graphics,
Registry;
Registry,
BaseSwSettings;
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;
TUnSwDialogSort = (dsName, dsType);
TUnSwDialogSettings = class(TUnSwBaseSettings)
TUnSwDialogSettings = class(TBaseSwSettings)
private
FHeight: Integer;
FIncludeDataModules: Boolean;
@ -62,7 +48,7 @@ type
end;
TUnSwColorSettings = class(TUnSwBaseSettings)
TUnSwColorSettings = class(TBaseSwSettings)
private
FDataModules: TColor;
FEnabled: Boolean;
@ -81,7 +67,7 @@ type
end;
TUnSwFilterSettings = class(TUnSwBaseSettings)
TUnSwFilterSettings = class(TBaseSwSettings)
private
FAllowEmptyResults: Boolean;
protected
@ -140,64 +126,6 @@ begin
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