318 lines
10 KiB
ObjectPascal
318 lines
10 KiB
ObjectPascal
unit TB2Reg;
|
|
|
|
{
|
|
Toolbar2000
|
|
Copyright (C) 1998-2008 by Jordan Russell
|
|
All rights reserved.
|
|
|
|
The contents of this file are subject to the "Toolbar2000 License"; you may
|
|
not use or distribute this file except in compliance with the
|
|
"Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
|
|
TB2k-LICENSE.txt or at:
|
|
http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
GNU General Public License (the "GPL"), in which case the provisions of the
|
|
GPL are applicable instead of those in the "Toolbar2000 License". A copy of
|
|
the GPL may be found in GPL-LICENSE.txt or at:
|
|
http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt
|
|
If you wish to allow use of your version of this file only under the terms of
|
|
the GPL and not to allow others to use your version of this file under the
|
|
"Toolbar2000 License", indicate your decision by deleting the provisions
|
|
above and replace them with the notice and other provisions required by the
|
|
GPL. If you do not delete the provisions above, a recipient may use your
|
|
version of this file under either the "Toolbar2000 License" or the GPL.
|
|
|
|
$jrsoftware: tb2k/Source/TB2Reg.pas,v 1.32 2008/09/18 19:08:40 jr Exp $
|
|
}
|
|
|
|
interface
|
|
|
|
{$I TB2Ver.inc}
|
|
|
|
uses
|
|
Windows, SysUtils, Classes, Graphics, Controls, Dialogs, ActnList, ImgList,
|
|
{$IFDEF JR_D6} DesignIntf, DesignEditors, VCLEditors, {$ELSE} DsgnIntf, {$ENDIF}
|
|
TB2Toolbar, TB2ToolWindow, TB2Dock, TB2Item, TB2ExtItems, TB2MRU, TB2MDI,
|
|
TB2DsgnItemEditor;
|
|
|
|
procedure Register;
|
|
procedure TBRegisterClasses(const AClasses: array of TPersistentClass);
|
|
|
|
implementation
|
|
|
|
{$IFDEF CLR}
|
|
{ Delphi.NET doesn't use DCR files for component icons }
|
|
{$R 'Icons\TTBBackground.bmp'}
|
|
{$R 'Icons\TTBBackground16.bmp'}
|
|
{$R 'Icons\TTBDock.bmp'}
|
|
{$R 'Icons\TTBDock16.bmp'}
|
|
{$R 'Icons\TTBImageList.bmp'}
|
|
{$R 'Icons\TTBImageList16.bmp'}
|
|
{$R 'Icons\TTBItemContainer.bmp'}
|
|
{$R 'Icons\TTBItemContainer16.bmp'}
|
|
{$R 'Icons\TTBMDIHandler.bmp'}
|
|
{$R 'Icons\TTBMDIHandler16.bmp'}
|
|
{$R 'Icons\TTBMRUList.bmp'}
|
|
{$R 'Icons\TTBMRUList16.bmp'}
|
|
{$R 'Icons\TTBPopupMenu.bmp'}
|
|
{$R 'Icons\TTBPopupMenu16.bmp'}
|
|
{$R 'Icons\TTBToolbar.bmp'}
|
|
{$R 'Icons\TTBToolbar16.bmp'}
|
|
{$R 'Icons\TTBToolWindow.bmp'}
|
|
{$R 'Icons\TTBToolWindow16.bmp'}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
{$IFDEF CLR} WinUtils, {$ENDIF}
|
|
ImgEdit;
|
|
|
|
{$IFDEF JR_D5}
|
|
|
|
{ TTBImageIndexPropertyEditor }
|
|
|
|
{ Unfortunately TComponentImageIndexPropertyEditor seems to be gone in
|
|
Delphi 6, so we have to use our own image index property editor class }
|
|
|
|
type
|
|
TTBImageIndexPropertyEditor = class(TIntegerProperty
|
|
{$IFDEF JR_D6} , ICustomPropertyListDrawing {$ENDIF})
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
function GetImageListAt(Index: Integer): TCustomImageList; virtual;
|
|
|
|
// ICustomPropertyListDrawing
|
|
procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;
|
|
var AHeight: Integer); {$IFNDEF JR_D6} override; {$ENDIF}
|
|
procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
|
|
var AWidth: Integer); {$IFNDEF JR_D6} override; {$ENDIF}
|
|
procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
|
|
const ARect: TRect; ASelected: Boolean); {$IFNDEF JR_D6} override; {$ENDIF}
|
|
end;
|
|
|
|
function TTBImageIndexPropertyEditor.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
Result := [paMultiSelect, paValueList, paRevertable];
|
|
end;
|
|
|
|
function TTBImageIndexPropertyEditor.GetImageListAt(Index: Integer): TCustomImageList;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TTBImageIndexPropertyEditor.GetValues(Proc: TGetStrProc);
|
|
var
|
|
ImgList: TCustomImageList;
|
|
I: Integer;
|
|
begin
|
|
ImgList := GetImageListAt(0);
|
|
if Assigned(ImgList) then
|
|
for I := 0 to ImgList.Count-1 do
|
|
Proc(IntToStr(I));
|
|
end;
|
|
|
|
procedure TTBImageIndexPropertyEditor.ListDrawValue(const Value: string;
|
|
ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
|
var
|
|
ImgList: TCustomImageList;
|
|
X: Integer;
|
|
begin
|
|
ImgList := GetImageListAt(0);
|
|
ACanvas.FillRect(ARect);
|
|
X := ARect.Left + 2;
|
|
if Assigned(ImgList) then begin
|
|
ImgList.Draw(ACanvas, X, ARect.Top + 2, StrToInt(Value));
|
|
Inc(X, ImgList.Width);
|
|
end;
|
|
ACanvas.TextOut(X + 3, ARect.Top + 1, Value);
|
|
end;
|
|
|
|
procedure TTBImageIndexPropertyEditor.ListMeasureHeight(const Value: string;
|
|
ACanvas: TCanvas; var AHeight: Integer);
|
|
var
|
|
ImgList: TCustomImageList;
|
|
begin
|
|
ImgList := GetImageListAt(0);
|
|
AHeight := ACanvas.TextHeight(Value) + 2;
|
|
if Assigned(ImgList) and (ImgList.Height + 4 > AHeight) then
|
|
AHeight := ImgList.Height + 4;
|
|
end;
|
|
|
|
procedure TTBImageIndexPropertyEditor.ListMeasureWidth(const Value: string;
|
|
ACanvas: TCanvas; var AWidth: Integer);
|
|
var
|
|
ImgList: TCustomImageList;
|
|
begin
|
|
ImgList := GetImageListAt(0);
|
|
AWidth := ACanvas.TextWidth(Value) + 4;
|
|
if Assigned(ImgList) then
|
|
Inc(AWidth, ImgList.Width);
|
|
end;
|
|
|
|
{ TTBItemImageIndexPropertyEditor }
|
|
|
|
type
|
|
TTBItemImageIndexPropertyEditor = class(TTBImageIndexPropertyEditor)
|
|
public
|
|
function GetImageListAt(Index: Integer): TCustomImageList; override;
|
|
end;
|
|
|
|
function TTBItemImageIndexPropertyEditor.GetImageListAt(Index: Integer): TCustomImageList;
|
|
var
|
|
C: TPersistent;
|
|
Item: TTBCustomItem;
|
|
begin
|
|
Result := nil;
|
|
{ ? I'm guessing that the Index parameter is a component index (one that
|
|
would be passed to the GetComponent function). }
|
|
C := GetComponent(Index);
|
|
if C is TTBCustomItem then begin
|
|
Item := TTBCustomItem(C);
|
|
repeat
|
|
Result := Item.Images;
|
|
if Assigned(Result) then
|
|
Break;
|
|
Item := Item.Parent;
|
|
if Item = nil then
|
|
Break;
|
|
Result := Item.SubMenuImages;
|
|
until Assigned(Result);
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
{ TTBImageListEditor }
|
|
|
|
type
|
|
TTBImageListEditor = class(TComponentEditor)
|
|
public
|
|
procedure Edit; override;
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerb(Index: Integer): String; override;
|
|
function GetVerbCount: Integer; override;
|
|
end;
|
|
|
|
procedure TTBImageListEditor.Edit;
|
|
var
|
|
ImgList: TTBImageList;
|
|
begin
|
|
ImgList := Component as TTBImageList;
|
|
if not ImgList.ImagesBitmap.Empty then begin
|
|
if MessageDlg('The image list''s ImagesBitmap property has ' +
|
|
'a bitmap assigned. Because of this, any changes you make in the ' +
|
|
'Image List Editor will not be preserved when the form is saved.'#13#10#13#10 +
|
|
'Do you want to open the editor anyway?', mtWarning,
|
|
[mbYes, mbNo], 0) <> mrYes then
|
|
Exit;
|
|
end;
|
|
EditImageList(ImgList);
|
|
end;
|
|
|
|
procedure TTBImageListEditor.ExecuteVerb(Index: Integer);
|
|
begin
|
|
if Index = 0 then
|
|
Edit;
|
|
end;
|
|
|
|
function TTBImageListEditor.GetVerbCount: Integer;
|
|
begin
|
|
Result := 1;
|
|
end;
|
|
|
|
function TTBImageListEditor.GetVerb(Index: Integer): String;
|
|
begin
|
|
if Index = 0 then
|
|
Result := 'ImageList Editor...'
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
|
|
procedure TBRegisterClasses(const AClasses: array of TPersistentClass);
|
|
{$IFDEF CLR}
|
|
var
|
|
I: Integer;
|
|
FoundClass: TPersistentClass;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF CLR}
|
|
{ Hack for Delphi.NET (2006): If you recompile an already-installed package
|
|
the IDE doesn't unload the old package before installing the new one.
|
|
Therefore, we must search for and unregister any existing classes before
|
|
registering new ones, to avoid having two incompatible sets of classes
|
|
registered at the same time.
|
|
Without this, if we rebuild tb2kdsgn_dn10 (which implicitly reloads
|
|
tb2k_dn10) and then attempt to open the Demo project's main form in the
|
|
IDE, we get a "Toolbar item cannot be inserted into container of type
|
|
TTBToolbar" exception inside TTBCustomItem.SetParentComponent, because
|
|
apparently the TTBToolbar class it's trying to use is located in the new
|
|
assembly, while the item class is located in the old assembly.
|
|
Note: It appears that this issue only affects registered classes; there
|
|
is no need for an "UnRegisterComponents" call. }
|
|
for I := High(AClasses) downto Low(AClasses) do begin
|
|
{ Unregister all classes with the same name }
|
|
while True do begin
|
|
FoundClass := GetClass(AClasses[I].ClassName);
|
|
if FoundClass = nil then
|
|
Break;
|
|
UnRegisterClass(FoundClass);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
RegisterClasses(AClasses);
|
|
end;
|
|
|
|
procedure Register;
|
|
begin
|
|
{ Note: On Delphi.NET 2006, it's possible for this procedure to be called
|
|
a second time on the same tb2kdsgn instance. See comments in
|
|
TBRegisterItemClass. }
|
|
|
|
RegisterComponents('Toolbar2000', [TTBDock, TTBToolbar, TTBToolWindow,
|
|
TTBPopupMenu, TTBImageList, TTBItemContainer, TTBBackground, TTBMRUList,
|
|
TTBMDIHandler]);
|
|
{$IFDEF JR_D4}
|
|
RegisterActions('', [TTBEditAction], nil);
|
|
{$ENDIF}
|
|
RegisterNoIcon([TTBCustomItem]);
|
|
TBRegisterClasses([TTBItem, TTBGroupItem, TTBSubmenuItem, TTBSeparatorItem,
|
|
TTBEditItem, TTBMRUListItem, TTBControlItem, TTBMDIWindowItem,
|
|
TTBVisibilityToggleItem]);
|
|
|
|
RegisterComponentEditor(TTBCustomToolbar, TTBItemsEditor);
|
|
RegisterComponentEditor(TTBItemContainer, TTBItemsEditor);
|
|
RegisterComponentEditor(TTBPopupMenu, TTBItemsEditor);
|
|
RegisterComponentEditor(TTBImageList, TTBImageListEditor);
|
|
RegisterPropertyEditor(TypeInfo(TTBRootItem), nil, '', TTBItemsPropertyEditor);
|
|
{$IFDEF JR_D5}
|
|
RegisterPropertyEditor(TypeInfo(TImageIndex), TTBCustomItem, 'ImageIndex',
|
|
TTBItemImageIndexPropertyEditor);
|
|
{$ENDIF}
|
|
{$IFDEF JR_D6}
|
|
{ TShortCut properties show up like Integer properties in Delphi 6
|
|
without this... }
|
|
RegisterPropertyEditor(TypeInfo(TShortCut), TTBCustomItem, '',
|
|
TShortCutProperty);
|
|
{$ENDIF}
|
|
|
|
{ Link in images for the toolbar buttons }
|
|
{$IFNDEF CLR}
|
|
{$R TB2DsgnItemEditor.res}
|
|
{$ELSE}
|
|
{$R 'Icons\TB2DsgnEditorImages.bmp'}
|
|
{$R 'Icons\TTBEditItem.bmp'}
|
|
{$R 'Icons\TTBGroupItem.bmp'}
|
|
{$R 'Icons\TTBMDIWindowItem.bmp'}
|
|
{$R 'Icons\TTBMRUListItem.bmp'}
|
|
{$ENDIF}
|
|
TBRegisterItemClass(TTBEditItem, 'New &Edit', HInstance);
|
|
TBRegisterItemClass(TTBGroupItem, 'New &Group Item', HInstance);
|
|
TBRegisterItemClass(TTBMRUListItem, 'New &MRU List Item', HInstance);
|
|
TBRegisterItemClass(TTBMDIWindowItem, 'New MDI &Windows List', HInstance);
|
|
TBRegisterItemClass(TTBVisibilityToggleItem, 'New &Visibility-Toggle Item', HInstance);
|
|
end;
|
|
|
|
end.
|