{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{                                                       }
{       Copyright (c) 1995 Borland International        }
{                                                       }
{*******************************************************}

unit DsgnIntf;

interface

{$N+,S-,W-}

uses SysUtils, Classes, Graphics, Controls, Forms, TypInfo;

type

{ TComponentList }

  TComponentList = class(TObject)
  private
    FList: TList;
    function Get(Index: Integer): TComponent;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(Item: TComponent): Integer;
    function Equals(List: TComponentList): Boolean;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TComponent read Get; default;
  end;

{ TPropertyEditor
  Edits a property of a component, or list of components, selected into the
  Object Inspector.  The property editor is created based on the type of the
  property being edited as determined by the types registered by
  RegisterPropertyEditor.  The Object Inspector uses the a TPropertyEditor
  for all modification to a property. GetName and GetValue are called to display
  the name and value of the property.  SetValue is called whenever the user
  requests to change the value.  Edit is called when the user double-clicks the
  property in the Object Inspector. GetValues is called when the drop-down
  list of a property is displayed.  GetProperties is called when the property
  is expanded to show sub-properties.  AllEqual is called to decide whether or
  not to display the value of the property when more than one component is
  selected.

  The following are methods that can be overriden to change the behavior of
  the property editor:

    Activate
      Called whenever the property becomes selected in the object inspector.
      This is potientially useful to allow certian property attributes to
      to only be determined whenever the property is selected in the object
      inspector. Only paSubProperties and paMultiSelect, returned from
      GetAttributes, need to be accurate before this method is called.
    AllEqual
      Called whenever there are more than one components selected.  If this
      method returns true, GetValue is called, otherwise blank is displayed
      in the Object Inspector.  This is called only when GetAttributes
      returns paMultiSelect.
    Edit
      Called when the '...' button is pressed or the property is double-clicked.
      This can, for example, bring up a dialog to allow the editing the
      component in some more meaningful fashion than by text (e.g. the Font
      property).
    GetAttributes
      Returns the information for use in the Object Inspector to be able to
      show the approprate tools.  GetAttributes return a set of type
      TPropertyAttributes:
        paValueList:     The property editor can return an enumerated list of
                         values for the property.  If GetValues calls Proc
                         with values then this attribute should be set.  This
                         will cause the drop-down button to appear to the right
                         of the property in the Object Inspector.
        paSortList:      Object Inspector to sort the list returned by
                         GetValues.
        paSubProperties: The property editor has sub-properties that will be
                         displayed indented and below the current property in
                         standard outline format. If GetProperties will
                         generate property objects then this attribute should
                         be set.
        paDialog:        Indicates that the Edit method will bring up a
                         dialog.  This will cause the '...' button to be
                         displayed to the right of the property in the Object
                         Inspector.
        paMultiSelect:   Allows the property to be displayed when more than
                         one component is selected.  Some properties are not
                         approprate for multi-selection (e.g. the Name
                         property).
        paAutoUpdate:    Causes the SetValue method to be called on each
                         change made to the editor instead of after the change
                         has been approved (e.g. the Caption property).
        paReadOnly:      Value is not allowed to change.
    GetComponent
      Returns the Index'th component being edited by this property editor.  This
      is used to retieve the components.  A property editor can only refer to
      multiple components when paMultiSelect is returned from GetAttributes.
    GetEditLimit
      Returns the number of character the user is allowed to enter for the
      value.  The inplace editor of the object inspector will be have its
      text limited set to the return value.  By default this limit is 255.
    GetName
      Returns a the name of the property.  By default the value is retrieved
      from the type information with all underbars replaced by spaces.  This
      should only be overriden if the name of the property is not the name
      that should appear in the Object Inspector.
    GetProperties
      Should be overriden to call PropertyProc for every sub-property (or nested
      property) of the property begin edited and passing a new TPropertyEdtior
      for each sub-property.  By default, PropertyProc is not called and no
      sub-properties are assumed.  TClassProperty will pass a new property
      editor for each published property in a class.  TSetProperty passes a
      new editor for each element in the set.
    GetPropType
      Returns the type information pointer for the propertie(s) being edited.
    GetValue
      Returns the string value of the property. By default this returns
      '(unknown)'.  This should be overriden to return the appropriate value.
    GetValues
      Called when paValueList is returned in GetAttributes.  Should call Proc
      for every value that is acceptable for this property.  TEnumProperty
      will pass every element in the enumeration.
    Initialize
      Called after the property editor has been created but before it is used.
      Many times property editors are created and because they are not a common
      property across the entire selection they are thrown away.  Initialize is
      called after it is determined the property editor is going to be used by
      the object inspector and not just thrown away.
    SetValue(Value)
      Called to set the value of the property.  The property editor should be
      able to translate the string and call one of the SetXxxValue methods. If
      the string is not in the correct format or not an allowed value, the
      property editor should generate an exception describing the problem. Set
      value can ignore all changes and allow all editing of the property be
      accomplished through the Edit method (e.g. the Picture property).

  Properties and methods useful in creating a new TPropertyEditor classes:

    Name property
      Returns the name of the property returned by GetName
    PrivateDirectory property
      It is either the .EXE or the "working directory" as specified in
      DELPHI.INI.  If the property editor needs auxilury or state files
      (templates, examples, etc) they should be stored in this directory.
    Properties indexed property
      The TProperty objects representing all the components being edited
      by the property editor.  If more than one component is selected, one
      TProperty object is created for each component.  Typically, it is not
      necessary to use this array since the Get/SetXxxValue methods will
      propagate the values appropriatly.
    Value property
      The current value, as a string, of the property as returned by GetValue.
    Modified
      Called to indicate the value of the property has been modified.  Called
      automatically by the SetXxxValue methods.  If you call a TProperty
      SetXxxValue method directly, you *must* call Modified as well.
    GetXxxValue
      Gets the value of the first property in the Properties property.  Calls
      the appropriate TProperty GetXxxValue method to retrieve the value.
    SetXxxValue
      Sets the value of all the properties in the Properties property.  Calls
      the approprate TProperty SetXxxxValue methods to set the value. }

  TFormDesigner = class(TDesigner)
  public
    function CreateMethod(const Name: string; TypeData: PTypeData): TMethod; virtual; abstract;
    function GetMethodName(const Method: TMethod): string; virtual; abstract;
    procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc); virtual; abstract;
    function GetPrivateDirectory: string; virtual; abstract;
    function MethodExists(const Name: string): Boolean; virtual; abstract;
    procedure RenameMethod(const CurName, NewName: string); virtual; abstract;
    procedure ShowMethod(const Name: string); virtual; abstract;
  end;

  TPropertyAttribute = (paValueList, paSubProperties, paDialog,
    paMultiSelect, paAutoUpdate, paSortList, paReadOnly);
  TPropertyAttributes = set of TPropertyAttribute;

  TPropertyEditor = class;

  TInstProp = record
    Instance: TComponent;
    PropInfo: PPropInfo;
  end;

  PInstPropList = ^TInstPropList;
  TInstPropList = array[0..1023] of TInstProp;

  TGetPropEditProc = procedure(Prop: TPropertyEditor) of object;

  TPropertyEditor = class
  private
    FDesigner: TFormDesigner;
    FPropList: PInstPropList;
    FPropCount: Integer;
    constructor Create(ADesigner: TFormDesigner; APropCount: Integer);
    function GetPrivateDirectory: string;
    procedure SetPropEntry(Index: Integer; AInstance: TComponent;
      APropInfo: PPropInfo);
  protected
    function GetPropInfo: PPropInfo;
    function GetFloatValue: Extended;
    function GetFloatValueAt(Index: Integer): Extended;
    function GetMethodValue: TMethod;
    function GetMethodValueAt(Index: Integer): TMethod;
    function GetOrdValue: Longint;
    function GetOrdValueAt(Index: Integer): Longint;
    function GetStrValue: string;
    function GetStrValueAt(Index: Integer): string;
    procedure Modified;
    procedure SetFloatValue(Value: Extended);
    procedure SetMethodValue(const Value: TMethod);
    procedure SetOrdValue(Value: Longint);
    procedure SetStrValue(const Value: string);
  public
    destructor Destroy; override;
    procedure Activate; virtual;
    function AllEqual: Boolean; virtual;
    procedure Edit; virtual;
    function GetAttributes: TPropertyAttributes; virtual;
    function GetComponent(Index: Integer): TComponent;
    function GetEditLimit: Integer; virtual;
    function GetName: string; virtual;
    procedure GetProperties(Proc: TGetPropEditProc); virtual;
    function GetPropType: PTypeInfo;
    function GetValue: string; virtual;
    procedure GetValues(Proc: TGetStrProc); virtual;
    procedure Initialize; virtual;
    procedure SetValue(const Value: string); virtual;
    property Designer: TFormDesigner read FDesigner;
    property PrivateDirectory: string read GetPrivateDirectory;
    property PropCount: Integer read FPropCount;
    property Value: string read GetValue write SetValue;
  end;

  TPropertyEditorClass = class of TPropertyEditor;

