Added: component icons

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.

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);
+    procedure HookAction(AAction: TContainedAction; AOnExecute: TNotifyEvent; AOnUpdate: TNotifyEvent = nil);
-    function HookIDEAction(const AName: String; AOnExecute: TNotifyEvent): TContainedAction;
+    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
+    if Assigned(hookedAction) and Assigned(hookedAction^.OldOnExecute) then
-      hookedAction^.NewOnExecute(AAction);
+      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;
 

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

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
+    DrawItemText(Canvas, currentItem, textRect);
-             DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
   end;
 end;
 

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.

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

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  ;=
+      bitmap  := Graphics.TBitmap.Create();
-      // #ToDo1 (MvR) 10-12-2007: proper transparency
+      try
-      Result := ImageList_AddMasked(FImageList.Handle, bitmapHandle,
+        bitmap.Handle := bitmapHandle;
-                                    GetTransparentColor(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.

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.

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
+      E003E003FFFFF000E007E007FFFFF000}
-      000000000000}
   end
   inherited alMain: TActionList
     object actSortByName: TAction