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

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', BaseSwFilters in '..\..\Source\BaseSwFilters.pas',
BaseSwDialog in '..\..\Source\BaseSwDialog.pas' {frmBaseSwDialog}, BaseSwDialog in '..\..\Source\BaseSwDialog.pas' {frmBaseSwDialog},
CmpSwObjects in '..\..\Source\CmpSwObjects.pas', 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. end.

View File

@ -1,10 +1,10 @@
object frmBaseSwDialog: TfrmBaseSwDialog object frmBaseSwDialog: TfrmBaseSwDialog
Left = 284 Left = 284
Top = 120 Top = 120
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

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 inherited frmCmpSwDialog: TfrmCmpSwDialog
Width = 358
Height = 557
Caption = 'ComponentSwitcher' Caption = 'ComponentSwitcher'
ExplicitHeight = 425
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
inherited pnlMain: TPanel inherited sbStatus: TStatusBar
inherited lstItems: TListBox Top = 511
ExplicitTop = 45 Width = 350
end end
inherited pnlMain: TPanel
Width = 350
Height = 402
inherited pnlSearch: TPanel
Width = 342
inherited cmbSearch: TComboBox
Width = 342
end
end
inherited lstItems: TListBox
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
end end

View File

@ -5,6 +5,7 @@ uses
ActnList, ActnList,
Classes, Classes,
ComCtrls, ComCtrls,
Contnrs,
Controls, Controls,
ExtCtrls, ExtCtrls,
Graphics, Graphics,
@ -37,18 +38,41 @@ type
TfrmCmpSwDialog = class(TfrmBaseSwDialog) 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 private
FClassFilteredList: TBaseSwItemList; FClassFilteredList: TBaseSwItemList;
FClassFilter: TCmpSwComponentClassFilter; FClassFilter: TCmpSwComponentClassFilter;
FFilterCheckBoxes: TObjectList;
protected protected
function InternalExecute(): TBaseSwItemList; override; function InternalExecute(): TBaseSwItemList; override;
function CreateStyleVisitor(): TBaseSwStyleVisitor; override; function CreateStyleVisitor(): TBaseSwStyleVisitor; override;
function GetBaseItemList(): TBaseSwItemList; 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 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; end;
@ -57,7 +81,8 @@ uses
SysUtils, SysUtils,
ToolsAPI, ToolsAPI,
CmpSwObjects; CmpSwObjects,
CmpSwSettings;
{$R *.dfm} {$R *.dfm}
@ -207,16 +232,24 @@ function TfrmCmpSwDialog.InternalExecute(): TBaseSwItemList;
begin begin
FClassFilteredList := TBaseSwItemList.Create(); FClassFilteredList := TBaseSwItemList.Create();
FClassFilter := TCmpSwComponentClassFilter.Create(); FClassFilter := TCmpSwComponentClassFilter.Create();
FFilterCheckBoxes := TObjectList.Create();
try try
UpdateClassFilter();
Result := inherited InternalExecute(); Result := inherited InternalExecute();
finally finally
FreeAndNil(FFilterCheckBoxes);
FreeAndNil(FClassFilter); FreeAndNil(FClassFilter);
FreeAndNil(FClassFilteredList); FreeAndNil(FClassFilteredList);
end; end;
end; end;
procedure TfrmCmpSwDialog.FormShow(Sender: TObject);
begin
UpdateClassFilter();
inherited;
end;
function TfrmCmpSwDialog.CreateStyleVisitor(): TBaseSwStyleVisitor; function TfrmCmpSwDialog.CreateStyleVisitor(): TBaseSwStyleVisitor;
begin begin
Result := TCmpSwStyleVisitor.Create(ilsTypes); Result := TCmpSwStyleVisitor.Create(ilsTypes);
@ -226,29 +259,263 @@ end;
procedure TfrmCmpSwDialog.DrawItemText(ACanvas: TCanvas; AItem: TBaseSwItem; ARect: TRect); procedure TfrmCmpSwDialog.DrawItemText(ACanvas: TCanvas; AItem: TBaseSwItem; ARect: TRect);
var var
text: String; text: String;
textRect: TRect;
begin begin
inherited; 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; ACanvas.Font.Color := clGrayText;
text := (AItem as TCmpSwComponent).ComponentClass; text := (AItem as TCmpSwComponent).ComponentClass;
DrawText(ACanvas.Handle, PChar(text), Length(text), ARect, DT_SINGLELINE or DrawText(ACanvas.Handle, PChar(text), Length(text), textRect, DT_SINGLELINE or
DT_RIGHT or DT_VCENTER); DT_RIGHT or DT_VCENTER or DT_END_ELLIPSIS);
end; end;
procedure TfrmCmpSwDialog.UpdateClassFilter(); procedure TfrmCmpSwDialog.UpdateClassFilter();
var
groupIndex: Integer;
itemIndex: Integer;
begin begin
// FClassFilteredList.Clone(ItemList); if ClassFilter.Groups.Count = 0 then
// FClassFilter.FilterList(FClassFilteredList); 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; end;
function TfrmCmpSwDialog.GetBaseItemList(): TBaseSwItemList; function TfrmCmpSwDialog.GetBaseItemList(): TBaseSwItemList;
begin begin
// Result := FClassFilteredList; Result := FClassFilteredList;
Result := inherited GetBaseItemList; 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;
end. end.