{ TOrdinalProperty
  The base class of all ordinal property editors.  It established that ordinal
  properties are all equal if the GetOrdValue all return the same value. }

  TOrdinalProperty = class(TPropertyEditor)
    function AllEqual: Boolean; override;
    function GetEditLimit: Integer; override;
  end;

{ TIntegerProperty
  Default editor for all Longint properties and all subtypes of the Longint
  type (i.e. Integer, Word, 1..10, etc.).  Retricts the value entrered into
  the property to the range of the sub-type. }

  TIntegerProperty = class(TOrdinalProperty)
  public
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

{ TCharProperty
  Default editor for all Char properties and sub-types of Char (i.e. Char,
  'A'..'Z', etc.). }

  TCharProperty = class(TOrdinalProperty)
  public
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

{ TEnumProperty
  The default property editor for all enumerated properties (e.g. TShape =
  (sCircle, sTriangle, sSquare), etc.). }

  TEnumProperty = class(TOrdinalProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

{ TFloatProperty
  The default property editor for all floating point types (e.g. Float,
  Single, Double, etc.) }

  TFloatProperty = class(TPropertyEditor)
  public
    function AllEqual: Boolean; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

{ TStringProperty
  The default property editor for all strings and sub types (e.g. string,
  string[20], etc.). }

  TStringProperty = class(TPropertyEditor)
  public
    function AllEqual: Boolean; override;
    function GetEditLimit: Integer; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

{ TSetElementProperty
  A property editor that edits an individual set element.  GetName is
  changed to display the set element name instead of the property name and
  Get/SetValue is changed to reflect the individual element state.  This
  editor is created by the TSetProperty editor. }

  TSetElementProperty = class(TPropertyEditor)
  private
    FElement: Integer;
    constructor Create(ADesigner: TFormDesigner; APropList: PInstPropList;
      APropCount: Integer; AElement: Integer);
  public
    destructor Destroy; override;
    function AllEqual: Boolean; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetName: string; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
   end;

{ TSetProperty
  Default property editor for all set properties. This editor does not edit
  the set directly but will display sub-properties for each element of the
  set. GetValue displays the value of the set in standard set syntax. }

  TSetProperty = class(TOrdinalProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetProperties(Proc: TGetPropEditProc); override;
    function GetValue: string; override;
  end;

{ TClassProperty
  Default proeperty editor for all objects.  Does not allow modifing the
  property but does display the class name of the object and will allow the
  editing of the object's properties as sub-properties of the property. }

  TClassProperty = class(TPropertyEditor)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetProperties(Proc: TGetPropEditProc); override;
    function GetValue: string; override;
  end;

{ TMethodProperty
  Property editor for all method properties. }

  TMethodProperty = class(TPropertyEditor)
  public
    function AllEqual: Boolean; override;
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetEditLimit: Integer; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const AValue: string); override;
  end;

{ TComponentProperty
  The default editor for TComponents.  It does not allow editing of the
  properties of the component.  It allow the user to set the value of this
  property to point to a component in the same form that is type compatible
  with the property being edited (e.g. the ActiveControl property). }

  TComponentProperty = class(TPropertyEditor)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetEditLimit: Integer; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

{ TComponentNameProperty
  Property editor for the Name property.  It restricts the name property
  from being displayed when more than one component is selected. }

  TComponentNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
  end;

{ TFontNameProperty
  Editor for the TFont.FontName property.  Displays a drop-down list of all
  the fonts known by Windows.}

  TFontNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

{ TColorProperty
  Property editor for the TColor type.  Displays the color as a clXXX value
  if one exists, otherwise displays the value as hex.  Also allows the
  clXXX value to be picked from a list. }

  TColorProperty = class(TIntegerProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

{ TCursorProperty
  Property editor for the TCursor type.  Displays the color as a crXXX value
  if one exists, otherwise displays the value as hex.  Also allows the
  clXXX value to be picked from a list. }

  TCursorProperty = class(TIntegerProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

{ TFontProperty
  Property editor the Font property.  Brings up the font dialog as well as
  allowing the properties of the object to be edited. }

  TFontProperty = class(TClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

{ TModalResultProperty }

  TModalResultProperty = class(TIntegerProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

{ TShortCutProperty
  Property editor the the ShortCut property.  Allows both typing in a short
  cut value or picking a short-cut value from a list. }

  TShortCutProperty = class(TOrdinalProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

{ TMPFilenameProperty
  Property editor for the TMediaPlayer.  Displays an File Open Dialog
  for the name of the media file.}

  TMPFilenameProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

{ TTabOrderProperty
  Property editor for the TabOrder property.  Prevents the property from being
  displayed when more than one component is selected. }

  TTabOrderProperty = class(TIntegerProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
  end;

{ TCaptionProperty
  Property editor for the Caption and Text properties.  Updates the value of
  the property for each change instead on when the property is approved. }

  TCaptionProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
  end;

  EPropertyError = class(Exception);

{ TComponentEditor
  A component editor is created for each component that is selected in the
  form designer based on the component's type (see GetComponentEditor and
  RegisterComponentEditor).  When the component is double-clicked the Edit
  method is called.  When the context menu for the component is invoked the
  GetVerbCount and GetVerb methods are called to build the menu.  If one
  of the verbs are selected ExecuteVerb is called.  Paste is called whenever
  the component is pasted to the clipboard.  You only need to create a
  component editor if you wish to add verbs to the context menu, change
  the default double-click behavior, or paste an additional clipboard format.
  The default component editor (TDefaultEditor) implements Edit to searchs the
  properties of the component and generates (or navigates to) the OnCreate,
  OnChanged, or OnClick event (whichever it finds first).  Whenever the
  component modifies the component is *must* call Designer.Modified to inform
  the designer that the form has been modified.

    Create(AComponent, ADesigner)
      Called to create the component editor.  AComponent is the component to
      be edited by the editor.  ADesigner is an interface to the designer to
      find controls and create methods (this is not use often).
    Edit
      Called when the user double-clicks the component. The component editor can
      bring up a dialog in responce to this method, for example, or some kind
      of design expert.  If GetVerbCount is greater than zero, edit will execute
      the first verb in the list (ExecuteVerb(0)).
    ExecuteVerb(Index)
      The Index'ed verb was selected by the use off the context menu.  The
      meaning of this is determined by component editor.
    GetVerb
      The component editor should return a string that will be displayed in the
      context menu.  It is the responcibility of the component editor to place
      the & character and the '...' characters as appropriate.
    GetVerbCount
      The number of valid indexs to GetVerb and Execute verb.  The index assumed
      to be zero based (i.e. 0..GetVerbCount - 1).
    Copy
      Called when the component is being copyied to the clipboard.  The
      component's filed image is already on the clipboard.  This gives the
      component editor a chance to paste a different type of format which is
      ignored by the designer but might be recoginized by another application. }

  TComponentEditor = class
  private
    FComponent: TComponent;
    FDesigner: TFormDesigner;
  public
    constructor Create(AComponent: TComponent; ADesigner: TFormDesigner); virtual;
    procedure Edit; virtual;
    procedure ExecuteVerb(Index: Integer); virtual;
    function GetVerb(Index: Integer): string; virtual;
    function GetVerbCount: Integer; virtual;
    procedure Copy; virtual;
    property Component: TComponent read FComponent;
    property Designer: TFormDesigner read FDesigner;
  end;

  TComponentEditorClass = class of TComponentEditor;

  TDefaultEditor = class(TComponentEditor)
  private
    FFirst: TPropertyEditor;
    FBest: TPropertyEditor;
    FContinue: Boolean;
    procedure CheckEdit(PropertyEditor: TPropertyEditor);
  protected
    procedure EditProperty(PropertyEditor: TPropertyEditor;
      var Continue, FreeEditor: Boolean); virtual;
  public
    procedure Edit; override;
  end;

{ RegisterPropertyEditor
  Registers a new property editor for the given type.  When a component is
  selected the Object Inspector will create a property editor for each
  of the component's properties.  The property editor is created based on
  the type of the property.  If, for example, the property type is an
  Integer, the property editor for Integer will be created (by default
  that would be TIntegerProperty). Most properties do not need specialized
  property editors.  For example, if the property is an ordinal type the
  default property editor will restrict the range to the ordinal subtype
  range (e.g. a property of type TMyRange = 1..10 will only allow values
  between 1 and 10 to be entered into the property).  Enumerated types will
  display a drop-down list of all the enumerated values (e.g. TShapes =
  (sCircle, sSquare, sTriangle) will be edited by a drop-down list containing
  only sCircle, sSquare and sTriangle).  A property editor need only be
  created if default property editor or none of the existing property editors
  are sufficient to edit the property.  This is typically because the
  property is an object.  The properties are looked up newest to oldest.
  This allows and existing property editor replaced by a custom property
  editor.

    PropertyType
      The type information pointer returned by the TypeInfo built-in function
      (e.g. TypeInfo(TMyRange) or TypeInfo(TShapes)).

    ComponentClass
      Type type of the component to which to restrict this type editor.  This
      parameter can be left nil which will mean this type editor applies to all
      properties of PropertyType.

    PropertyName
      The name of the property to which to restrict this type editor.  This
      parameter is ignored if ComponentClass is nil.  This paramter can be
      an empty string ('') which will mean that this editor applies to all
      properties of PropertyType in ComponentClass.

    EditorClass
      The class of the editor to be created whenever a property of the type
      passed in PropertyTypeInfo is displayed in the Object Inspector.  The
      class will be created by calling EditorClass.Create. }

procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  const PropertyName: string; EditorClass: TPropertyEditorClass);

procedure GetComponentProperties(Components: TComponentList;
  Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);

procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  ComponentEditor: TComponentEditorClass);

function GetComponentEditor(Component: TComponent;
  Designer: TFormDesigner): TComponentEditor;

implementation

uses WinTypes, WinProcs, Menus, Dialogs, Consts, IniFiles;

type
  TCardinalSet = set of 0..SizeOf(Cardinal) * 8 - 1;

type
  PPropertyClassRec = ^TPropertyClassRec;
  TPropertyClassRec = record
    Next: PPropertyClassRec;
    PropertyType: PTypeInfo;
    PropertyName: PString;
    ComponentClass: TClass;
    EditorClass: TPropertyEditorClass;
  end;

const
  PropClassMap: array[TTypeKind] of TPropertyEditorClass = (
    TPropertyEditor, TIntegerProperty, TCharProperty, TEnumProperty,
    TFloatProperty, TStringProperty, TSetProperty, TClassProperty,
    TMethodProperty);
  PropertyClassList: PPropertyClassRec = nil;

const

  { context ids for the Font editor and the Color Editor, etc. }
  hcDFontEditor       = 25000;
  hcDColorEditor      = 25010;
  hcDMediaPlayerOpen  = 25020;

{ TComponentList }

constructor TComponentList.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TComponentList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

function TComponentList.Get(Index: Integer): TComponent;
begin
  Result := FList[Index];
end;

function TComponentList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TComponentList.Add(Item: TComponent): Integer;
begin
  Result := FList.Add(Item);
end;

function TComponentList.Equals(List: TComponentList): Boolean;
var
  I: Integer;
begin
  Result := False;
  if List.Count <> FList.Count then Exit;
  for I := 0 to List.Count - 1 do if List[I] <> FList[I] then Exit;
  Result := True;
end;

{ TPropertyEditor }

constructor TPropertyEditor.Create(ADesigner: TFormDesigner;
  APropCount: Integer);
begin
  FDesigner := ADesigner;
  GetMem(FPropList, APropCount * SizeOf(TInstProp));
  FPropCount := APropCount;
end;

destructor TPropertyEditor.Destroy;
begin
  if FPropList <> nil then
    FreeMem(FPropList, FPropCount * SizeOf(TInstProp));
end;

procedure TPropertyEditor.Activate;
begin
end;

function TPropertyEditor.AllEqual: Boolean;
begin
  Result := FPropCount = 1;
end;

procedure TPropertyEditor.Edit;
type
  TGetStrFunc = function(const Value: string): Integer of object;
var
  I: Integer;
  Values: TStringList;
  AddValue: TGetStrFunc;
begin
  Values := TStringList.Create;
  Values.Sorted := paSortList in GetAttributes;
  try
    AddValue := Values.Add;
    GetValues(TGetStrProc(AddValue));
    if Values.Count > 0 then
    begin
      I := Values.IndexOf(Value) + 1;
      if I = Values.Count then I := 0;
      Value := Values[I];
    end;
  finally
    Values.Free;
  end;
end;

function TPropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect];
end;

function TPropertyEditor.GetComponent(Index: Integer): TComponent;
begin
  Result := FPropList^[Index].Instance;
end;

function TPropertyEditor.GetFloatValue: Extended;
begin
  Result := GetFloatValueAt(0);
end;

function TPropertyEditor.GetFloatValueAt(Index: Integer): Extended;
begin
  with FPropList^[Index] do Result := GetFloatProp(Instance, PropInfo);
end;

function TPropertyEditor.GetMethodValue: TMethod;
begin
  Result := GetMethodValueAt(0);
end;

function TPropertyEditor.GetMethodValueAt(Index: Integer): TMethod;
begin
  with FPropList^[Index] do Result := GetMethodProp(Instance, PropInfo);
end;

function TPropertyEditor.GetEditLimit: Integer;
begin
  Result := 255;
end;

function TPropertyEditor.GetName: string;
begin
  Result := FPropList^[0].PropInfo^.Name;
end;

function TPropertyEditor.GetOrdValue: Longint;
begin
  Result := GetOrdValueAt(0);
end;

function TPropertyEditor.GetOrdValueAt(Index: Integer): Longint;
begin
  with FPropList^[Index] do Result := GetOrdProp(Instance, PropInfo);
end;

function TPropertyEditor.GetPrivateDirectory: string;
begin
  Result := Designer.GetPrivateDirectory;
end;

procedure TPropertyEditor.GetProperties(Proc: TGetPropEditProc);
begin
end;

function TPropertyEditor.GetPropInfo: PPropInfo;
begin
  Result := FPropList^[0].PropInfo;
end;

function TPropertyEditor.GetPropType: PTypeInfo;
begin
  Result := FPropList^[0].PropInfo^.PropType;
end;

function TPropertyEditor.GetStrValue: string;
begin
  Result := GetStrValueAt(0);
end;

function TPropertyEditor.GetStrValueAt(Index: Integer): string;
begin
  with FPropList^[Index] do Result := GetStrProp(Instance, PropInfo);
end;

function TPropertyEditor.GetValue: string;
begin
  Result := LoadStr(srUnknown);
end;

procedure TPropertyEditor.GetValues(Proc: TGetStrProc);
begin
end;

procedure TPropertyEditor.Initialize;
begin
end;

procedure TPropertyEditor.Modified;
begin
  Designer.Modified;
end;

procedure TPropertyEditor.SetFloatValue(Value: Extended);
var
  I: Integer;
begin
  for I := 0 to FPropCount - 1 do
    with FPropList^[I] do SetFloatProp(Instance, PropInfo, Value);
  Modified;
end;

procedure TPropertyEditor.SetMethodValue(const Value: TMethod);
var
  I: Integer;
begin
  for I := 0 to FPropCount - 1 do
    with FPropList^[I] do SetMethodProp(Instance, PropInfo, Value);
  Modified;
end;

procedure TPropertyEditor.SetOrdValue(Value: Longint);
var
  I: Integer;
begin
  for I := 0 to FPropCount - 1 do
    with FPropList^[I] do SetOrdProp(Instance, PropInfo, Value);
  Modified;
end;

procedure TPropertyEditor.SetPropEntry(Index: Integer;
  AInstance: TComponent; APropInfo: PPropInfo);
begin
  with FPropList^[Index] do
  begin
    Instance := AInstance;
    PropInfo := APropInfo;
  end;
end;

procedure TPropertyEditor.SetStrValue(const Value: string);
var
  I: Integer;
begin
  for I := 0 to FPropCount - 1 do
    with FPropList^[I] do SetStrProp(Instance, PropInfo, Value);
  Modified;
end;

procedure TPropertyEditor.SetValue(const Value: string);
begin
end;

{ TOrdinalProperty }

function TOrdinalProperty.AllEqual: Boolean;
var
  I: Integer;
  V: Longint;
begin
  Result := False;
  if PropCount > 1 then
  begin
    V := GetOrdValue;
    for I := 1 to PropCount - 1 do
      if GetOrdValueAt(I) <> V then Exit;
  end;
  Result := True;
end;

function TOrdinalProperty.GetEditLimit: Integer;
begin
  Result := 64;
end;

{ TIntegerProperty }

function TIntegerProperty.GetValue: string;
begin
  Result := IntToStr(GetOrdValue);
end;

procedure TIntegerProperty.SetValue(const Value: String);
var
  E: Integer;
  L: Longint;
begin
  L := StrToInt(Value);
  with GetTypeData(GetPropType)^ do
    if (L < MinValue) or (L > MaxValue) then
      raise EPropertyError.Create(
        FmtLoadStr(SOutOfRange, [MinValue, MaxValue]));
  SetOrdValue(L);
end;

{ TCharProperty }

function TCharProperty.GetValue: string;
var
  Ch: Char;
begin
  Ch := Chr(GetOrdValue);
  if Ch in [#33..#127] then
    Result := Ch else
    FmtStr(Result, '#%d', [Ord(Ch)]);
end;

procedure TCharProperty.SetValue(const Value: string);
var
  E: Integer;
  L: Longint;
begin
  if Length(Value) = 0 then L := 0 else
    if Length(Value) = 1 then L := Ord(Value[1]) else
      if Value[1] = '#' then L := StrToInt(Copy(Value, 2, 255)) else
        raise EPropertyError.Create(LoadStr(SInvalidPropertyValue));
  with GetTypeData(GetPropType)^ do
    if (L < MinValue) or (L > MaxValue) then
      raise EPropertyError.Create(
        FmtLoadStr(SOutOfRange, [MinValue, MaxValue]));
  SetOrdValue(L);
end;

{ TEnumProperty }

function TEnumProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList];
end;

function TEnumProperty.GetValue: string;
begin
  Result := GetEnumName(GetPropType, GetOrdValue)^;
end;

procedure TEnumProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  EnumType: PTypeInfo;
begin
  EnumType := GetPropType;
  with GetTypeData(EnumType)^ do
    for I := MinValue to MaxValue do Proc(GetEnumName(EnumType, I)^);
end;

procedure TEnumProperty.SetValue(const Value: string);
var
  I: Integer;
  EnumType: PTypeInfo;
begin
  EnumType := GetPropType;
  with GetTypeData(EnumType)^ do
    for I := MinValue to MaxValue do
      if CompareText(GetEnumName(EnumType, I)^, Value) = 0 then
      begin
        SetOrdValue(I);
        Exit;
      end;
  raise EPropertyError.Create(LoadStr(SInvalidPropertyValue));
end;

{ TFloatProperty }

function TFloatProperty.AllEqual: Boolean;
var
  I: Integer;
  V: Extended;
begin
  Result := False;
  if PropCount > 1 then
  begin
    V := GetFloatValue;
    for I := 1 to PropCount - 1 do
      if GetFloatValueAt(I) <> V then Exit;
  end;
  Result := True;
end;

function TFloatProperty.GetValue: string;
const
  Precisions: array[TFloatType] of Integer = (7, 15, 18, 18);
begin
  Result := FloatToStrF(GetFloatValue, ffGeneral,
    Precisions[GetTypeData(GetPropType)^.FloatType], 0);
end;

procedure TFloatProperty.SetValue(const Value: string);
begin
  SetFloatValue(StrToFloat(Value));
end;

{ TStringProperty }

function TStringProperty.AllEqual: Boolean;
var
  I: Integer;
  V: string;
begin
  Result := False;
  if PropCount > 1 then
  begin
    V := GetStrValue;
    for I := 1 to PropCount - 1 do
      if GetStrValueAt(I) <> V then Exit;
  end;
  Result := True;
end;

function TStringProperty.GetEditLimit: Integer;
begin
  Result := GetTypeData(GetPropType)^.MaxLength;
end;

function TStringProperty.GetValue: string;
begin
  Result := GetStrValue;
end;

procedure TStringProperty.SetValue(const Value: string);
begin
  SetStrValue(Value);
end;

{ TComponentNameProperty }

function TComponentNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [];
end;

{ TSetElementProperty }

constructor TSetElementProperty.Create(ADesigner: TFormDesigner;
  APropList: PInstPropList; APropCount: Integer; AElement: Integer);
begin
  FDesigner := ADesigner;
  FPropList := APropList;
  FPropCount := APropCount;
  FElement := AElement;
end;

destructor TSetElementProperty.Destroy;
begin
end;

function TSetElementProperty.AllEqual: Boolean;
var
  I: Integer;
  W: Cardinal;
  V: Boolean;
begin
  Result := False;
  if PropCount > 1 then
  begin
    W := GetOrdValue;
    V := FElement in TCardinalSet(W);
    for I := 1 to PropCount - 1 do
    begin
      W := GetOrdValueAt(I);
      if (FElement in TCardinalSet(W)) <> V then Exit;
    end;
  end;
  Result := True;
end;

function TSetElementProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList];
end;

function TSetElementProperty.GetName: string;
begin
  Result := GetEnumName(GetTypeData(GetPropType)^.CompType, FElement)^;
end;

function TSetElementProperty.GetValue: string;
var
  W: Cardinal;
begin
  W := GetOrdValue;
  if FElement in TCardinalSet(W) then Result := 'True' else Result := 'False';
end;

procedure TSetElementProperty.GetValues(Proc: TGetStrProc);
begin
  Proc('False');
  Proc('True');
end;

procedure TSetElementProperty.SetValue(const Value: string);
var
  W: Cardinal;
begin
  W := GetOrdValue;
  if CompareText(Value, 'True') = 0 then
    Include(TCardinalSet(W), FElement)
  else
    Exclude(TCardinalSet(W), FElement);
  SetOrdValue(W);
end;

{ TSetProperty }

function TSetProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paSubProperties, paReadOnly];
end;

procedure TSetProperty.GetProperties(Proc: TGetPropEditProc);
var
  I: Integer;
begin
  with GetTypeData(GetTypeData(GetPropType)^.CompType)^ do
    for I := MinValue to MaxValue do
      Proc(TSetElementProperty.Create(FDesigner, FPropList, FPropCount, I));
end;

function TSetProperty.GetValue: string;
var
  W: Cardinal;
  TypeInfo: PTypeInfo;
  I: Integer;
begin
  W := GetOrdValue;
  TypeInfo := GetTypeData(GetPropType)^.CompType;
  Result := '[';
  for I := 0 to 15 do
    if I in TCardinalSet(W) then
    begin
      if Length(Result) <> 1 then Result := Result + ',';
      Result := Result + GetEnumName(TypeInfo, I)^;
    end;
  Result := Result + ']';
end;

{ TClassProperty }

function TClassProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paSubProperties, paReadOnly];
end;

procedure TClassProperty.GetProperties(Proc: TGetPropEditProc);
var
  I: Integer;
  Components: TComponentList;
begin
  Components := TComponentList.Create;
  try
    for I := 0 to PropCount - 1 do
      Components.Add(TComponent(GetOrdValueAt(I)));
    GetComponentProperties(Components, tkProperties, Designer, Proc);
  finally
    Components.Free;
  end;
end;

function TClassProperty.GetValue: string;
begin
  FmtStr(Result, '(%s)', [GetPropType^.Name]);
end;

{ TComponentProperty }

function TComponentProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList];
end;

