214 lines
7.0 KiB
ObjectPascal
214 lines
7.0 KiB
ObjectPascal
|
|
{********************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressCoreLibrary }
|
|
{ }
|
|
{ Copyright (c) 1998-2009 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSCORELIBRARY AND ALL }
|
|
{ ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{********************************************************************}
|
|
|
|
unit dxCoreReg;
|
|
|
|
{$I cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Menus, TypInfo,
|
|
DesignIntf, DesignEditors, DesignConst, DesignMenus, dxCore;
|
|
|
|
const
|
|
dxCompanyName = 'Developer Express Inc.';
|
|
dxCompanyURL = 'www.devexpress.com';
|
|
|
|
type
|
|
TDesignMenuItem = {$IFDEF DELPHI6}DesignMenus.IMenuItem{$ELSE}TMenuItem{$ENDIF};
|
|
|
|
{ TdxComponentEditor }
|
|
|
|
TdxComponentEditor = class(TComponentEditor)
|
|
private
|
|
function GetBaseVerbCount: Integer;
|
|
|
|
procedure AssignClick(Sender: TObject);
|
|
procedure CheckObjectsForAssign(const AObjectName: string);
|
|
procedure UpdateAssignableList;
|
|
protected
|
|
FAssignableObjects: TStringList;
|
|
|
|
function IsAssignable: Boolean; virtual;
|
|
function IsObjectAssignable(AObject: TObject): Boolean; virtual;
|
|
procedure DoAssign(AObject: TObject); virtual; abstract;
|
|
function GetAssignItemCaption: string; virtual;
|
|
function GetAssignTypeClass: TClass; virtual; abstract;
|
|
|
|
function GetProductMajorVersion: string; virtual; abstract;
|
|
function GetProductMinorVersion: string; virtual;
|
|
function GetProductName: string; virtual; abstract;
|
|
function InternalGetVerb(AIndex: Integer): string; virtual;
|
|
function InternalGetVerbCount: Integer; virtual;
|
|
procedure InternalExecuteVerb(AIndex: Integer); virtual;
|
|
public
|
|
constructor Create(AComponent: TComponent; ADesigner: IDesigner); override;
|
|
destructor Destroy; override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
function GetVerbCount: Integer; override;
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
|
|
procedure PrepareItem(Index: Integer; const AItem: TDesignMenuItem); override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TdxComponentEditor }
|
|
|
|
constructor TdxComponentEditor.Create(AComponent: TComponent; ADesigner: IDesigner);
|
|
begin
|
|
inherited;
|
|
|
|
FAssignableObjects := TStringList.Create;
|
|
FAssignableObjects.Sorted := True;
|
|
end;
|
|
|
|
destructor TdxComponentEditor.Destroy;
|
|
begin
|
|
FreeAndNil(FAssignableObjects);
|
|
inherited;
|
|
end;
|
|
|
|
function TdxComponentEditor.GetVerb(Index: Integer): string;
|
|
begin
|
|
if Index < InternalGetVerbCount then
|
|
Result := InternalGetVerb(Index)
|
|
else
|
|
begin
|
|
Index := Index - InternalGetVerbCount;
|
|
if FAssignableObjects.Count = 0 then
|
|
Inc(Index);
|
|
case Index of
|
|
0: Result := GetAssignItemCaption;
|
|
1: Result := '-';
|
|
2: Result := GetProductName + ' ' + Format('%s.%s', [GetProductMajorVersion, GetProductMinorVersion]);
|
|
3: Result := dxCompanyName;
|
|
4: Result := dxCompanyURL;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TdxComponentEditor.GetVerbCount: Integer;
|
|
begin
|
|
if IsAssignable then
|
|
UpdateAssignableList;
|
|
|
|
Result := GetBaseVerbCount + InternalGetVerbCount;
|
|
end;
|
|
|
|
procedure TdxComponentEditor.ExecuteVerb(Index: Integer);
|
|
begin
|
|
if Index < InternalGetVerbCount then
|
|
InternalExecuteVerb(Index);
|
|
end;
|
|
|
|
procedure TdxComponentEditor.PrepareItem(Index: Integer; const AItem: TDesignMenuItem);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited;
|
|
if (FAssignableObjects.Count > 0) and (Index = InternalGetVerbCount) then
|
|
begin
|
|
for I := 0 to FAssignableObjects.Count - 1 do
|
|
AItem.AddItem(FAssignableObjects[I], 0, False, True, AssignClick);
|
|
end;
|
|
end;
|
|
|
|
function TdxComponentEditor.InternalGetVerb(AIndex: Integer): string;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TdxComponentEditor.IsAssignable: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TdxComponentEditor.IsObjectAssignable(AObject: TObject): Boolean;
|
|
begin
|
|
Result := AObject <> Component;
|
|
end;
|
|
|
|
function TdxComponentEditor.GetAssignItemCaption: string;
|
|
begin
|
|
Result := 'Assign From';
|
|
end;
|
|
|
|
function TdxComponentEditor.GetProductMinorVersion: string;
|
|
begin
|
|
Result := IntToStr(dxBuildNumber);
|
|
end;
|
|
|
|
function TdxComponentEditor.InternalGetVerbCount: Integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TdxComponentEditor.InternalExecuteVerb(AIndex: Integer);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
function TdxComponentEditor.GetBaseVerbCount: Integer;
|
|
begin
|
|
Result := 4;
|
|
if FAssignableObjects.Count > 0 then
|
|
Inc(Result);
|
|
end;
|
|
|
|
procedure TdxComponentEditor.AssignClick(Sender: TObject);
|
|
begin
|
|
DoAssign(FAssignableObjects.Objects[((Sender as TMenuItem).MenuIndex)]);
|
|
end;
|
|
|
|
procedure TdxComponentEditor.CheckObjectsForAssign(const AObjectName: string);
|
|
var
|
|
AObject: TObject;
|
|
begin
|
|
AObject := Designer.GetComponent(AObjectName);
|
|
if IsObjectAssignable(AObject) then
|
|
FAssignableObjects.AddObject(AObjectName, AObject);
|
|
end;
|
|
|
|
procedure TdxComponentEditor.UpdateAssignableList;
|
|
begin
|
|
FAssignableObjects.Clear;
|
|
Designer.GetComponentNames(GetTypeData(GetAssignTypeClass.ClassInfo), CheckObjectsForAssign);
|
|
end;
|
|
|
|
end.
|
|
|