View File

@ -2,42 +2,240 @@ unit CmpSwFilters;
interface interface
uses uses
Classes,
Contnrs,
BaseSwFilters, BaseSwFilters,
BaseSwObjects; BaseSwObjects;
type 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 protected
procedure VisitItem(const AItem: TBaseSwItem); override; procedure VisitItem(const AItem: TBaseSwItem); override;
public
constructor Create();
destructor Destroy(); override;
property Groups: TCmpSwFilterGroups read FGroups;
end; end;
implementation implementation
uses uses
Masks,
SysUtils, SysUtils,
CmpSwObjects; CmpSwObjects;
{ TCmpSwComponentClassFilter } const
procedure TCmpSwComponentClassFilter.VisitItem(const AItem: TBaseSwItem); 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 var
componentClass: String; filterIndex: Integer;
begin begin
componentClass := TCmpSwComponent(AItem).ComponentClass; Result := False;
UpdateFilters();
// #ToDo1 (MvR) 10-12-2007: use a configurable list for filterIndex := Pred(Filter.Count) downto 0 do
if SameText(componentClass, 'TMenuItem') or begin
SameText(componentClass, 'TAction') or if Assigned(Filter.Objects[filterIndex]) then
SameText(componentClass, 'TTBXItem') or Result := TMask(Filter.Objects[filterIndex]).Matches(AValue)
SameText(componentClass, 'TTBItem') or else
SameText(componentClass, 'TTBXSeparatorItem') or Result := SameText(Filter[filterIndex], AValue);
SameText(componentClass, 'TTBXNoPrefixItem') or
SameText(componentClass, 'TTBXNoPrefixSubmenuItem') or if Result then
SameText(componentClass, 'TTBXSubmenuItem') or Break;
SameText(componentClass, 'TX2GraphicContainerItem') then 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); FilterItem(AItem);
end; 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 TextHeight = 13
inherited pnlMain: TPanel inherited pnlMain: TPanel
Height = 307 Height = 307
ExplicitHeight = 307
inherited lstItems: TListBox inherited lstItems: TListBox
Height = 254 Height = 254
ExplicitHeight = 254
end end
end end
inherited pnlButtons: TPanel inherited pnlButtons: TPanel
@ -71,7 +69,7 @@ inherited frmUnSwDialog: TfrmUnSwDialog
end end
inherited ilsTypes: TImageList inherited ilsTypes: TImageList
Bitmap = { Bitmap = {
494C010106000900040010001000FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600 494C010106000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000003000000001002000000000000030 0000000000003600000028000000400000003000000001002000000000000030
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
@ -471,7 +469,8 @@ inherited frmUnSwDialog: TfrmUnSwDialog
E000E0000000AC0FE000E0000000BF3FE000E0000000FFFFE000600000001000 E000E0000000AC0FE000E0000000BF3FE000E0000000FFFFE000600000001000
E000200000001000E00000000000B000E00020000000F000E00060000000F000 E000200000001000E00000000000B000E00020000000F000E00060000000F000
E000E0000000F000E000E0000000F000E000E0000000F000E001E0010000F000 E000E0000000F000E000E0000000F000E000E0000000F000E001E0010000F000
E003E003FFFFF000E007E007FFFFF000} E003E003FFFFF000E007E007FFFFF00000000000000000000000000000000000
000000000000}
end end
inherited alMain: TActionList inherited alMain: TActionList
object actSortByName: TAction object actSortByName: TAction

View File

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