GitHub-Mirror
/
unitswitcher
mirror of
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Added: component icons

This commit is contained in:
Mark van Renswoude 2007-12-10 20:29:57 +00:00
parent 0ef2e33fed
commit e3822bae54
10 changed files with 229 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Lib/D2006/UnitSwitcherD2006.bpl
View File

Binary file not shown.

3
Packages/D2006/UnitSwitcher.dpk
View File

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

44
Source/BaseSwClient.pas
View File

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

4
Source/BaseSwDialog.dfm
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

21
Source/BaseSwDialog.pas
View File

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

18
Source/CmpSwClient.pas
View File

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

7
Source/CmpSwDialog.dfm
View File

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

119
Source/CmpSwDialog.pas
View File

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

44
Source/CmpSwFilters.pas Normal file
View File

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

7
Source/UnSwDialog.dfm
View File

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