1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
|
uses ...DesignIntf, DesignEditors, VCLEditors, TypInfo...;
type
TBugManagerEventEditor = class(TMethodProperty)
private
function GetInstance: TPersistent;
public
function GetAttributes: TPropertyAttributes; override;
function GetName: string; override;
procedure GetProperties(Proc: TGetPropProc); override;
function GetValue: string; override;
property Instance: TPersistent read GetInstance;
end;
TEventProperty = class(TNestedProperty)
private
FParent: TPropertyEditor;
FPropInfo: PPropInfo;
function GetInstance: TPersistent;
protected
constructor Create(AParent: TPropertyEditor; APropInfo: PPropInfo); reintroduce;
public
procedure Edit; override;
function GetName: string; override;
function GetValue: string; override;
procedure SetValue(const AValue: string); override;
end;
procedure Register;
implementation
uses DesignConst;
procedure Register;
begin
RegisterComponents('Kaféine Test', [TCustomSimulator]);
RegisterPropertyEditor(TypeInfo(TNotifyEvent), TCustomSimulator, 'BugManagerEvents', TBugManagerEventEditor);
end;
{ TBugManagerEventEditor }
function TBugManagerEventEditor.GetAttributes: TPropertyAttributes;
begin
Result := [paMultiSelect, paSubProperties, paReadOnly, paRevertable];
end;
function TBugManagerEventEditor.GetInstance: TPersistent;
begin
Result := TCustomSimulator(GetComponent(0)).BugManager;
end;
function TBugManagerEventEditor.GetName: string;
begin
Result := 'BugManager';
end;
procedure TBugManagerEventEditor.GetProperties(Proc: TGetPropProc);
var
APropList: TPropList;
I, ACount : Integer;
begin
ACount := GetPropList(Instance.ClassInfo, [tkMethod], @APropList);
for I := 0 to ACount - 1 do
Proc(TEventProperty.Create(Self, APropList[I]));
end;
function TBugManagerEventEditor.GetValue: string;
begin
Result := '(' + Instance.ClassName + ')';
end;
{ TEventProperty }
constructor TEventProperty.Create(AParent: TPropertyEditor;
APropInfo: PPropInfo);
begin
inherited Create(AParent);
FPropInfo := APropInfo;
FParent := AParent;
end;
procedure TEventProperty.Edit;
var
NomMethode: string;
begin
NomMethode := GetValue;
if (NomMethode = '') or Designer.MethodFromAncestor(GetMethodValue) then
begin
if NomMethode = '' then
NomMethode := Designer.GetObjectName(GetComponent(0)) + GetName;
if NomMethode = '' then
raise EPropertyError.Create(SCannotCreateName);
SetValue(NomMethode);
end;
Designer.ShowMethod(NomMethode);
end;
function TEventProperty.GetInstance: TPersistent;
begin
Result := nil;
if FParent is TBugManagerEventEditor then
Result := TBugManagerEventEditor(FParent).Instance;
end;
function TEventProperty.GetName: string;
begin
Result := FPropInfo.Name;
end;
function TEventProperty.GetValue: string;
begin
Result := Designer.GetMethodName(GetMethodProp(GetInstance, FPropInfo));
end;
procedure TEventProperty.SetValue(const AValue: string);
var
IsNouvelle: Boolean;
ValeurCourante: string;
AncienneMethode: TMethod;
begin
ValeurCourante:= GetValue;
if (ValeurCourante <> '') and (AValue <> '') and ((CompareText(ValeurCourante, AValue) = 0) or
not Designer.MethodExists(AValue)) and not Designer.MethodFromAncestor(GetMethodValue) then
Designer.RenameMethod(ValeurCourante, AValue)
else
begin
IsNouvelle := (AValue <> '') and not Designer.MethodExists(AValue);
AncienneMethode := GetMethodValue;
SetMethodProp(GetInstance, FPropInfo,
Designer.CreateMethod(AValue, GetTypeData(FPropInfo.PropType^)));
if IsNouvelle then
begin
Designer.ShowMethod(AValue);
end;
Designer.Modified;
end;
end; |
Partager