function TComponentProperty.GetEditLimit: Integer;
begin
  Result := 64;
end;

function TComponentProperty.GetValue: string;
var
  Component: TComponent;
begin
  Component := TComponent(GetOrdValue);
  if Component = nil then Result := '' else Result := Component.Name;
end;

procedure TComponentProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Component: TComponent;
  PropClass: TClass;
begin
  PropClass := GetTypeData(GetPropType)^.ClassType;
  for I := 0 to Designer.Form.ComponentCount - 1 do
  begin
    Component := Designer.Form.Components[I];
    if (Component is PropClass) and (Component.Name <> '') then
      Proc(Component.Name);
  end;
end;

procedure TComponentProperty.SetValue(const Value: string);
var
  Component: TComponent;
begin
  if Value = '' then Component := nil else
  begin
    Component := Designer.Form.FindComponent(Value);
    if not (Component is GetTypeData(GetPropType)^.ClassType) then
      raise EPropertyError.Create(LoadStr(SInvalidPropertyValue));
  end;
  SetOrdValue(Longint(Component));
end;

{ TMethodProperty }

function TMethodProperty.AllEqual: Boolean;
var
  I: Integer;
  V, T: TMethod;
begin
  Result := False;
  if PropCount > 1 then
  begin
    V := GetMethodValue;
    for I := 1 to PropCount - 1 do
    begin
      T := GetMethodValueAt(I);
      if (T.Code <> V.Code) or (T.Data <> V.Data) then Exit;
    end;
  end;
  Result := True;
