diff --git a/Lib/D2006/UnitSwitcherD2006.bpl b/Lib/D2006/UnitSwitcherD2006.bpl index 1f15c10..447eaa2 100644 Binary files a/Lib/D2006/UnitSwitcherD2006.bpl and b/Lib/D2006/UnitSwitcherD2006.bpl differ diff --git a/Packages/D2006/UnitSwitcher.dpk b/Packages/D2006/UnitSwitcher.dpk index 1811dae..91ab9ff 100644 --- a/Packages/D2006/UnitSwitcher.dpk +++ b/Packages/D2006/UnitSwitcher.dpk @@ -50,6 +50,7 @@ contains BaseSwObjects in '..\..\Source\BaseSwObjects.pas', UnSwReg in '..\..\Source\UnSwReg.pas', CmpSwDialog in '..\..\Source\CmpSwDialog.pas' {frmCmpSwDialog}, - CmpSwObjects in '..\..\Source\CmpSwObjects.pas'; + CmpSwObjects in '..\..\Source\CmpSwObjects.pas', + CmpSwFilters in '..\..\Source\CmpSwFilters.pas'; end. diff --git a/Source/BaseSwClient.pas b/Source/BaseSwClient.pas index 605aa54..0f75913 100644 --- a/Source/BaseSwClient.pas +++ b/Source/BaseSwClient.pas @@ -20,6 +20,8 @@ type Action: TContainedAction; OldOnExecute: TNotifyEvent; NewOnExecute: TNotifyEvent; + OldOnUpdate: TNotifyEvent; + NewOnUpdate: TNotifyEvent; end; @@ -30,12 +32,13 @@ type function GetHookedActionIndex(AAction: TContainedAction): Integer; function GetHookedAction(AAction: TContainedAction): PHookedAction; - procedure HookAction(AAction: TContainedAction; AOnExecute: TNotifyEvent); - function HookIDEAction(const AName: String; AOnExecute: TNotifyEvent): TContainedAction; + procedure HookAction(AAction: TContainedAction; AOnExecute: TNotifyEvent; AOnUpdate: TNotifyEvent = nil); + function HookIDEAction(const AName: String; AOnExecute: TNotifyEvent; AOnUpdate: TNotifyEvent = nil): TContainedAction; procedure UnhookActionIndex(AIndex: Integer); procedure UnhookAction(AAction: TContainedAction); procedure OldActionExecute(AAction: TObject); + procedure OldActionUpdate(AAction: TObject); public constructor Create(); destructor Destroy(); override; @@ -100,7 +103,7 @@ begin end; -procedure TBaseSwitcherHook.HookAction(AAction: TContainedAction; AOnExecute: TNotifyEvent); +procedure TBaseSwitcherHook.HookAction(AAction: TContainedAction; AOnExecute, AOnUpdate: TNotifyEvent); var hookedAction: PHookedAction; @@ -111,13 +114,20 @@ begin hookedAction^.Action := AAction; hookedAction^.OldOnExecute := AAction.OnExecute; hookedAction^.NewOnExecute := AOnExecute; - FHookedActions.Add(hookedAction); - AAction.OnExecute := AOnExecute; + + hookedAction^.OldOnUpdate := AAction.OnUpdate; + hookedAction^.NewOnUpdate := AOnUpdate; + + if Assigned(AOnUpdate) then + AAction.OnUpdate := AOnUpdate; + + FHookedActions.Add(hookedAction); end; -function TBaseSwitcherHook.HookIDEAction(const AName: String; AOnExecute: TNotifyEvent): TContainedAction; +function TBaseSwitcherHook.HookIDEAction(const AName: String; + AOnExecute, AOnUpdate: TNotifyEvent): TContainedAction; var actionIndex: Integer; ntaServices: INTAServices; @@ -136,7 +146,7 @@ begin if action.Name = AName then begin Result := action; - HookAction(action, AOnExecute); + HookAction(action, AOnExecute, AOnUpdate); Break; end; end; @@ -158,6 +168,7 @@ begin // if onExecute = hookedAction^.NewOnExecute then action.OnExecute := hookedAction^.OldOnExecute; + action.OnUpdate := hookedAction^.OldOnUpdate; Dispose(hookedAction); FHookedActions.Delete(AIndex); @@ -184,8 +195,23 @@ begin begin hookedAction := GetHookedAction(TContainedAction(AAction)); - if Assigned(hookedAction) and Assigned(hookedAction^.NewOnExecute) then - hookedAction^.NewOnExecute(AAction); + if Assigned(hookedAction) and Assigned(hookedAction^.OldOnExecute) then + hookedAction^.OldOnExecute(AAction); + end; +end; + + +procedure TBaseSwitcherHook.OldActionUpdate(AAction: TObject); +var + hookedAction: PHookedAction; + +begin + if AAction is TContainedAction then + begin + hookedAction := GetHookedAction(TContainedAction(AAction)); + + if Assigned(hookedAction) and Assigned(hookedAction^.OldOnUpdate) then + hookedAction^.OldOnUpdate(AAction); end; end; diff --git a/Source/BaseSwDialog.dfm b/Source/BaseSwDialog.dfm index 28087b6..8fb3bc3 100644 --- a/Source/BaseSwDialog.dfm +++ b/Source/BaseSwDialog.dfm @@ -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 diff --git a/Source/BaseSwDialog.pas b/Source/BaseSwDialog.pas index 8cd9eef..5cdcf18 100644 --- a/Source/BaseSwDialog.pas +++ b/Source/BaseSwDialog.pas @@ -116,6 +116,8 @@ type procedure LoadSettings(); virtual; procedure SaveSettings(); virtual; + + procedure DrawItemText(ACanvas: TCanvas; AItem: TBaseSwItem; ARect: TRect); virtual; protected property ActiveItem: TBaseSwItem read FActiveItem write FActiveItem; property ItemList: TBaseSwItemList read FItemList write FItemList; @@ -124,7 +126,7 @@ type class function Execute(const AItems: TBaseSwItemList; const AActive: TBaseSwItem = nil): TBaseSwItemList; end; - + implementation uses Messages, @@ -546,12 +548,22 @@ begin end; +procedure TfrmBaseSwDialog.DrawItemText(ACanvas: TCanvas; AItem: TBaseSwItem; ARect: TRect); +var + text: String; + +begin + text := GetItemDisplayName(AItem); + DrawText(ACanvas.Handle, PChar(text), Length(text), ARect, DT_SINGLELINE or + DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS); +end; + + procedure TfrmBaseSwDialog.lstItemsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var currentItem: TBaseSwItem; textRect: TRect; - text: String; begin with TListBox(Control) do @@ -560,8 +572,6 @@ begin if Assigned(FStyleVisitor) then currentItem.AcceptVisitor(FStyleVisitor); - text := GetItemDisplayName(currentItem); - if odSelected in State then begin Canvas.Brush.Color := clHighlight; @@ -589,8 +599,7 @@ begin end; Inc(textRect.Left, ilsTypes.Width + 4); - DrawText(Canvas.Handle, PChar(text), Length(text), textRect, DT_SINGLELINE or - DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS); + DrawItemText(Canvas, currentItem, textRect); end; end; diff --git a/Source/CmpSwClient.pas b/Source/CmpSwClient.pas index b86506d..6edcfff 100644 --- a/Source/CmpSwClient.pas +++ b/Source/CmpSwClient.pas @@ -26,6 +26,7 @@ type function ActiveModule(): IOTAModule; function ActiveEditor(): IOTAEditor; + procedure NewUpdate(Sender: TObject); procedure NewExecute(Sender: TObject); public constructor Create(); @@ -45,7 +46,7 @@ begin inherited; try - HookIDEAction('SearchFindCommand', NewExecute); + HookIDEAction('SearchFindCommand', NewExecute, NewUpdate); except on E:EAssertionFailed do ShowMessage('Error while loading ComponentSwitcher: ' + E.Message); @@ -134,4 +135,19 @@ begin end; end; + +procedure TComponentSwitcherHook.NewUpdate(Sender: TObject); +var + editor: IOTAEditor; + +begin + { BDS 2006 with the Embedded Designer disables the Find action } + editor := ActiveEditor(); + + if Assigned(editor) and Supports(editor, IOTAFormEditor) then + (Sender as TCustomAction).Enabled := True + else + OldActionUpdate(Sender); +end; + end. diff --git a/Source/CmpSwDialog.dfm b/Source/CmpSwDialog.dfm index f000a87..7b53e5c 100644 --- a/Source/CmpSwDialog.dfm +++ b/Source/CmpSwDialog.dfm @@ -1,14 +1,11 @@ inherited frmCmpSwDialog: TfrmCmpSwDialog Caption = 'ComponentSwitcher' + ExplicitHeight = 425 PixelsPerInch = 96 TextHeight = 13 inherited pnlMain: TPanel inherited lstItems: TListBox - ItemHeight = 30 + ExplicitTop = 45 end end - inherited ilsTypes: TImageList - Height = 24 - Width = 24 - end end diff --git a/Source/CmpSwDialog.pas b/Source/CmpSwDialog.pas index e97601d..d3c167b 100644 --- a/Source/CmpSwDialog.pas +++ b/Source/CmpSwDialog.pas @@ -7,13 +7,16 @@ uses ComCtrls, Controls, ExtCtrls, + Graphics, ImgList, IniFiles, Menus, StdCtrls, + Windows, BaseSwDialog, - BaseSwObjects; + BaseSwObjects, + CmpSwFilters; type @@ -26,6 +29,7 @@ type function GetComponentPackage(const AClassName: String): String; function LoadComponentImage(const APackageName, AClassName: String): Integer; + procedure ResizeBitmap(const ABitmap: Graphics.TBitmap; const AWidth, AHeight: Integer); public constructor Create(AImageList: TImageList); destructor Destroy(); override; @@ -33,17 +37,25 @@ type TfrmCmpSwDialog = class(TfrmBaseSwDialog) + private + FClassFilteredList: TBaseSwItemList; + FClassFilter: TCmpSwComponentClassFilter; protected + function InternalExecute(): TBaseSwItemList; override; + function CreateStyleVisitor(): TBaseSwStyleVisitor; override; + function GetBaseItemList(): TBaseSwItemList; override; + + procedure DrawItemText(ACanvas: TCanvas; AItem: TBaseSwItem; ARect: TRect); override; + + procedure UpdateClassFilter(); end; implementation uses - CommCtrl, SysUtils, ToolsAPI, - Windows, CmpSwObjects; @@ -88,7 +100,7 @@ begin end; if ImageIndex = -2 then - ImageIndex := 0; + ImageIndex := -1; end; @@ -109,7 +121,13 @@ begin if SameText(packageServices.ComponentNames[packageIndex, componentIndex], AClassName) then begin - Result := packageServices.PackageNames[packageIndex] + '.bpl'; + Result := packageServices.PackageNames[packageIndex]; + + { Delphi 7 doesn't add the .bpl extension, BDS 2006 does, let's just + take the safe route and check } + if not SameText(ExtractFileExt(Result), '.bpl') then + Result := Result + '.bpl'; + Break; end; end; @@ -121,7 +139,7 @@ function TCmpSwStyleVisitor.LoadComponentImage(const APackageName, AClassName: S var packageHandle: THandle; bitmapHandle: THandle; - bitmap: TBitmap; + bitmap: Graphics.TBitmap; begin Result := -1; @@ -129,13 +147,27 @@ begin if packageHandle <> 0 then try - bitmapHandle := LoadBitmap(packageHandle, PChar(AClassName)); + { BDS includes 16x16 versions of the component bitmaps, try those first } + bitmapHandle := LoadBitmap(packageHandle, PChar(AClassName + '16')); + if bitmapHandle = 0 then + bitmapHandle := LoadBitmap(packageHandle, PChar(AClassName)); + if bitmapHandle <> 0 then begin - bitmap ;= - // #ToDo1 (MvR) 10-12-2007: proper transparency - Result := ImageList_AddMasked(FImageList.Handle, bitmapHandle, - GetTransparentColor(bitmapHandle)); + bitmap := Graphics.TBitmap.Create(); + try + bitmap.Handle := bitmapHandle; + + if (bitmap.Width <> FImageList.Width) or + (bitmap.Height <> FImageList.Height) then + begin + ResizeBitmap(bitmap, FImageList.Width, FImageList.Height); + end; + + Result := FImageList.AddMasked(bitmap, bitmap.TransparentColor); + finally + FreeAndNil(bitmap); + end; end; finally FreeLibrary(packageHandle); @@ -148,10 +180,75 @@ begin end; +procedure TCmpSwStyleVisitor.ResizeBitmap(const ABitmap: Graphics.TBitmap; + const AWidth, AHeight: Integer); +var + tempBitmap: Graphics.TBitmap; + +begin + tempBitmap := Graphics.TBitmap.Create(); + try + tempBitmap.PixelFormat := pf24bit; + tempBitmap.Width := AWidth; + tempBitmap.Height := AHeight; + + tempBitmap.Canvas.CopyRect(Rect(0, 0, AWidth, AHeight), ABitmap.Canvas, + Rect(0, 0, ABitmap.Width, ABitmap.Height)); + + ABitmap.Assign(tempBitmap); + finally + FreeAndNil(tempBitmap); + end; +end; + + { TfrmCmpSwDialog } +function TfrmCmpSwDialog.InternalExecute(): TBaseSwItemList; +begin + FClassFilteredList := TBaseSwItemList.Create(); + FClassFilter := TCmpSwComponentClassFilter.Create(); + try + UpdateClassFilter(); + Result := inherited InternalExecute(); + finally + FreeAndNil(FClassFilter); + FreeAndNil(FClassFilteredList); + end; +end; + + function TfrmCmpSwDialog.CreateStyleVisitor(): TBaseSwStyleVisitor; begin Result := TCmpSwStyleVisitor.Create(ilsTypes); end; + +procedure TfrmCmpSwDialog.DrawItemText(ACanvas: TCanvas; AItem: TBaseSwItem; ARect: TRect); +var + text: String; + +begin + inherited; + + 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); +end; + + +procedure TfrmCmpSwDialog.UpdateClassFilter(); +begin +// FClassFilteredList.Clone(ItemList); +// FClassFilter.FilterList(FClassFilteredList); +end; + + +function TfrmCmpSwDialog.GetBaseItemList(): TBaseSwItemList; +begin +// Result := FClassFilteredList; + Result := inherited GetBaseItemList; +end; + end. diff --git a/Source/CmpSwFilters.pas b/Source/CmpSwFilters.pas new file mode 100644 index 0000000..024fbfb --- /dev/null +++ b/Source/CmpSwFilters.pas @@ -0,0 +1,44 @@ +unit CmpSwFilters; + +interface +uses + BaseSwFilters, + BaseSwObjects; + + +type + TCmpSwComponentClassFilter = class(TBaseSwItemSimpleFilter) + protected + procedure VisitItem(const AItem: TBaseSwItem); override; + end; + + +implementation +uses + SysUtils, + + CmpSwObjects; + + +{ TCmpSwComponentClassFilter } +procedure TCmpSwComponentClassFilter.VisitItem(const AItem: TBaseSwItem); +var + componentClass: String; + +begin + componentClass := TCmpSwComponent(AItem).ComponentClass; + + // #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 + FilterItem(AItem); +end; + +end. diff --git a/Source/UnSwDialog.dfm b/Source/UnSwDialog.dfm index 158b77e..d165b88 100644 --- a/Source/UnSwDialog.dfm +++ b/Source/UnSwDialog.dfm @@ -3,8 +3,10 @@ inherited frmUnSwDialog: TfrmUnSwDialog TextHeight = 13 inherited pnlMain: TPanel Height = 307 + ExplicitHeight = 307 inherited lstItems: TListBox Height = 254 + ExplicitHeight = 254 end end inherited pnlButtons: TPanel @@ -69,7 +71,7 @@ inherited frmUnSwDialog: TfrmUnSwDialog end inherited ilsTypes: TImageList Bitmap = { - 494C010106000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010106000900040010001000FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000003000000001002000000000000030 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -469,8 +471,7 @@ inherited frmUnSwDialog: TfrmUnSwDialog E000E0000000AC0FE000E0000000BF3FE000E0000000FFFFE000600000001000 E000200000001000E00000000000B000E00020000000F000E00060000000F000 E000E0000000F000E000E0000000F000E000E0000000F000E001E0010000F000 - E003E003FFFFF000E007E007FFFFF00000000000000000000000000000000000 - 000000000000} + E003E003FFFFF000E007E007FFFFF000} end inherited alMain: TActionList object actSortByName: TAction