end;

procedure TMethodProperty.Edit;
var
  FormMethodName, EventName: string[63];
begin
  FormMethodName := GetValue;
  if FormMethodName = '' then
  begin
    if GetComponent(0) = Designer.Form then
      FormMethodName := 'Form' else
      FormMethodName := GetComponent(0).Name;
    if FormMethodName = '' then
      raise EPropertyError.Create(LoadStr(SCannotCreateName));
    EventName := GetName;
    if CompareText(Copy(EventName, 1, 2), 'ON') = 0 then
      EventName := Copy(EventName, 3, 255);
    FormMethodName := FormMethodName + EventName;
    SetMethodValue(Designer.CreateMethod(FormMethodName,
      GetTypeData(GetPropType)));
  end;
  Designer.ShowMethod(FormMethodName);
end;

function TMethodProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList];
end;

function TMethodProperty.GetEditLimit: Integer;
begin
  Result := 64;
end;

function TMethodProperty.GetValue: string;
begin
  Result := Designer.GetMethodName(GetMethodValue);
end;

procedure TMethodProperty.GetValues(Proc: TGetStrProc);
begin
  Designer.GetMethods(GetTypeData(GetPropType), Proc);
end;

procedure TMethodProperty.SetValue(const AValue: string);
var
  NewMethod: Boolean;
  CurValue: string[63];
begin
  CurValue:= GetValue;
  if (CurValue <> '') and (AValue <> '') and
    ((CompareText(CurValue, AValue) = 0) or
    not Designer.MethodExists(AValue)) then
    Designer.RenameMethod(CurValue, AValue)
  else
  begin
    NewMethod := (AValue <> '') and not Designer.MethodExists(AValue);
    SetMethodValue(Designer.CreateMethod(AValue, GetTypeData(GetPropType)));
    if NewMethod then Designer.ShowMethod(AValue);
  end;
end;

{ TFontNameProperty }

function TFontNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList];
end;

procedure TFontNameProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  for I := 0 to Screen.Fonts.Count - 1 do Proc(Screen.Fonts[I]);
end;


{ TMPFilenameProperty }

procedure TMPFilenameProperty.Edit;
var
  MPFileOpen: TOpenDialog;
begin
  MPFileOpen := TOpenDialog.Create(Application);
  MPFileOpen.Filename := GetValue;
  MPFileOpen.Filter := LoadStr(SMPOpenFilter);
  MPFileOpen.HelpContext := hcDMediaPlayerOpen;
  MPFileOpen.Options := MPFileOpen.Options + [ofShowHelp, ofPathMustExist,
    ofFileMustExist];
  try
    if MPFileOpen.Execute then SetValue(MPFileOpen.Filename);
  finally
    MPFileOpen.Free;
  end;
end;

function TMPFilenameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

{ TColorProperty }

procedure TColorProperty.Edit;
var
  ColorDialog: TColorDialog;
  IniName: string;
  IniFile: TIniFile;

  procedure GetCustomColors;
  begin
    IniFile := TIniFile.Create('DELPHI.INI');
    try
      IniFile.ReadSectionValues(LoadStr(SCustomColors), ColorDialog.CustomColors);
    except
      { Ignore errors reading values }
    end;
  end;

  procedure SaveCustomColors;
  var
    I, P: Integer;
    S: string;
  begin
    if IniFile <> nil then
      with ColorDialog do
        for I := 0 to CustomColors.Count - 1 do
        begin
          S := CustomColors.Strings[I];
          P := Pos('=', S);
          if P <> 0 then
          begin
            S := Copy(S, 1, P - 1);
            IniFile.WriteString(LoadStr(SCustomColors), S, CustomColors.Values[S]);
          end;
        end;
  end;

begin
  IniFile := nil;
  ColorDialog := TColorDialog.Create(Application);
  try
    GetCustomColors;
    ColorDialog.Color := GetOrdValue;
    ColorDialog.HelpContext := hcDColorEditor;
    ColorDialog.Options := [cdShowHelp];
    if ColorDialog.Execute then SetOrdValue(ColorDialog.Color);
    SaveCustomColors;
  finally
    if IniFile <> nil then IniFile.Free;
    ColorDialog.Free;
  end;
end;

function TColorProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paDialog, paValueList];
end;

function TColorProperty.GetValue: string;
begin
  Result := ColorToString(TColor(GetOrdValue));
end;

procedure TColorProperty.GetValues(Proc: TGetStrProc);
begin
  GetColorValues(Proc);
end;

procedure TColorProperty.SetValue(const Value: string);
var
  NewValue: Longint;
begin
  if IdentToColor(Value, NewValue) then
    SetOrdValue(NewValue)
  else inherited SetValue(Value);
end;

{ TCursorProperty }

function TCursorProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList];
end;

function TCursorProperty.GetValue: string;
begin
  Result := CursorToString(TCursor(GetOrdValue));
end;

procedure TCursorProperty.GetValues(Proc: TGetStrProc);
begin
  GetCursorValues(Proc);
end;

procedure TCursorProperty.SetValue(const Value: string);
var
  NewValue: Longint;
begin
  if IdentToCursor(Value, NewValue) then
    SetOrdValue(NewValue)
  else inherited SetValue(Value);
end;

{ TFontProperty }

procedure TFontProperty.Edit;
var
  FontDialog: TFontDialog;
begin
  FontDialog := TFontDialog.Create(Application);
  try
    FontDialog.Font := TFont(GetOrdValue);
    FontDialog.HelpContext := hcDFontEditor;
    FontDialog.Options := FontDialog.Options + [fdShowHelp, fdForceFontExist];
    if FontDialog.Execute then SetOrdValue(Longint(FontDialog.Font));
  finally
    FontDialog.Free;
  end;
end;

function TFontProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
end;

{ TModalResultProperty }

const
  ModalResults: array[mrNone..mrNo] of string[8] = (
    'mrNone',
    'mrOk',
    'mrCancel',
    'mrAbort',
    'mrRetry',
    'mrIgnore',
    'mrYes',
    'mrNo');

function TModalResultProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList];
end;

function TModalResultProperty.GetValue: string;
var
  CurValue: Longint;
begin
  CurValue := GetOrdValue;
  case CurValue of
    Low(ModalResults)..High(ModalResults):
      Result := ModalResults[CurValue];
  else
    Result := IntToStr(CurValue);
  end;
end;

procedure TModalResultProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  for I := Low(ModalResults) to High(ModalResults) do Proc(ModalResults[I]);
end;

procedure TModalResultProperty.SetValue(const Value: string);
var
  I: Integer;
begin
  if Value = '' then
  begin
    SetOrdValue(0);
    Exit;
  end;
  for I := Low(ModalResults) to High(ModalResults) do
    if CompareText(ModalResults[I], Value) = 0 then
    begin
      SetOrdValue(I);
      Exit;
    end;
  inherited SetValue(Value);
end;

{ TShortCutProperty }

const
  ShortCuts: array[0..82] of TShortCut = (
    scNone,
    Byte('A') or scCtrl,
    Byte('B') or scCtrl,
    Byte('C') or scCtrl,
    Byte('D') or scCtrl,
    Byte('E') or scCtrl,
    Byte('F') or scCtrl,
    Byte('G') or scCtrl,
    Byte('H') or scCtrl,
    Byte('I') or scCtrl,
    Byte('J') or scCtrl,
    Byte('K') or scCtrl,
    Byte('L') or scCtrl,
    Byte('M') or scCtrl,
    Byte('N') or scCtrl,
    Byte('O') or scCtrl,
    Byte('P') or scCtrl,
    Byte('Q') or scCtrl,
    Byte('R') or scCtrl,
    Byte('S') or scCtrl,
    Byte('T') or scCtrl,
    Byte('U') or scCtrl,
    Byte('V') or scCtrl,
    Byte('W') or scCtrl,
    Byte('X') or scCtrl,
    Byte('Y') or scCtrl,
    Byte('Z') or scCtrl,
    VK_F1,
    VK_F2,
    VK_F3,
    VK_F4,
    VK_F5,
    VK_F6,
    VK_F7,
    VK_F8,
    VK_F9,
    VK_F10,
    VK_F11,
    VK_F12,
    VK_F1 or scCtrl,
    VK_F2 or scCtrl,
    VK_F3 or scCtrl,
    VK_F4 or scCtrl,
    VK_F5 or scCtrl,
    VK_F6 or scCtrl,
    VK_F7 or scCtrl,
    VK_F8 or scCtrl,
    VK_F9 or scCtrl,
    VK_F10 or scCtrl,
    VK_F11 or scCtrl,
    VK_F12 or scCtrl,
    VK_F1 or scShift,
    VK_F2 or scShift,
    VK_F3 or scShift,
    VK_F4 or scShift,
    VK_F5 or scShift,
    VK_F6 or scShift,
    VK_F7 or scShift,
    VK_F8 or scShift,
    VK_F9 or scShift,
    VK_F10 or scShift,
    VK_F11 or scShift,
    VK_F12 or scShift,
    VK_F1 or scShift or scCtrl,
    VK_F2 or scShift or scCtrl,
    VK_F3 or scShift or scCtrl,
    VK_F4 or scShift or scCtrl,
    VK_F5 or scShift or scCtrl,
    VK_F6 or scShift or scCtrl,
    VK_F7 or scShift or scCtrl,
    VK_F8 or scShift or scCtrl,
    VK_F9 or scShift or scCtrl,
    VK_F10 or scShift or scCtrl,
    VK_F11 or scShift or scCtrl,
    VK_F12 or scShift or scCtrl,
    VK_INSERT,
    VK_INSERT or scShift,
    VK_INSERT or scCtrl,
    VK_DELETE,
    VK_DELETE or scShift,
    VK_DELETE or scCtrl,
    VK_BACK or scAlt,
    VK_BACK or scShift or scAlt);

function TShortCutProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList];
end;

function TShortCutProperty.GetValue: string;
var
  CurValue: TShortCut;
begin
  CurValue := GetOrdValue;
  if CurValue = scNone then
    Result := LoadStr(srNone) else
    Result := ShortCutToText(CurValue);
end;

procedure TShortCutProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  Proc(LoadStr(srNone));
  for I := 1 to High(ShortCuts) do Proc(ShortCutToText(ShortCuts[I]));
end;

procedure TShortCutProperty.SetValue(const Value: string);
var
  NewValue: TShortCut;
begin
  NewValue := 0;
  if (Value <> '') and (CompareText(Value, LoadStr(srNone)) <> 0) then
  begin
    NewValue := TextToShortCut(Value);
    if NewValue = 0 then
      raise EPropertyError.Create(LoadStr(SInvalidPropertyValue));
  end;
  SetOrdValue(NewValue);
end;

{ TTabOrderProperty }

function TTabOrderProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [];
end;

{ TCaptionProperty }

function TCaptionProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paAutoUpdate];
end;

{ TPropInfoList }

type
  TPropInfoList = class
  private
    FList: PPropList;
    FCount: Integer;
    FSize: Integer;
    function Get(Index: Integer): PPropInfo;
  public
    constructor Create(Component: TComponent; Filter: TTypeKinds);
    destructor Destroy; override;
    function Contains(P: PPropInfo): Boolean;
    procedure Delete(Index: Integer);
    procedure Intersect(List: TPropInfoList);
    property Count: Integer read FCount;
    property Items[Index: Integer]: PPropInfo read Get; default;
  end;

constructor TPropInfoList.Create(Component: TComponent; Filter: TTypeKinds);
begin
  FCount := GetPropList(Component.ClassInfo, Filter, nil);
  FSize := FCount * SizeOf(Pointer);
  GetMem(FList, FSize);
  GetPropList(Component.ClassInfo, Filter, FList);
end;

destructor TPropInfoList.Destroy;
begin
  if FList <> nil then FreeMem(FList, FSize);
end;

function TPropInfoList.Contains(P: PPropInfo): Boolean;
var
  I: Integer;
begin
  for I := 0 to FCount - 1 do
    with FList^[I]^ do
      if (PropType = P^.PropType) and (CompareText(Name, P^.Name) = 0) then
      begin
        Result := True;
        Exit;
      end;
  Result := False;
end;

procedure TPropInfoList.Delete(Index: Integer);
begin
  Dec(FCount);
  if Index < FCount then
    Move(FList^[Index + 1], FList^[Index],
      (FCount - Index) * SizeOf(Pointer));
end;

function TPropInfoList.Get(Index: Integer): PPropInfo;
begin
  Result := FList^[Index];
end;

procedure TPropInfoList.Intersect(List: TPropInfoList);
var
  I: Integer;
begin
  for I := FCount - 1 downto 0 do
    if not List.Contains(FList^[I]) then Delete(I);
end;

{ GetComponentProperties }

procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  const PropertyName: string; EditorClass: TPropertyEditorClass);
var
  P: PPropertyClassRec;
begin
  New(P);
  P^.Next := PropertyClassList;
  P^.PropertyType := PropertyType;
  P^.ComponentClass := ComponentClass;
  P^.PropertyName := NewStr('');
  if Assigned(ComponentClass) then P^.PropertyName := NewStr(PropertyName);
  P^.EditorClass := EditorClass;
  PropertyClassList := P;
end;

function GetEditorClass(PropInfo: PPropInfo;
  ComponentClass: TClass): TPropertyEditorClass;
var
  PropType: PTypeInfo;
  P, C: PPropertyClassRec;
begin
  PropType := PropInfo^.PropType;
  P := PropertyClassList;
  C := nil;
  while P <> nil do
  begin
    if ((P^.PropertyType = PropType) or ((PropType^.Kind = tkClass) and
      (P^.PropertyType^.Kind = tkClass) and
      GetTypeData(PropType)^.ClassType.InheritsFrom(GetTypeData(P^.PropertyType)^.ClassType))) and
      ((P^.ComponentClass = nil) or (ComponentClass.InheritsFrom(P^.ComponentClass))) and
      ((P^.PropertyName^ = '') or (CompareText(PropInfo^.Name, P^.PropertyName^) = 0)) then
      if (C = nil) or ((C^.ComponentClass = nil) and (P^.ComponentClass <> nil))
        or ((C^.PropertyName^ = '') and (P^.PropertyName^ <> '')) then C := P;
    P := P^.Next;
  end;
  if C <> nil then
    Result := C^.EditorClass else
    Result := PropClassMap[PropType^.Kind];
end;

procedure GetComponentProperties(Components: TComponentList;
  Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);
var
  I, J, CompCount: Integer;
  CompType: TClass;
  Candidates: TPropInfoList;
  PropLists: TList;
  Editor: TPropertyEditor;
  PropInfo: PPropInfo;
  AddEditor: Boolean;
begin
  if (Components = nil) or (Components.Count = 0) then Exit;
  CompCount := Components.Count;
  CompType := Components[0].ClassType;
  Candidates := TPropInfoList.Create(Components[0], Filter);
  try
    for I := Candidates.Count - 1 downto 0 do
    begin
      PropInfo := Candidates[I];
      Editor := GetEditorClass(PropInfo, CompType).Create(Designer, 1);
      try
        Editor.SetPropEntry(0, Components[0], PropInfo);
        Editor.Initialize;
        with PropInfo^ do
          if (GetProc = nil) or ((PropType^.Kind <> tkClass) and
            (SetProc = nil)) or ((CompCount > 1) and
            not (paMultiSelect in Editor.GetAttributes)) then
            Candidates.Delete(I);
      finally
        Editor.Free;
      end;
    end;
    PropLists := TList.Create;
    try
      PropLists.Capacity := CompCount;
      for I := 0 to CompCount - 1 do
        PropLists.Add(TPropInfoList.Create(Components[I], Filter));
      for I := 0 to CompCount - 1 do
        Candidates.Intersect(TPropInfoList(PropLists[I]));
      for I := 0 to CompCount - 1 do
        TPropInfoList(PropLists[I]).Intersect(Candidates);
      for I := 0 to Candidates.Count - 1 do
      begin
        Editor := GetEditorClass(Candidates[I],
          CompType).Create(Designer, CompCount);
        try
          AddEditor := True;
          for J := 0 to CompCount - 1 do
          begin
            if (Components[J].ClassType <> CompType) and
              (GetEditorClass(TPropInfoList(PropLists[J])[I],
                Components[J].ClassType) <> Editor.ClassType) then
            begin
              AddEditor := False;
              Break;
            end;
            Editor.SetPropEntry(J, Components[J],
              TPropInfoList(PropLists[J])[I]);
          end;
        except
          Editor.Free;
          raise;
        end;
        if AddEditor then
        begin
          Editor.Initialize;
          Proc(Editor);
        end
        else Editor.Free;
      end;
    finally
      for I := 0 to PropLists.Count - 1 do TPropInfoList(PropLists[I]).Free;
      PropLists.Free;
    end;
  finally
    Candidates.Free;
  end;
end;

{ RegisterComponentEditor }

type
  PComponentClassRec = ^TComponentClassRec;
  TComponentClassRec = record
    Next: PComponentClassRec;
    ComponentClass: TComponentClass;
    EditorClass: TComponentEditorClass;
  end;

const
  ComponentClassList: PComponentClassRec = nil;

procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  ComponentEditor: TComponentEditorClass);
var
  P: PComponentClassRec;
begin
  New(P);
  P^.Next := ComponentClassList;
  P^.ComponentClass := ComponentClass;
  P^.EditorClass := ComponentEditor;
  ComponentClassList := P;
end;

{ GetComponentEditor }

function GetComponentEditor(Component: TComponent;
  Designer: TFormDesigner): TComponentEditor;
var
  P: PComponentClassRec;
  ComponentClass: TComponentClass;
  EditorClass: TComponentEditorClass;
begin
  P := ComponentClassList;
  ComponentClass := TComponent;
  EditorClass := TDefaultEditor;
  while P <> nil do
  begin
    if (Component is P^.ComponentClass) and
      (P^.ComponentClass.InheritsFrom(ComponentClass)) then
    begin
      EditorClass := P^.EditorClass;
      ComponentClass := P^.ComponentClass;
    end;
    P := P^.Next;
  end;
  Result := EditorClass.Create(Component, Designer);
end;

{ TComponentEditor }

constructor TComponentEditor.Create(AComponent: TComponent; ADesigner: TFormDesigner);
begin
  inherited Create;
  FComponent := AComponent;
  FDesigner := ADesigner;
end;

procedure TComponentEditor.Edit;
begin
  if GetVerbCount > 0 then ExecuteVerb(0);
end;

function TComponentEditor.GetVerbCount: Integer;
begin
  Result := 0;
end;

function TComponentEditor.GetVerb(Index: Integer): string;
begin
end;

procedure TComponentEditor.ExecuteVerb(Index: Integer);
begin
end;

procedure TComponentEditor.Copy;
begin
end;

{ TDefaultEditor }

procedure TDefaultEditor.CheckEdit(PropertyEditor: TPropertyEditor);
var
  FreeEditor: Boolean;
begin
  FreeEditor := True;
  try
    if FContinue then EditProperty(PropertyEditor, FContinue, FreeEditor);
  finally
    if FreeEditor then PropertyEditor.Free;
  end;
end;

procedure TDefaultEditor.EditProperty(PropertyEditor: TPropertyEditor;
  var Continue, FreeEditor: Boolean);

  procedure ReplaceBest;
  begin
    FBest.Free;
    FBest := PropertyEditor;
    if FFirst = FBest then FFirst := nil;
    FreeEditor := False;
  end;

var
  PropName: string[64];
  BestName: string[64];
begin
  if not Assigned(FFirst) and (PropertyEditor is TMethodProperty) then
  begin
    FreeEditor := False;
    FFirst := PropertyEditor;
  end;
  PropName := PropertyEditor.GetName;
  BestName := '';
  if Assigned(FBest) then BestName := FBest.GetName;
  if CompareText(PropName, 'ONCREATE') = 0 then
    ReplaceBest
  else if CompareText(BestName, 'ONCREATE') <> 0 then
    if CompareText(PropName, 'ONCHANGE') = 0 then
      ReplaceBest
    else if CompareText(BestName, 'ONCHANGE') <> 0 then
      if CompareText(PropName, 'ONCLICK') = 0 then
        ReplaceBest;
end;

procedure TDefaultEditor.Edit;
var
  Components: TComponentList;
begin
  Components := TComponentList.Create;
  try
    FContinue := True;
    Components.Add(Component);
    FFirst := nil;
    FBest := nil;
    try
      GetComponentProperties(Components, tkAny, Designer, CheckEdit);
      if FContinue then
        if Assigned(FBest) then
          FBest.Edit
        else if Assigned(FFirst) then
          FFirst.Edit;
    finally
      FFirst.Free;
      FBest.Free;
    end;
  finally
    Components.Free;
  end;
end;

end.

