home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1996 August / VPR9608A.BIN / del20try / install / data.z / DSGNINTF.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-08  |  63KB  |  2,087 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DsgnIntf;
  11.  
  12. interface
  13.  
  14. {$N+,S-,R-}
  15.  
  16. uses SysUtils, Classes, Graphics, Controls, Forms, TypInfo;
  17.  
  18. type
  19.  
  20. { TComponentList }
  21.  
  22.   TComponentList = class(TObject)
  23.   private
  24.     FList: TList;
  25.     function Get(Index: Integer): TComponent;
  26.     function GetCount: Integer;
  27.   public
  28.     constructor Create;
  29.     destructor Destroy; override;
  30.     function Add(Item: TComponent): Integer;
  31.     function Equals(List: TComponentList): Boolean;
  32.     property Count: Integer read GetCount;
  33.     property Items[Index: Integer]: TComponent read Get; default;
  34.   end;
  35.  
  36. { TFormDesigner }
  37.  
  38.   TFormDesigner = class(TDesigner)
  39.   public
  40.     function CreateMethod(const Name: string; TypeData: PTypeData): TMethod; virtual; abstract;
  41.     function GetMethodName(const Method: TMethod): string; virtual; abstract;
  42.     procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc); virtual; abstract;
  43.     function GetPrivateDirectory: string; virtual; abstract;
  44.     procedure GetSelections(List: TComponentList); virtual; abstract;
  45.     function MethodExists(const Name: string): Boolean; virtual; abstract;
  46.     procedure RenameMethod(const CurName, NewName: string); virtual; abstract;
  47.     procedure SelectComponent(Component: TComponent); virtual; abstract;
  48.     procedure SetSelections(List: TComponentList); virtual; abstract;
  49.     procedure ShowMethod(const Name: string); virtual; abstract;
  50.     function UniqueName(const BaseName: string): string; virtual; abstract;
  51.     procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc); virtual; abstract;
  52.     function GetComponent(const Name: string): TComponent; virtual; abstract;
  53.     function GetComponentName(Component: TComponent): string; virtual; abstract;
  54.     function MethodFromAncestor(const Method: TMethod): Boolean; virtual; abstract;
  55.     function CreateComponent(ComponentClass: TComponentClass; Parent: TComponent;
  56.       Left, Top, Width, Height: Integer): TComponent; virtual; abstract;
  57.     function IsComponentLinkable(Component: TComponent): Boolean; virtual; abstract;
  58.     procedure MakeComponentLinkable(Component: TComponent); virtual; abstract;
  59.     function GetRoot: TComponent; virtual; abstract;
  60.     procedure Revert(Instance: TPersistent; PropInfo: PPropInfo); virtual; abstract;
  61.   end;
  62.  
  63. { TPropertyEditor
  64.   Edits a property of a component, or list of components, selected into the
  65.   Object Inspector.  The property editor is created based on the type of the
  66.   property being edited as determined by the types registered by
  67.   RegisterPropertyEditor.  The Object Inspector uses the a TPropertyEditor
  68.   for all modification to a property. GetName and GetValue are called to display
  69.   the name and value of the property.  SetValue is called whenever the user
  70.   requests to change the value.  Edit is called when the user double-clicks the
  71.   property in the Object Inspector. GetValues is called when the drop-down
  72.   list of a property is displayed.  GetProperties is called when the property
  73.   is expanded to show sub-properties.  AllEqual is called to decide whether or
  74.   not to display the value of the property when more than one component is
  75.   selected.
  76.  
  77.   The following are methods that can be overriden to change the behavior of
  78.   the property editor:
  79.  
  80.     Activate
  81.       Called whenever the property becomes selected in the object inspector.
  82.       This is potientially useful to allow certian property attributes to
  83.       to only be determined whenever the property is selected in the object
  84.       inspector. Only paSubProperties and paMultiSelect, returned from
  85.       GetAttributes, need to be accurate before this method is called.
  86.     AllEqual
  87.       Called whenever there are more than one components selected.  If this
  88.       method returns true, GetValue is called, otherwise blank is displayed
  89.       in the Object Inspector.  This is called only when GetAttributes
  90.       returns paMultiSelect.
  91.     Edit
  92.       Called when the '...' button is pressed or the property is double-clicked.
  93.       This can, for example, bring up a dialog to allow the editing the
  94.       component in some more meaningful fashion than by text (e.g. the Font
  95.       property).
  96.     GetAttributes
  97.       Returns the information for use in the Object Inspector to be able to
  98.       show the approprate tools.  GetAttributes return a set of type
  99.       TPropertyAttributes:
  100.         paValueList:     The property editor can return an enumerated list of
  101.                          values for the property.  If GetValues calls Proc
  102.                          with values then this attribute should be set.  This
  103.                          will cause the drop-down button to appear to the right
  104.                          of the property in the Object Inspector.
  105.         paSortList:      Object Inspector to sort the list returned by
  106.                          GetValues.
  107.         paSubProperties: The property editor has sub-properties that will be
  108.                          displayed indented and below the current property in
  109.                          standard outline format. If GetProperties will
  110.                          generate property objects then this attribute should
  111.                          be set.
  112.         paDialog:        Indicates that the Edit method will bring up a
  113.                          dialog.  This will cause the '...' button to be
  114.                          displayed to the right of the property in the Object
  115.                          Inspector.
  116.         paMultiSelect:   Allows the property to be displayed when more than
  117.                          one component is selected.  Some properties are not
  118.                          approprate for multi-selection (e.g. the Name
  119.                          property).
  120.         paAutoUpdate:    Causes the SetValue method to be called on each
  121.                          change made to the editor instead of after the change
  122.                          has been approved (e.g. the Caption property).
  123.         paReadOnly:      Value is not allowed to change.
  124.         paRevertable:    Allows the property to be reverted to the original
  125.                          value.  Things that shouldn't be reverted are nested
  126.                          properties (e.g. Fonts) and elements of a composite
  127.                          property such as set element values.
  128.     GetComponent
  129.       Returns the Index'th component being edited by this property editor.  This
  130.       is used to retieve the components.  A property editor can only refer to
  131.       multiple components when paMultiSelect is returned from GetAttributes.
  132.     GetEditLimit
  133.       Returns the number of character the user is allowed to enter for the
  134.       value.  The inplace editor of the object inspector will be have its
  135.       text limited set to the return value.  By default this limit is 255.
  136.     GetName
  137.       Returns a the name of the property.  By default the value is retrieved
  138.       from the type information with all underbars replaced by spaces.  This
  139.       should only be overriden if the name of the property is not the name
  140.       that should appear in the Object Inspector.
  141.     GetProperties
  142.       Should be overriden to call PropertyProc for every sub-property (or nested
  143.       property) of the property begin edited and passing a new TPropertyEdtior
  144.       for each sub-property.  By default, PropertyProc is not called and no
  145.       sub-properties are assumed.  TClassProperty will pass a new property
  146.       editor for each published property in a class.  TSetProperty passes a
  147.       new editor for each element in the set.
  148.     GetPropType
  149.       Returns the type information pointer for the propertie(s) being edited.
  150.     GetValue
  151.       Returns the string value of the property. By default this returns
  152.       '(unknown)'.  This should be overriden to return the appropriate value.
  153.     GetValues
  154.       Called when paValueList is returned in GetAttributes.  Should call Proc
  155.       for every value that is acceptable for this property.  TEnumProperty
  156.       will pass every element in the enumeration.
  157.     Initialize
  158.       Called after the property editor has been created but before it is used.
  159.       Many times property editors are created and because they are not a common
  160.       property across the entire selection they are thrown away.  Initialize is
  161.       called after it is determined the property editor is going to be used by
  162.       the object inspector and not just thrown away.
  163.     SetValue(Value)
  164.       Called to set the value of the property.  The property editor should be
  165.       able to translate the string and call one of the SetXxxValue methods. If
  166.       the string is not in the correct format or not an allowed value, the
  167.       property editor should generate an exception describing the problem. Set
  168.       value can ignore all changes and allow all editing of the property be
  169.       accomplished through the Edit method (e.g. the Picture property).
  170.  
  171.   Properties and methods useful in creating a new TPropertyEditor classes:
  172.  
  173.     Name property
  174.       Returns the name of the property returned by GetName
  175.     PrivateDirectory property
  176.       It is either the .EXE or the "working directory" as specified in
  177.       DELPHI32.INI.  If the property editor needs auxilury or state files
  178.       (templates, examples, etc) they should be stored in this directory.
  179.     Properties indexed property
  180.       The TProperty objects representing all the components being edited
  181.       by the property editor.  If more than one component is selected, one
  182.       TProperty object is created for each component.  Typically, it is not
  183.       necessary to use this array since the Get/SetXxxValue methods will
  184.       propagate the values appropriatly.
  185.     Value property
  186.       The current value, as a string, of the property as returned by GetValue.
  187.     Modified
  188.       Called to indicate the value of the property has been modified.  Called
  189.       automatically by the SetXxxValue methods.  If you call a TProperty
  190.       SetXxxValue method directly, you *must* call Modified as well.
  191.     GetXxxValue
  192.       Gets the value of the first property in the Properties property.  Calls
  193.       the appropriate TProperty GetXxxValue method to retrieve the value.
  194.     SetXxxValue
  195.       Sets the value of all the properties in the Properties property.  Calls
  196.       the approprate TProperty SetXxxxValue methods to set the value. }
  197.  
  198.   TPropertyAttribute = (paValueList, paSubProperties, paDialog,
  199.     paMultiSelect, paAutoUpdate, paSortList, paReadOnly, paRevertable);
  200.   TPropertyAttributes = set of TPropertyAttribute;
  201.  
  202.   TPropertyEditor = class;
  203.  
  204.   TInstProp = record
  205.     Instance: TComponent;
  206.     PropInfo: PPropInfo;
  207.   end;
  208.  
  209.   PInstPropList = ^TInstPropList;
  210.   TInstPropList = array[0..1023] of TInstProp;
  211.  
  212.   TGetPropEditProc = procedure(Prop: TPropertyEditor) of object;
  213.  
  214.   TPropertyEditor = class
  215.   private
  216.     FDesigner: TFormDesigner;
  217.     FPropList: PInstPropList;
  218.     FPropCount: Integer;
  219.     constructor Create(ADesigner: TFormDesigner; APropCount: Integer);
  220.     function GetPrivateDirectory: string;
  221.     procedure SetPropEntry(Index: Integer; AInstance: TComponent;
  222.       APropInfo: PPropInfo);
  223.   protected
  224.     function GetPropInfo: PPropInfo;
  225.     function GetFloatValue: Extended;
  226.     function GetFloatValueAt(Index: Integer): Extended;
  227.     function GetMethodValue: TMethod;
  228.     function GetMethodValueAt(Index: Integer): TMethod;
  229.     function GetOrdValue: Longint;
  230.     function GetOrdValueAt(Index: Integer): Longint;
  231.     function GetStrValue: string;
  232.     function GetStrValueAt(Index: Integer): string;
  233.     function GetVarValue: Variant;
  234.     function GetVarValueAt(Index: Integer): Variant;
  235.     procedure Modified;
  236.     procedure SetFloatValue(Value: Extended);
  237.     procedure SetMethodValue(const Value: TMethod);
  238.     procedure SetOrdValue(Value: Longint);
  239.     procedure SetStrValue(const Value: string);
  240.     procedure SetVarValue(const Value: Variant);
  241.   public
  242.     destructor Destroy; override;
  243.     procedure Activate; virtual;
  244.     function AllEqual: Boolean; virtual;
  245.     procedure Edit; virtual;
  246.     function GetAttributes: TPropertyAttributes; virtual;
  247.     function GetComponent(Index: Integer): TComponent;
  248.     function GetEditLimit: Integer; virtual;
  249.     function GetName: string; virtual;
  250.     procedure GetProperties(Proc: TGetPropEditProc); virtual;
  251.     function GetPropType: PTypeInfo;
  252.     function GetValue: string; virtual;
  253.     procedure GetValues(Proc: TGetStrProc); virtual;
  254.     procedure Initialize; virtual;
  255.     procedure Revert;
  256.     procedure SetValue(const Value: string); virtual;
  257.     function ValueAvailable: Boolean;
  258.     property Designer: TFormDesigner read FDesigner;
  259.     property PrivateDirectory: string read GetPrivateDirectory;
  260.     property PropCount: Integer read FPropCount;
  261.     property Value: string read GetValue write SetValue;
  262.   end;
  263.  
  264.   TPropertyEditorClass = class of TPropertyEditor;
  265.  
  266. { TOrdinalProperty
  267.   The base class of all ordinal property editors.  It established that ordinal
  268.   properties are all equal if the GetOrdValue all return the same value. }
  269.  
  270.   TOrdinalProperty = class(TPropertyEditor)
  271.     function AllEqual: Boolean; override;
  272.     function GetEditLimit: Integer; override;
  273.   end;
  274.  
  275. { TIntegerProperty
  276.   Default editor for all Longint properties and all subtypes of the Longint
  277.   type (i.e. Integer, Word, 1..10, etc.).  Retricts the value entrered into
  278.   the property to the range of the sub-type. }
  279.  
  280.   TIntegerProperty = class(TOrdinalProperty)
  281.   public
  282.     function GetValue: string; override;
  283.     procedure SetValue(const Value: string); override;
  284.   end;
  285.  
  286. { TCharProperty
  287.   Default editor for all Char properties and sub-types of Char (i.e. Char,
  288.   'A'..'Z', etc.). }
  289.  
  290.   TCharProperty = class(TOrdinalProperty)
  291.   public
  292.     function GetValue: string; override;
  293.     procedure SetValue(const Value: string); override;
  294.   end;
  295.  
  296. { TEnumProperty
  297.   The default property editor for all enumerated properties (e.g. TShape =
  298.   (sCircle, sTriangle, sSquare), etc.). }
  299.  
  300.   TEnumProperty = class(TOrdinalProperty)
  301.   public
  302.     function GetAttributes: TPropertyAttributes; override;
  303.     function GetValue: string; override;
  304.     procedure GetValues(Proc: TGetStrProc); override;
  305.     procedure SetValue(const Value: string); override;
  306.   end;
  307.  
  308. { TFloatProperty
  309.   The default property editor for all floating point types (e.g. Float,
  310.   Single, Double, etc.) }
  311.  
  312.   TFloatProperty = class(TPropertyEditor)
  313.   public
  314.     function AllEqual: Boolean; override;
  315.     function GetValue: string; override;
  316.     procedure SetValue(const Value: string); override;
  317.   end;
  318.  
  319. { TStringProperty
  320.   The default property editor for all strings and sub types (e.g. string,
  321.   string[20], etc.). }
  322.  
  323.   TStringProperty = class(TPropertyEditor)
  324.   public
  325.     function AllEqual: Boolean; override;
  326.     function GetEditLimit: Integer; override;
  327.     function GetValue: string; override;
  328.     procedure SetValue(const Value: string); override;
  329.   end;
  330.  
  331. { TSetElementProperty
  332.   A property editor that edits an individual set element.  GetName is
  333.   changed to display the set element name instead of the property name and
  334.   Get/SetValue is changed to reflect the individual element state.  This
  335.   editor is created by the TSetProperty editor. }
  336.  
  337.   TSetElementProperty = class(TPropertyEditor)
  338.   private
  339.     FElement: Integer;
  340.     constructor Create(ADesigner: TFormDesigner; APropList: PInstPropList;
  341.       APropCount: Integer; AElement: Integer);
  342.   public
  343.     destructor Destroy; override;
  344.     function AllEqual: Boolean; override;
  345.     function GetAttributes: TPropertyAttributes; override;
  346.     function GetName: string; override;
  347.     function GetValue: string; override;
  348.     procedure GetValues(Proc: TGetStrProc); override;
  349.     procedure SetValue(const Value: string); override;
  350.    end;
  351.  
  352. { TSetProperty
  353.   Default property editor for all set properties. This editor does not edit
  354.   the set directly but will display sub-properties for each element of the
  355.   set. GetValue displays the value of the set in standard set syntax. }
  356.  
  357.   TSetProperty = class(TOrdinalProperty)
  358.   public
  359.     function GetAttributes: TPropertyAttributes; override;
  360.     procedure GetProperties(Proc: TGetPropEditProc); override;
  361.     function GetValue: string; override;
  362.   end;
  363.  
  364. { TClassProperty
  365.   Default proeperty editor for all objects.  Does not allow modifing the
  366.   property but does display the class name of the object and will allow the
  367.   editing of the object's properties as sub-properties of the property. }
  368.  
  369.   TClassProperty = class(TPropertyEditor)
  370.   public
  371.     function GetAttributes: TPropertyAttributes; override;
  372.     procedure GetProperties(Proc: TGetPropEditProc); override;
  373.     function GetValue: string; override;
  374.   end;
  375.  
  376. { TMethodProperty
  377.   Property editor for all method properties. }
  378.  
  379.   TMethodProperty = class(TPropertyEditor)
  380.   public
  381.     function AllEqual: Boolean; override;
  382.     procedure Edit; override;
  383.     function GetAttributes: TPropertyAttributes; override;
  384.     function GetEditLimit: Integer; override;
  385.     function GetValue: string; override;
  386.     procedure GetValues(Proc: TGetStrProc); override;
  387.     procedure SetValue(const AValue: string); override;
  388.   end;
  389.  
  390. { TComponentProperty
  391.   The default editor for TComponents.  It does not allow editing of the
  392.   properties of the component.  It allow the user to set the value of this
  393.   property to point to a component in the same form that is type compatible
  394.   with the property being edited (e.g. the ActiveControl property). }
  395.  
  396.   TComponentProperty = class(TPropertyEditor)
  397.   public
  398.     function GetAttributes: TPropertyAttributes; override;
  399.     function GetEditLimit: Integer; override;
  400.     function GetValue: string; override;
  401.     procedure GetValues(Proc: TGetStrProc); override;
  402.     procedure SetValue(const Value: string); override;
  403.   end;
  404.  
  405. { TComponentNameProperty
  406.   Property editor for the Name property.  It restricts the name property
  407.   from being displayed when more than one component is selected. }
  408.  
  409.   TComponentNameProperty = class(TStringProperty)
  410.   public
  411.     function GetAttributes: TPropertyAttributes; override;
  412.     function GetEditLimit: Integer; override;
  413.   end;
  414.  
  415. { TFontNameProperty
  416.   Editor for the TFont.FontName property.  Displays a drop-down list of all
  417.   the fonts known by Windows.}
  418.  
  419.   TFontNameProperty = class(TStringProperty)
  420.   public
  421.     function GetAttributes: TPropertyAttributes; override;
  422.     procedure GetValues(Proc: TGetStrProc); override;
  423.   end;
  424.  
  425. { TColorProperty
  426.   Property editor for the TColor type.  Displays the color as a clXXX value
  427.   if one exists, otherwise displays the value as hex.  Also allows the
  428.   clXXX value to be picked from a list. }
  429.  
  430.   TColorProperty = class(TIntegerProperty)
  431.   public
  432.     procedure Edit; override;
  433.     function GetAttributes: TPropertyAttributes; override;
  434.     function GetValue: string; override;
  435.     procedure GetValues(Proc: TGetStrProc); override;
  436.     procedure SetValue(const Value: string); override;
  437.   end;
  438.  
  439. { TCursorProperty
  440.   Property editor for the TCursor type.  Displays the color as a crXXX value
  441.   if one exists, otherwise displays the value as hex.  Also allows the
  442.   clXXX value to be picked from a list. }
  443.  
  444.   TCursorProperty = class(TIntegerProperty)
  445.   public
  446.     function GetAttributes: TPropertyAttributes; override;
  447.     function GetValue: string; override;
  448.     procedure GetValues(Proc: TGetStrProc); override;
  449.     procedure SetValue(const Value: string); override;
  450.   end;
  451.  
  452. { TFontProperty
  453.   Property editor the Font property.  Brings up the font dialog as well as
  454.   allowing the properties of the object to be edited. }
  455.  
  456.   TFontProperty = class(TClassProperty)
  457.   public
  458.     procedure Edit; override;
  459.     function GetAttributes: TPropertyAttributes; override;
  460.   end;
  461.  
  462. { TModalResultProperty }
  463.  
  464.   TModalResultProperty = class(TIntegerProperty)
  465.   public
  466.     function GetAttributes: TPropertyAttributes; override;
  467.     function GetValue: string; override;
  468.     procedure GetValues(Proc: TGetStrProc); override;
  469.     procedure SetValue(const Value: string); override;
  470.   end;
  471.  
  472. { TShortCutProperty
  473.   Property editor the the ShortCut property.  Allows both typing in a short
  474.   cut value or picking a short-cut value from a list. }
  475.  
  476.   TShortCutProperty = class(TOrdinalProperty)
  477.   public
  478.     function GetAttributes: TPropertyAttributes; override;
  479.     function GetValue: string; override;
  480.     procedure GetValues(Proc: TGetStrProc); override;
  481.     procedure SetValue(const Value: string); override;
  482.   end;
  483.  
  484. { TMPFilenameProperty
  485.   Property editor for the TMediaPlayer.  Displays an File Open Dialog
  486.   for the name of the media file.}
  487.  
  488.   TMPFilenameProperty = class(TStringProperty)
  489.   public
  490.     procedure Edit; override;
  491.     function GetAttributes: TPropertyAttributes; override;
  492.   end;
  493.  
  494. { TTabOrderProperty
  495.   Property editor for the TabOrder property.  Prevents the property from being
  496.   displayed when more than one component is selected. }
  497.  
  498.   TTabOrderProperty = class(TIntegerProperty)
  499.   public
  500.     function GetAttributes: TPropertyAttributes; override;
  501.   end;
  502.  
  503. { TCaptionProperty
  504.   Property editor for the Caption and Text properties.  Updates the value of
  505.   the property for each change instead on when the property is approved. }
  506.  
  507.   TCaptionProperty = class(TStringProperty)
  508.   public
  509.     function GetAttributes: TPropertyAttributes; override;
  510.   end;
  511.  
  512.   EPropertyError = class(Exception);
  513.  
  514. { TComponentEditor
  515.   A component editor is created for each component that is selected in the
  516.   form designer based on the component's type (see GetComponentEditor and
  517.   RegisterComponentEditor).  When the component is double-clicked the Edit
  518.   method is called.  When the context menu for the component is invoked the
  519.   GetVerbCount and GetVerb methods are called to build the menu.  If one
  520.   of the verbs are selected ExecuteVerb is called.  Paste is called whenever
  521.   the component is pasted to the clipboard.  You only need to create a
  522.   component editor if you wish to add verbs to the context menu, change
  523.   the default double-click behavior, or paste an additional clipboard format.
  524.   The default component editor (TDefaultEditor) implements Edit to searchs the
  525.   properties of the component and generates (or navigates to) the OnCreate,
  526.   OnChanged, or OnClick event (whichever it finds first).  Whenever the
  527.   component modifies the component is *must* call Designer.Modified to inform
  528.   the designer that the form has been modified.
  529.  
  530.     Create(AComponent, ADesigner)
  531.       Called to create the component editor.  AComponent is the component to
  532.       be edited by the editor.  ADesigner is an interface to the designer to
  533.       find controls and create methods (this is not use often).
  534.     Edit
  535.       Called when the user double-clicks the component. The component editor can
  536.       bring up a dialog in responce to this method, for example, or some kind
  537.       of design expert.  If GetVerbCount is greater than zero, edit will execute
  538.       the first verb in the list (ExecuteVerb(0)).
  539.     ExecuteVerb(Index)
  540.       The Index'ed verb was selected by the use off the context menu.  The
  541.       meaning of this is determined by component editor.
  542.     GetVerb
  543.       The component editor should return a string that will be displayed in the
  544.       context menu.  It is the responsibility of the component editor to place
  545.       the & character and the '...' characters as appropriate.
  546.     GetVerbCount
  547.       The number of valid indexs to GetVerb and Execute verb.  The index assumed
  548.       to be zero based (i.e. 0..GetVerbCount - 1).
  549.     Copy
  550.       Called when the component is being copyied to the clipboard.  The
  551.       component's filed image is already on the clipboard.  This gives the
  552.       component editor a chance to paste a different type of format which is
  553.       ignored by the designer but might be recoginized by another application. }
  554.  
  555.   TComponentEditor = class
  556.   private
  557.     FComponent: TComponent;
  558.     FDesigner: TFormDesigner;
  559.   public
  560.     constructor Create(AComponent: TComponent; ADesigner: TFormDesigner); virtual;
  561.     procedure Edit; virtual;
  562.     procedure ExecuteVerb(Index: Integer); virtual;
  563.     function GetVerb(Index: Integer): string; virtual;
  564.     function GetVerbCount: Integer; virtual;
  565.     procedure Copy; virtual;
  566.     property Component: TComponent read FComponent;
  567.     property Designer: TFormDesigner read FDesigner;
  568.   end;
  569.  
  570.   TComponentEditorClass = class of TComponentEditor;
  571.  
  572.   TDefaultEditor = class(TComponentEditor)
  573.   private
  574.     FFirst: TPropertyEditor;
  575.     FBest: TPropertyEditor;
  576.     FContinue: Boolean;
  577.     procedure CheckEdit(PropertyEditor: TPropertyEditor);
  578.   protected
  579.     procedure EditProperty(PropertyEditor: TPropertyEditor;
  580.       var Continue, FreeEditor: Boolean); virtual;
  581.   public
  582.     procedure Edit; override;
  583.   end;
  584.  
  585. { RegisterPropertyEditor
  586.   Registers a new property editor for the given type.  When a component is
  587.   selected the Object Inspector will create a property editor for each
  588.   of the component's properties.  The property editor is created based on
  589.   the type of the property.  If, for example, the property type is an
  590.   Integer, the property editor for Integer will be created (by default
  591.   that would be TIntegerProperty). Most properties do not need specialized
  592.   property editors.  For example, if the property is an ordinal type the
  593.   default property editor will restrict the range to the ordinal subtype
  594.   range (e.g. a property of type TMyRange = 1..10 will only allow values
  595.   between 1 and 10 to be entered into the property).  Enumerated types will
  596.   display a drop-down list of all the enumerated values (e.g. TShapes =
  597.   (sCircle, sSquare, sTriangle) will be edited by a drop-down list containing
  598.   only sCircle, sSquare and sTriangle).  A property editor need only be
  599.   created if default property editor or none of the existing property editors
  600.   are sufficient to edit the property.  This is typically because the
  601.   property is an object.  The properties are looked up newest to oldest.
  602.   This allows and existing property editor replaced by a custom property
  603.   editor.
  604.  
  605.     PropertyType
  606.       The type information pointer returned by the TypeInfo built-in function
  607.       (e.g. TypeInfo(TMyRange) or TypeInfo(TShapes)).
  608.  
  609.     ComponentClass
  610.       Type type of the component to which to restrict this type editor.  This
  611.       parameter can be left nil which will mean this type editor applies to all
  612.       properties of PropertyType.
  613.  
  614.     PropertyName
  615.       The name of the property to which to restrict this type editor.  This
  616.       parameter is ignored if ComponentClass is nil.  This paramter can be
  617.       an empty string ('') which will mean that this editor applies to all
  618.       properties of PropertyType in ComponentClass.
  619.  
  620.     EditorClass
  621.       The class of the editor to be created whenever a property of the type
  622.       passed in PropertyTypeInfo is displayed in the Object Inspector.  The
  623.       class will be created by calling EditorClass.Create. }
  624.  
  625. procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  626.   const PropertyName: string; EditorClass: TPropertyEditorClass);
  627.  
  628. procedure GetComponentProperties(Components: TComponentList;
  629.   Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);
  630.  
  631. procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  632.   ComponentEditor: TComponentEditorClass);
  633.  
  634. function GetComponentEditor(Component: TComponent;
  635.   Designer: TFormDesigner): TComponentEditor;
  636.  
  637. implementation
  638.  
  639. uses Windows, Menus, Dialogs, Consts, IniFiles;
  640.  
  641. type
  642.   TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;
  643.  
  644. type
  645.   PPropertyClassRec = ^TPropertyClassRec;
  646.   TPropertyClassRec = record
  647.     Next: PPropertyClassRec;
  648.     PropertyType: PTypeInfo;
  649.     PropertyName: string;
  650.     ComponentClass: TClass;
  651.     EditorClass: TPropertyEditorClass;
  652.   end;
  653.  
  654. const
  655.   PropClassMap: array[TTypeKind] of TPropertyEditorClass = (
  656.     TPropertyEditor, TIntegerProperty, TCharProperty, TEnumProperty,
  657.     TFloatProperty, TStringProperty, TSetProperty, TClassProperty,
  658.     TMethodProperty, TPropertyEditor, TStringProperty, TPropertyEditor,
  659.     TPropertyEditor); {!!!}
  660.  
  661. var
  662.   PropertyClassList: PPropertyClassRec = nil;
  663.  
  664. const
  665.  
  666.   { context ids for the Font editor and the Color Editor, etc. }
  667.   hcDFontEditor       = 25000;
  668.   hcDColorEditor      = 25010;
  669.   hcDMediaPlayerOpen  = 25020;
  670.  
  671. { TComponentList }
  672.  
  673. constructor TComponentList.Create;
  674. begin
  675.   inherited Create;
  676.   FList := TList.Create;
  677. end;
  678.  
  679. destructor TComponentList.Destroy;
  680. begin
  681.   FList.Free;
  682.   inherited Destroy;
  683. end;
  684.  
  685. function TComponentList.Get(Index: Integer): TComponent;
  686. begin
  687.   Result := FList[Index];
  688. end;
  689.  
  690. function TComponentList.GetCount: Integer;
  691. begin
  692.   Result := FList.Count;
  693. end;
  694.  
  695. function TComponentList.Add(Item: TComponent): Integer;
  696. begin
  697.   Result := FList.Add(Item);
  698. end;
  699.  
  700. function TComponentList.Equals(List: TComponentList): Boolean;
  701. var
  702.   I: Integer;
  703. begin
  704.   Result := False;
  705.   if List.Count <> FList.Count then Exit;
  706.   for I := 0 to List.Count - 1 do if List[I] <> FList[I] then Exit;
  707.   Result := True;
  708. end;
  709.  
  710. { TPropertyEditor }
  711.  
  712. constructor TPropertyEditor.Create(ADesigner: TFormDesigner;
  713.   APropCount: Integer);
  714. begin
  715.   FDesigner := ADesigner;
  716.   GetMem(FPropList, APropCount * SizeOf(TInstProp));
  717.   FPropCount := APropCount;
  718. end;
  719.  
  720. destructor TPropertyEditor.Destroy;
  721. begin
  722.   if FPropList <> nil then
  723.     FreeMem(FPropList, FPropCount * SizeOf(TInstProp));
  724. end;
  725.  
  726. procedure TPropertyEditor.Activate;
  727. begin
  728. end;
  729.  
  730. function TPropertyEditor.AllEqual: Boolean;
  731. begin
  732.   Result := FPropCount = 1;
  733. end;
  734.  
  735. procedure TPropertyEditor.Edit;
  736. type
  737.   TGetStrFunc = function(const Value: string): Integer of object;
  738. var
  739.   I: Integer;
  740.   Values: TStringList;
  741.   AddValue: TGetStrFunc;
  742. begin
  743.   Values := TStringList.Create;
  744.   Values.Sorted := paSortList in GetAttributes;
  745.   try
  746.     AddValue := Values.Add;
  747.     GetValues(TGetStrProc(AddValue));
  748.     if Values.Count > 0 then
  749.     begin
  750.       I := Values.IndexOf(Value) + 1;
  751.       if I = Values.Count then I := 0;
  752.       Value := Values[I];
  753.     end;
  754.   finally
  755.     Values.Free;
  756.   end;
  757. end;
  758.  
  759. function TPropertyEditor.GetAttributes: TPropertyAttributes;
  760. begin
  761.   Result := [paMultiSelect, paRevertable];
  762. end;
  763.  
  764. function TPropertyEditor.GetComponent(Index: Integer): TComponent;
  765. begin
  766.   Result := FPropList^[Index].Instance;
  767. end;
  768.  
  769. function TPropertyEditor.GetFloatValue: Extended;
  770. begin
  771.   Result := GetFloatValueAt(0);
  772. end;
  773.  
  774. function TPropertyEditor.GetFloatValueAt(Index: Integer): Extended;
  775. begin
  776.   with FPropList^[Index] do Result := GetFloatProp(Instance, PropInfo);
  777. end;
  778.  
  779. function TPropertyEditor.GetMethodValue: TMethod;
  780. begin
  781.   Result := GetMethodValueAt(0);
  782. end;
  783.  
  784. function TPropertyEditor.GetMethodValueAt(Index: Integer): TMethod;
  785. begin
  786.   with FPropList^[Index] do Result := GetMethodProp(Instance, PropInfo);
  787. end;
  788.  
  789. function TPropertyEditor.GetEditLimit: Integer;
  790. begin
  791.   Result := 255;
  792. end;
  793.  
  794. function TPropertyEditor.GetName: string;
  795. begin
  796.   Result := FPropList^[0].PropInfo^.Name;
  797. end;
  798.  
  799. function TPropertyEditor.GetOrdValue: Longint;
  800. begin
  801.   Result := GetOrdValueAt(0);
  802. end;
  803.  
  804. function TPropertyEditor.GetOrdValueAt(Index: Integer): Longint;
  805. begin
  806.   with FPropList^[Index] do Result := GetOrdProp(Instance, PropInfo);
  807. end;
  808.  
  809. function TPropertyEditor.GetPrivateDirectory: string;
  810. begin
  811.   Result := Designer.GetPrivateDirectory;
  812. end;
  813.  
  814. procedure TPropertyEditor.GetProperties(Proc: TGetPropEditProc);
  815. begin
  816. end;
  817.  
  818. function TPropertyEditor.GetPropInfo: PPropInfo;
  819. begin
  820.   Result := FPropList^[0].PropInfo;
  821. end;
  822.  
  823. function TPropertyEditor.GetPropType: PTypeInfo;
  824. begin
  825.   Result := FPropList^[0].PropInfo^.PropType;
  826. end;
  827.  
  828. function TPropertyEditor.GetStrValue: string;
  829. begin
  830.   Result := GetStrValueAt(0);
  831. end;
  832.  
  833. function TPropertyEditor.GetStrValueAt(Index: Integer): string;
  834. begin
  835.   with FPropList^[Index] do Result := GetStrProp(Instance, PropInfo);
  836. end;
  837.  
  838. function TPropertyEditor.GetVarValue: Variant;
  839. begin
  840.   Result := GetVarValueAt(0);
  841. end;
  842.  
  843. function TPropertyEditor.GetVarValueAt(Index: Integer): Variant;
  844. begin
  845.   with FPropList^[Index] do Result := GetVariantProp(Instance, PropInfo);
  846. end;
  847.  
  848. function TPropertyEditor.GetValue: string;
  849. begin
  850.   Result := LoadStr(srUnknown);
  851. end;
  852.  
  853. procedure TPropertyEditor.GetValues(Proc: TGetStrProc);
  854. begin
  855. end;
  856.  
  857. procedure TPropertyEditor.Initialize;
  858. begin
  859. end;
  860.  
  861. procedure TPropertyEditor.Modified;
  862. begin
  863.   Designer.Modified;
  864. end;
  865.  
  866. procedure TPropertyEditor.SetFloatValue(Value: Extended);
  867. var
  868.   I: Integer;
  869. begin
  870.   for I := 0 to FPropCount - 1 do
  871.     with FPropList^[I] do SetFloatProp(Instance, PropInfo, Value);
  872.   Modified;
  873. end;
  874.  
  875. procedure TPropertyEditor.SetMethodValue(const Value: TMethod);
  876. var
  877.   I: Integer;
  878. begin
  879.   for I := 0 to FPropCount - 1 do
  880.     with FPropList^[I] do SetMethodProp(Instance, PropInfo, Value);
  881.   Modified;
  882. end;
  883.  
  884. procedure TPropertyEditor.SetOrdValue(Value: Longint);
  885. var
  886.   I: Integer;
  887. begin
  888.   for I := 0 to FPropCount - 1 do
  889.     with FPropList^[I] do SetOrdProp(Instance, PropInfo, Value);
  890.   Modified;
  891. end;
  892.  
  893. procedure TPropertyEditor.SetPropEntry(Index: Integer;
  894.   AInstance: TComponent; APropInfo: PPropInfo);
  895. begin
  896.   with FPropList^[Index] do
  897.   begin
  898.     Instance := AInstance;
  899.     PropInfo := APropInfo;
  900.   end;
  901. end;
  902.  
  903. procedure TPropertyEditor.SetStrValue(const Value: string);
  904. var
  905.   I: Integer;
  906. begin
  907.   for I := 0 to FPropCount - 1 do
  908.     with FPropList^[I] do SetStrProp(Instance, PropInfo, Value);
  909.   Modified;
  910. end;
  911.  
  912. procedure TPropertyEditor.SetVarValue(const Value: Variant);
  913. var
  914.   I: Integer;
  915. begin
  916.   for I := 0 to FPropCount - 1 do
  917.     with FPropList^[I] do SetVariantProp(Instance, PropInfo, Value);
  918.   Modified;
  919. end;
  920.  
  921. procedure TPropertyEditor.Revert;
  922. var
  923.   I: Integer;
  924. begin
  925.   for I := 0 to FPropCount - 1 do
  926.     with FPropList^[I] do Designer.Revert(Instance, PropInfo);
  927. end;
  928.  
  929. procedure TPropertyEditor.SetValue(const Value: string);
  930. begin
  931. end;
  932.  
  933. function TPropertyEditor.ValueAvailable: Boolean;
  934. var
  935.   I: Integer;
  936.   S: string;
  937. begin
  938.   Result := True;
  939.   for I := 0 to FPropCount - 1 do
  940.   begin
  941.     if csCheckPropAvail in FPropList^[I].Instance.ComponentStyle then
  942.     begin
  943.       try
  944.         S := GetValue;
  945.         AllEqual;
  946.       except
  947.         Result := False;
  948.       end;
  949.       Exit;
  950.     end;
  951.   end;
  952. end;
  953.  
  954. { TOrdinalProperty }
  955.  
  956. function TOrdinalProperty.AllEqual: Boolean;
  957. var
  958.   I: Integer;
  959.   V: Longint;
  960. begin
  961.   Result := False;
  962.   if PropCount > 1 then
  963.   begin
  964.     V := GetOrdValue;
  965.     for I := 1 to PropCount - 1 do
  966.       if GetOrdValueAt(I) <> V then Exit;
  967.   end;
  968.   Result := True;
  969. end;
  970.  
  971. function TOrdinalProperty.GetEditLimit: Integer;
  972. begin
  973.   Result := 63;
  974. end;
  975.  
  976. { TIntegerProperty }
  977.  
  978. function TIntegerProperty.GetValue: string;
  979. begin
  980.   Result := IntToStr(GetOrdValue);
  981. end;
  982.  
  983. procedure TIntegerProperty.SetValue(const Value: String);
  984. var
  985.   L: Longint;
  986. begin
  987.   L := StrToInt(Value);
  988.   with GetTypeData(GetPropType)^ do
  989.     if (L < MinValue) or (L > MaxValue) then
  990.       raise EPropertyError.CreateResFmt(SOutOfRange, [MinValue, MaxValue]);
  991.   SetOrdValue(L);
  992. end;
  993.  
  994. { TCharProperty }
  995.  
  996. function TCharProperty.GetValue: string;
  997. var
  998.   Ch: Char;
  999. begin
  1000.   Ch := Chr(GetOrdValue);
  1001.   if Ch in [#33..#127] then
  1002.     Result := Ch else
  1003.     FmtStr(Result, '#%d', [Ord(Ch)]);
  1004. end;
  1005.  
  1006. procedure TCharProperty.SetValue(const Value: string);
  1007. var
  1008.   L: Longint;
  1009. begin
  1010.   if Length(Value) = 0 then L := 0 else
  1011.     if Length(Value) = 1 then L := Ord(Value[1]) else
  1012.       if Value[1] = '#' then L := StrToInt(Copy(Value, 2, Maxint)) else
  1013.         raise EPropertyError.CreateRes(SInvalidPropertyValue);
  1014.   with GetTypeData(GetPropType)^ do
  1015.     if (L < MinValue) or (L > MaxValue) then
  1016.       raise EPropertyError.CreateResFmt(SOutOfRange, [MinValue, MaxValue]);
  1017.   SetOrdValue(L);
  1018. end;
  1019.  
  1020. { TEnumProperty }
  1021.  
  1022. function TEnumProperty.GetAttributes: TPropertyAttributes;
  1023. begin
  1024.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1025. end;
  1026.  
  1027. function TEnumProperty.GetValue: string;
  1028. var
  1029.   L: Longint;
  1030. begin
  1031.   L := GetOrdValue;
  1032.   with GetTypeData(GetPropType)^ do
  1033.     if (L < MinValue) or (L > MaxValue) then L := MaxValue;
  1034.   Result := GetEnumName(GetPropType, L);
  1035. end;
  1036.  
  1037. procedure TEnumProperty.GetValues(Proc: TGetStrProc);
  1038. var
  1039.   I: Integer;
  1040.   EnumType: PTypeInfo;
  1041. begin
  1042.   EnumType := GetPropType;
  1043.   with GetTypeData(EnumType)^ do
  1044.     for I := MinValue to MaxValue do Proc(GetEnumName(EnumType, I));
  1045. end;
  1046.  
  1047. procedure TEnumProperty.SetValue(const Value: string);
  1048. var
  1049.   I: Integer;
  1050. begin
  1051.   I := GetEnumValue(GetPropType, Value);
  1052.   if I < 0 then raise EPropertyError.CreateRes(SInvalidPropertyValue);
  1053.   SetOrdValue(I);
  1054. end;
  1055.  
  1056. { TFloatProperty }
  1057.  
  1058. function TFloatProperty.AllEqual: Boolean;
  1059. var
  1060.   I: Integer;
  1061.   V: Extended;
  1062. begin
  1063.   Result := False;
  1064.   if PropCount > 1 then
  1065.   begin
  1066.     V := GetFloatValue;
  1067.     for I := 1 to PropCount - 1 do
  1068.       if GetFloatValueAt(I) <> V then Exit;
  1069.   end;
  1070.   Result := True;
  1071. end;
  1072.  
  1073. function TFloatProperty.GetValue: string;
  1074. const
  1075.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 18);
  1076. begin
  1077.   Result := FloatToStrF(GetFloatValue, ffGeneral,
  1078.     Precisions[GetTypeData(GetPropType)^.FloatType], 0);
  1079. end;
  1080.  
  1081. procedure TFloatProperty.SetValue(const Value: string);
  1082. begin
  1083.   SetFloatValue(StrToFloat(Value));
  1084. end;
  1085.  
  1086. { TStringProperty }
  1087.  
  1088. function TStringProperty.AllEqual: Boolean;
  1089. var
  1090.   I: Integer;
  1091.   V: string;
  1092. begin
  1093.   Result := False;
  1094.   if PropCount > 1 then
  1095.   begin
  1096.     V := GetStrValue;
  1097.     for I := 1 to PropCount - 1 do
  1098.       if GetStrValueAt(I) <> V then Exit;
  1099.   end;
  1100.   Result := True;
  1101. end;
  1102.  
  1103. function TStringProperty.GetEditLimit: Integer;
  1104. begin
  1105.   if GetPropType^.Kind = tkString then
  1106.     Result := GetTypeData(GetPropType)^.MaxLength else
  1107.     Result := 255;
  1108. end;
  1109.  
  1110. function TStringProperty.GetValue: string;
  1111. begin
  1112.   Result := GetStrValue;
  1113. end;
  1114.  
  1115. procedure TStringProperty.SetValue(const Value: string);
  1116. begin
  1117.   SetStrValue(Value);
  1118. end;
  1119.  
  1120. { TComponentNameProperty }
  1121.  
  1122. function TComponentNameProperty.GetAttributes: TPropertyAttributes;
  1123. begin
  1124.   Result := [];
  1125. end;
  1126.  
  1127. function TComponentNameProperty.GetEditLimit: Integer;
  1128. begin
  1129.   Result := 63;
  1130. end;
  1131.  
  1132. { TSetElementProperty }
  1133.  
  1134. constructor TSetElementProperty.Create(ADesigner: TFormDesigner;
  1135.   APropList: PInstPropList; APropCount: Integer; AElement: Integer);
  1136. begin
  1137.   FDesigner := ADesigner;
  1138.   FPropList := APropList;
  1139.   FPropCount := APropCount;
  1140.   FElement := AElement;
  1141. end;
  1142.  
  1143. destructor TSetElementProperty.Destroy;
  1144. begin
  1145. end;
  1146.  
  1147. function TSetElementProperty.AllEqual: Boolean;
  1148. var
  1149.   I: Integer;
  1150.   S: TIntegerSet;
  1151.   V: Boolean;
  1152. begin
  1153.   Result := False;
  1154.   if PropCount > 1 then
  1155.   begin
  1156.     Integer(S) := GetOrdValue;
  1157.     V := FElement in S;
  1158.     for I := 1 to PropCount - 1 do
  1159.     begin
  1160.       Integer(S) := GetOrdValueAt(I);
  1161.       if (FElement in S) <> V then Exit;
  1162.     end;
  1163.   end;
  1164.   Result := True;
  1165. end;
  1166.  
  1167. function TSetElementProperty.GetAttributes: TPropertyAttributes;
  1168. begin
  1169.   Result := [paMultiSelect, paValueList, paSortList];
  1170. end;
  1171.  
  1172. function TSetElementProperty.GetName: string;
  1173. begin
  1174.   Result := GetEnumName(GetTypeData(GetPropType)^.CompType, FElement);
  1175. end;
  1176.  
  1177. function TSetElementProperty.GetValue: string;
  1178. var
  1179.   S: TIntegerSet;
  1180. begin
  1181.   Integer(S) := GetOrdValue;
  1182.   if FElement in S then Result := 'True' else Result := 'False';
  1183. end;
  1184.  
  1185. procedure TSetElementProperty.GetValues(Proc: TGetStrProc);
  1186. begin
  1187.   Proc('False');
  1188.   Proc('True');
  1189. end;
  1190.  
  1191. procedure TSetElementProperty.SetValue(const Value: string);
  1192. var
  1193.   S: TIntegerSet;
  1194. begin
  1195.   Integer(S) := GetOrdValue;
  1196.   if AnsiCompareText(Value, 'True') = 0 then
  1197.     Include(S, FElement) else
  1198.     Exclude(S, FElement);
  1199.   SetOrdValue(Integer(S));
  1200. end;
  1201.  
  1202. { TSetProperty }
  1203.  
  1204. function TSetProperty.GetAttributes: TPropertyAttributes;
  1205. begin
  1206.   Result := [paMultiSelect, paSubProperties, paReadOnly, paRevertable];
  1207. end;
  1208.  
  1209. procedure TSetProperty.GetProperties(Proc: TGetPropEditProc);
  1210. var
  1211.   I: Integer;
  1212. begin
  1213.   with GetTypeData(GetTypeData(GetPropType)^.CompType)^ do
  1214.     for I := MinValue to MaxValue do
  1215.       Proc(TSetElementProperty.Create(FDesigner, FPropList, FPropCount, I));
  1216. end;
  1217.  
  1218. function TSetProperty.GetValue: string;
  1219. var
  1220.   S: TIntegerSet;
  1221.   TypeInfo: PTypeInfo;
  1222.   I: Integer;
  1223. begin
  1224.   Integer(S) := GetOrdValue;
  1225.   TypeInfo := GetTypeData(GetPropType)^.CompType;
  1226.   Result := '[';
  1227.   for I := 0 to SizeOf(Integer) * 8 - 1 do
  1228.     if I in S then
  1229.     begin
  1230.       if Length(Result) <> 1 then Result := Result + ',';
  1231.       Result := Result + GetEnumName(TypeInfo, I);
  1232.     end;
  1233.   Result := Result + ']';
  1234. end;
  1235.  
  1236. { TClassProperty }
  1237.  
  1238. function TClassProperty.GetAttributes: TPropertyAttributes;
  1239. begin
  1240.   Result := [paMultiSelect, paSubProperties, paReadOnly];
  1241. end;
  1242.  
  1243. procedure TClassProperty.GetProperties(Proc: TGetPropEditProc);
  1244. var
  1245.   I: Integer;
  1246.   Components: TComponentList;
  1247. begin
  1248.   Components := TComponentList.Create;
  1249.   try
  1250.     for I := 0 to PropCount - 1 do
  1251.       Components.Add(TComponent(GetOrdValueAt(I)));
  1252.     GetComponentProperties(Components, tkProperties, Designer, Proc);
  1253.   finally
  1254.     Components.Free;
  1255.   end;
  1256. end;
  1257.  
  1258. function TClassProperty.GetValue: string;
  1259. begin
  1260.   FmtStr(Result, '(%s)', [GetPropType^.Name]);
  1261. end;
  1262.  
  1263. { TComponentProperty }
  1264.  
  1265. function TComponentProperty.GetAttributes: TPropertyAttributes;
  1266. begin
  1267.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1268. end;
  1269.  
  1270. function TComponentProperty.GetEditLimit: Integer;
  1271. begin
  1272.   Result := 127;
  1273. end;
  1274.  
  1275. function TComponentProperty.GetValue: string;
  1276. begin
  1277.   Result := Designer.GetComponentName(TComponent(GetOrdValue));
  1278. end;
  1279.  
  1280. procedure TComponentProperty.GetValues(Proc: TGetStrProc);
  1281. begin
  1282.   Designer.GetComponentNames(GetTypeData(GetPropType), Proc);
  1283. end;
  1284.  
  1285. procedure TComponentProperty.SetValue(const Value: string);
  1286. var
  1287.   Component: TComponent;
  1288. begin
  1289.   if Value = '' then Component := nil else
  1290.   begin
  1291.     Component := Designer.GetComponent(Value);
  1292.     if not (Component is GetTypeData(GetPropType)^.ClassType) then
  1293.       raise EPropertyError.CreateRes(SInvalidPropertyValue);
  1294.   end;
  1295.   SetOrdValue(Longint(Component));
  1296. end;
  1297.  
  1298. { TMethodProperty }
  1299.  
  1300. function TMethodProperty.AllEqual: Boolean;
  1301. var
  1302.   I: Integer;
  1303.   V, T: TMethod;
  1304. begin
  1305.   Result := False;
  1306.   if PropCount > 1 then
  1307.   begin
  1308.     V := GetMethodValue;
  1309.     for I := 1 to PropCount - 1 do
  1310.     begin
  1311.       T := GetMethodValueAt(I);
  1312.       if (T.Code <> V.Code) or (T.Data <> V.Data) then Exit;
  1313.     end;
  1314.   end;
  1315.   Result := True;
  1316. end;
  1317.  
  1318. procedure TMethodProperty.Edit;
  1319. var
  1320.   FormMethodName, EventName: string;
  1321. begin
  1322.   FormMethodName := GetValue;
  1323.   if (FormMethodName = '') or
  1324.     Designer.MethodFromAncestor(GetMethodValue) then
  1325.   begin
  1326.     if FormMethodName = '' then
  1327.     begin
  1328.       if GetComponent(0) = Designer.Form then
  1329.         FormMethodName := 'Form' else
  1330.         FormMethodName := GetComponent(0).Name;
  1331.       if FormMethodName = '' then
  1332.         raise EPropertyError.CreateRes(SCannotCreateName);
  1333.       EventName := GetName;
  1334.       if ANsiCompareText(Copy(EventName, 1, 2), 'ON') = 0 then
  1335.         EventName := Copy(EventName, 3, Maxint);
  1336.       FormMethodName := FormMethodName + EventName;
  1337.     end;
  1338.     SetMethodValue(Designer.CreateMethod(FormMethodName,
  1339.       GetTypeData(GetPropType)));
  1340.   end;
  1341.   Designer.ShowMethod(FormMethodName);
  1342. end;
  1343.  
  1344. function TMethodProperty.GetAttributes: TPropertyAttributes;
  1345. begin
  1346.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1347. end;
  1348.  
  1349. function TMethodProperty.GetEditLimit: Integer;
  1350. begin
  1351.   Result := 63;
  1352. end;
  1353.  
  1354. function TMethodProperty.GetValue: string;
  1355. begin
  1356.   Result := Designer.GetMethodName(GetMethodValue);
  1357. end;
  1358.  
  1359. procedure TMethodProperty.GetValues(Proc: TGetStrProc);
  1360. begin
  1361.   Designer.GetMethods(GetTypeData(GetPropType), Proc);
  1362. end;
  1363.  
  1364. procedure TMethodProperty.SetValue(const AValue: string);
  1365. var
  1366.   NewMethod: Boolean;
  1367.   CurValue: string;
  1368. begin
  1369.   CurValue:= GetValue;
  1370.   if (CurValue <> '') and (AValue <> '') and
  1371.     ((AnsiCompareText(CurValue, AValue) = 0) or
  1372.     not Designer.MethodExists(AValue)) then
  1373.     Designer.RenameMethod(CurValue, AValue)
  1374.   else
  1375.   begin
  1376.     NewMethod := (AValue <> '') and not Designer.MethodExists(AValue);
  1377.     SetMethodValue(Designer.CreateMethod(AValue, GetTypeData(GetPropType)));
  1378.     if NewMethod then Designer.ShowMethod(AValue);
  1379.   end;
  1380. end;
  1381.  
  1382. { TFontNameProperty }
  1383.  
  1384. function TFontNameProperty.GetAttributes: TPropertyAttributes;
  1385. begin
  1386.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1387. end;
  1388.  
  1389. procedure TFontNameProperty.GetValues(Proc: TGetStrProc);
  1390. var
  1391.   I: Integer;
  1392. begin
  1393.   for I := 0 to Screen.Fonts.Count - 1 do Proc(Screen.Fonts[I]);
  1394. end;
  1395.  
  1396. { TMPFilenameProperty }
  1397.  
  1398. procedure TMPFilenameProperty.Edit;
  1399. var
  1400.   MPFileOpen: TOpenDialog;
  1401. begin
  1402.   MPFileOpen := TOpenDialog.Create(Application);
  1403.   MPFileOpen.Filename := GetValue;
  1404.   MPFileOpen.Filter := LoadStr(SMPOpenFilter);
  1405.   MPFileOpen.HelpContext := hcDMediaPlayerOpen;
  1406.   MPFileOpen.Options := MPFileOpen.Options + [ofShowHelp, ofPathMustExist,
  1407.     ofFileMustExist];
  1408.   try
  1409.     if MPFileOpen.Execute then SetValue(MPFileOpen.Filename);
  1410.   finally
  1411.     MPFileOpen.Free;
  1412.   end;
  1413. end;
  1414.  
  1415. function TMPFilenameProperty.GetAttributes: TPropertyAttributes;
  1416. begin
  1417.   Result := [paDialog, paRevertable];
  1418. end;
  1419.  
  1420. { TColorProperty }
  1421.  
  1422. procedure TColorProperty.Edit;
  1423. var
  1424.   ColorDialog: TColorDialog;
  1425.   IniFile: TIniFile;
  1426.  
  1427.   procedure GetCustomColors;
  1428.   begin
  1429.     IniFile := TIniFile.Create('DELPHI32.INI');
  1430.     try
  1431.       IniFile.ReadSectionValues(LoadStr(SCustomColors),
  1432.         ColorDialog.CustomColors);
  1433.     except
  1434.       { Ignore errors reading values }
  1435.     end;
  1436.   end;
  1437.  
  1438.   procedure SaveCustomColors;
  1439.   var
  1440.     I, P: Integer;
  1441.     S: string;
  1442.   begin
  1443.     if IniFile <> nil then
  1444.       with ColorDialog do
  1445.         for I := 0 to CustomColors.Count - 1 do
  1446.         begin
  1447.           S := CustomColors.Strings[I];
  1448.           P := Pos('=', S);
  1449.           if P <> 0 then
  1450.           begin
  1451.             S := Copy(S, 1, P - 1);
  1452.             IniFile.WriteString(LoadStr(SCustomColors), S,
  1453.               CustomColors.Values[S]);
  1454.           end;
  1455.         end;
  1456.   end;
  1457.  
  1458. begin
  1459.   IniFile := nil;
  1460.   ColorDialog := TColorDialog.Create(Application);
  1461.   try
  1462.     GetCustomColors;
  1463.     ColorDialog.Color := GetOrdValue;
  1464.     ColorDialog.HelpContext := hcDColorEditor;
  1465.     ColorDialog.Options := [cdShowHelp];
  1466.     if ColorDialog.Execute then SetOrdValue(ColorDialog.Color);
  1467.     SaveCustomColors;
  1468.   finally
  1469.     if IniFile <> nil then IniFile.Free;
  1470.     ColorDialog.Free;
  1471.   end;
  1472. end;
  1473.  
  1474. function TColorProperty.GetAttributes: TPropertyAttributes;
  1475. begin
  1476.   Result := [paMultiSelect, paDialog, paValueList, paRevertable];
  1477. end;
  1478.  
  1479. function TColorProperty.GetValue: string;
  1480. begin
  1481.   Result := ColorToString(TColor(GetOrdValue));
  1482. end;
  1483.  
  1484. procedure TColorProperty.GetValues(Proc: TGetStrProc);
  1485. begin
  1486.   GetColorValues(Proc);
  1487. end;
  1488.  
  1489. procedure TColorProperty.SetValue(const Value: string);
  1490. var
  1491.   NewValue: Longint;
  1492. begin
  1493.   if IdentToColor(Value, NewValue) then
  1494.     SetOrdValue(NewValue)
  1495.   else inherited SetValue(Value);
  1496. end;
  1497.  
  1498. { TCursorProperty }
  1499.  
  1500. function TCursorProperty.GetAttributes: TPropertyAttributes;
  1501. begin
  1502.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1503. end;
  1504.  
  1505. function TCursorProperty.GetValue: string;
  1506. begin
  1507.   Result := CursorToString(TCursor(GetOrdValue));
  1508. end;
  1509.  
  1510. procedure TCursorProperty.GetValues(Proc: TGetStrProc);
  1511. begin
  1512.   GetCursorValues(Proc);
  1513. end;
  1514.  
  1515. procedure TCursorProperty.SetValue(const Value: string);
  1516. var
  1517.   NewValue: Longint;
  1518. begin
  1519.   if IdentToCursor(Value, NewValue) then
  1520.     SetOrdValue(NewValue)
  1521.   else inherited SetValue(Value);
  1522. end;
  1523.  
  1524. { TFontProperty }
  1525.  
  1526. procedure TFontProperty.Edit;
  1527. var
  1528.   FontDialog: TFontDialog;
  1529. begin
  1530.   FontDialog := TFontDialog.Create(Application);
  1531.   try
  1532.     FontDialog.Font := TFont(GetOrdValue);
  1533.     FontDialog.HelpContext := hcDFontEditor;
  1534.     FontDialog.Options := FontDialog.Options + [fdShowHelp, fdForceFontExist];
  1535.     if FontDialog.Execute then SetOrdValue(Longint(FontDialog.Font));
  1536.   finally
  1537.     FontDialog.Free;
  1538.   end;
  1539. end;
  1540.  
  1541. function TFontProperty.GetAttributes: TPropertyAttributes;
  1542. begin
  1543.   Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
  1544. end;
  1545.  
  1546. { TModalResultProperty }
  1547.  
  1548. const
  1549.   ModalResults: array[mrNone..mrNo] of string = (
  1550.     'mrNone',
  1551.     'mrOk',
  1552.     'mrCancel',
  1553.     'mrAbort',
  1554.     'mrRetry',
  1555.     'mrIgnore',
  1556.     'mrYes',
  1557.     'mrNo');
  1558.  
  1559. function TModalResultProperty.GetAttributes: TPropertyAttributes;
  1560. begin
  1561.   Result := [paMultiSelect, paValueList, paRevertable];
  1562. end;
  1563.  
  1564. function TModalResultProperty.GetValue: string;
  1565. var
  1566.   CurValue: Longint;
  1567. begin
  1568.   CurValue := GetOrdValue;
  1569.   case CurValue of
  1570.     Low(ModalResults)..High(ModalResults):
  1571.       Result := ModalResults[CurValue];
  1572.   else
  1573.     Result := IntToStr(CurValue);
  1574.   end;
  1575. end;
  1576.  
  1577. procedure TModalResultProperty.GetValues(Proc: TGetStrProc);
  1578. var
  1579.   I: Integer;
  1580. begin
  1581.   for I := Low(ModalResults) to High(ModalResults) do Proc(ModalResults[I]);
  1582. end;
  1583.  
  1584. procedure TModalResultProperty.SetValue(const Value: string);
  1585. var
  1586.   I: Integer;
  1587. begin
  1588.   if Value = '' then
  1589.   begin
  1590.     SetOrdValue(0);
  1591.     Exit;
  1592.   end;
  1593.   for I := Low(ModalResults) to High(ModalResults) do
  1594.     if AnsiCompareText(ModalResults[I], Value) = 0 then
  1595.     begin
  1596.       SetOrdValue(I);
  1597.       Exit;
  1598.     end;
  1599.   inherited SetValue(Value);
  1600. end;
  1601.  
  1602. { TShortCutProperty }
  1603.  
  1604. const
  1605.   ShortCuts: array[0..82] of TShortCut = (
  1606.     scNone,
  1607.     Byte('A') or scCtrl,
  1608.     Byte('B') or scCtrl,
  1609.     Byte('C') or scCtrl,
  1610.     Byte('D') or scCtrl,
  1611.     Byte('E') or scCtrl,
  1612.     Byte('F') or scCtrl,
  1613.     Byte('G') or scCtrl,
  1614.     Byte('H') or scCtrl,
  1615.     Byte('I') or scCtrl,
  1616.     Byte('J') or scCtrl,
  1617.     Byte('K') or scCtrl,
  1618.     Byte('L') or scCtrl,
  1619.     Byte('M') or scCtrl,
  1620.     Byte('N') or scCtrl,
  1621.     Byte('O') or scCtrl,
  1622.     Byte('P') or scCtrl,
  1623.     Byte('Q') or scCtrl,
  1624.     Byte('R') or scCtrl,
  1625.     Byte('S') or scCtrl,
  1626.     Byte('T') or scCtrl,
  1627.     Byte('U') or scCtrl,
  1628.     Byte('V') or scCtrl,
  1629.     Byte('W') or scCtrl,
  1630.     Byte('X') or scCtrl,
  1631.     Byte('Y') or scCtrl,
  1632.     Byte('Z') or scCtrl,
  1633.     VK_F1,
  1634.     VK_F2,
  1635.     VK_F3,
  1636.     VK_F4,
  1637.     VK_F5,
  1638.     VK_F6,
  1639.     VK_F7,
  1640.     VK_F8,
  1641.     VK_F9,
  1642.     VK_F10,
  1643.     VK_F11,
  1644.     VK_F12,
  1645.     VK_F1 or scCtrl,
  1646.     VK_F2 or scCtrl,
  1647.     VK_F3 or scCtrl,
  1648.     VK_F4 or scCtrl,
  1649.     VK_F5 or scCtrl,
  1650.     VK_F6 or scCtrl,
  1651.     VK_F7 or scCtrl,
  1652.     VK_F8 or scCtrl,
  1653.     VK_F9 or scCtrl,
  1654.     VK_F10 or scCtrl,
  1655.     VK_F11 or scCtrl,
  1656.     VK_F12 or scCtrl,
  1657.     VK_F1 or scShift,
  1658.     VK_F2 or scShift,
  1659.     VK_F3 or scShift,
  1660.     VK_F4 or scShift,
  1661.     VK_F5 or scShift,
  1662.     VK_F6 or scShift,
  1663.     VK_F7 or scShift,
  1664.     VK_F8 or scShift,
  1665.     VK_F9 or scShift,
  1666.     VK_F10 or scShift,
  1667.     VK_F11 or scShift,
  1668.     VK_F12 or scShift,
  1669.     VK_F1 or scShift or scCtrl,
  1670.     VK_F2 or scShift or scCtrl,
  1671.     VK_F3 or scShift or scCtrl,
  1672.     VK_F4 or scShift or scCtrl,
  1673.     VK_F5 or scShift or scCtrl,
  1674.     VK_F6 or scShift or scCtrl,
  1675.     VK_F7 or scShift or scCtrl,
  1676.     VK_F8 or scShift or scCtrl,
  1677.     VK_F9 or scShift or scCtrl,
  1678.     VK_F10 or scShift or scCtrl,
  1679.     VK_F11 or scShift or scCtrl,
  1680.     VK_F12 or scShift or scCtrl,
  1681.     VK_INSERT,
  1682.     VK_INSERT or scShift,
  1683.     VK_INSERT or scCtrl,
  1684.     VK_DELETE,
  1685.     VK_DELETE or scShift,
  1686.     VK_DELETE or scCtrl,
  1687.     VK_BACK or scAlt,
  1688.     VK_BACK or scShift or scAlt);
  1689.  
  1690. function TShortCutProperty.GetAttributes: TPropertyAttributes;
  1691. begin
  1692.   Result := [paMultiSelect, paValueList, paRevertable];
  1693. end;
  1694.  
  1695. function TShortCutProperty.GetValue: string;
  1696. var
  1697.   CurValue: TShortCut;
  1698. begin
  1699.   CurValue := GetOrdValue;
  1700.   if CurValue = scNone then
  1701.     Result := LoadStr(srNone) else
  1702.     Result := ShortCutToText(CurValue);
  1703. end;
  1704.  
  1705. procedure TShortCutProperty.GetValues(Proc: TGetStrProc);
  1706. var
  1707.   I: Integer;
  1708. begin
  1709.   Proc(LoadStr(srNone));
  1710.   for I := 1 to High(ShortCuts) do Proc(ShortCutToText(ShortCuts[I]));
  1711. end;
  1712.  
  1713. procedure TShortCutProperty.SetValue(const Value: string);
  1714. var
  1715.   NewValue: TShortCut;
  1716. begin
  1717.   NewValue := 0;
  1718.   if (Value <> '') and (AnsiCompareText(Value, LoadStr(srNone)) <> 0) then
  1719.   begin
  1720.     NewValue := TextToShortCut(Value);
  1721.     if NewValue = 0 then
  1722.       raise EPropertyError.CreateRes(SInvalidPropertyValue);
  1723.   end;
  1724.   SetOrdValue(NewValue);
  1725. end;
  1726.  
  1727. { TTabOrderProperty }
  1728.  
  1729. function TTabOrderProperty.GetAttributes: TPropertyAttributes;
  1730. begin
  1731.   Result := [];
  1732. end;
  1733.  
  1734. { TCaptionProperty }
  1735.  
  1736. function TCaptionProperty.GetAttributes: TPropertyAttributes;
  1737. begin
  1738.   Result := [paMultiSelect, paAutoUpdate, paRevertable];
  1739. end;
  1740.  
  1741. { TPropInfoList }
  1742.  
  1743. type
  1744.   TPropInfoList = class
  1745.   private
  1746.     FList: PPropList;
  1747.     FCount: Integer;
  1748.     FSize: Integer;
  1749.     function Get(Index: Integer): PPropInfo;
  1750.   public
  1751.     constructor Create(Component: TComponent; Filter: TTypeKinds);
  1752.     destructor Destroy; override;
  1753.     function Contains(P: PPropInfo): Boolean;
  1754.     procedure Delete(Index: Integer);
  1755.     procedure Intersect(List: TPropInfoList);
  1756.     property Count: Integer read FCount;
  1757.     property Items[Index: Integer]: PPropInfo read Get; default;
  1758.   end;
  1759.  
  1760. constructor TPropInfoList.Create(Component: TComponent; Filter: TTypeKinds);
  1761. begin
  1762.   FCount := GetPropList(Component.ClassInfo, Filter, nil);
  1763.   FSize := FCount * SizeOf(Pointer);
  1764.   GetMem(FList, FSize);
  1765.   GetPropList(Component.ClassInfo, Filter, FList);
  1766. end;
  1767.  
  1768. destructor TPropInfoList.Destroy;
  1769. begin
  1770.   if FList <> nil then FreeMem(FList, FSize);
  1771. end;
  1772.  
  1773. function TPropInfoList.Contains(P: PPropInfo): Boolean;
  1774. var
  1775.   I: Integer;
  1776. begin
  1777.   for I := 0 to FCount - 1 do
  1778.     with FList^[I]^ do
  1779.       if (PropType = P^.PropType) and (AnsiCompareText(Name, P^.Name) = 0) then
  1780.       begin
  1781.         Result := True;
  1782.         Exit;
  1783.       end;
  1784.   Result := False;
  1785. end;
  1786.  
  1787. procedure TPropInfoList.Delete(Index: Integer);
  1788. begin
  1789.   Dec(FCount);
  1790.   if Index < FCount then
  1791.     Move(FList^[Index + 1], FList^[Index],
  1792.       (FCount - Index) * SizeOf(Pointer));
  1793. end;
  1794.  
  1795. function TPropInfoList.Get(Index: Integer): PPropInfo;
  1796. begin
  1797.   Result := FList^[Index];
  1798. end;
  1799.  
  1800. procedure TPropInfoList.Intersect(List: TPropInfoList);
  1801. var
  1802.   I: Integer;
  1803. begin
  1804.   for I := FCount - 1 downto 0 do
  1805.     if not List.Contains(FList^[I]) then Delete(I);
  1806. end;
  1807.  
  1808. { GetComponentProperties }
  1809.  
  1810. procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  1811.   const PropertyName: string; EditorClass: TPropertyEditorClass);
  1812. var
  1813.   P: PPropertyClassRec;
  1814. begin
  1815.   New(P);
  1816.   P^.Next := PropertyClassList;
  1817.   P^.PropertyType := PropertyType;
  1818.   P^.ComponentClass := ComponentClass;
  1819.   P^.PropertyName := '';
  1820.   if Assigned(ComponentClass) then P^.PropertyName := PropertyName;
  1821.   P^.EditorClass := EditorClass;
  1822.   PropertyClassList := P;
  1823. end;
  1824.  
  1825. function GetEditorClass(PropInfo: PPropInfo;
  1826.   ComponentClass: TClass): TPropertyEditorClass;
  1827. var
  1828.   PropType: PTypeInfo;
  1829.   P, C: PPropertyClassRec;
  1830. begin
  1831.   PropType := PropInfo^.PropType;
  1832.   P := PropertyClassList;
  1833.   C := nil;
  1834.   while P <> nil do
  1835.   begin
  1836.     if ((P^.PropertyType = PropType) or ((PropType^.Kind = tkClass) and
  1837.       (P^.PropertyType^.Kind = tkClass) and
  1838.       GetTypeData(PropType)^.ClassType.InheritsFrom(GetTypeData(P^.PropertyType)^.ClassType))) and
  1839.       ((P^.ComponentClass = nil) or (ComponentClass.InheritsFrom(P^.ComponentClass))) and
  1840.       ((P^.PropertyName = '') or (AnsiCompareText(PropInfo^.Name, P^.PropertyName) = 0)) then
  1841.       if (C = nil) or ((C^.ComponentClass = nil) and (P^.ComponentClass <> nil))
  1842.         or ((C^.PropertyName = '') and (P^.PropertyName <> '')) then C := P;
  1843.     P := P^.Next;
  1844.   end;
  1845.   if C <> nil then
  1846.     Result := C^.EditorClass else
  1847.     Result := PropClassMap[PropType^.Kind];
  1848. end;
  1849.  
  1850. procedure GetComponentProperties(Components: TComponentList;
  1851.   Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);
  1852. var
  1853.   I, J, CompCount: Integer;
  1854.   CompType: TClass;
  1855.   Candidates: TPropInfoList;
  1856.   PropLists: TList;
  1857.   Editor: TPropertyEditor;
  1858.   PropInfo: PPropInfo;
  1859.   AddEditor: Boolean;
  1860. begin
  1861.   if (Components = nil) or (Components.Count = 0) then Exit;
  1862.   CompCount := Components.Count;
  1863.   CompType := Components[0].ClassType;
  1864.   Candidates := TPropInfoList.Create(Components[0], Filter);
  1865.   try
  1866.     for I := Candidates.Count - 1 downto 0 do
  1867.     begin
  1868.       PropInfo := Candidates[I];
  1869.       Editor := GetEditorClass(PropInfo, CompType).Create(Designer, 1);
  1870.       try
  1871.         Editor.SetPropEntry(0, Components[0], PropInfo);
  1872.         Editor.Initialize;
  1873.         with PropInfo^ do
  1874.           if (GetProc = nil) or ((PropType^.Kind <> tkClass) and
  1875.             (SetProc = nil)) or ((CompCount > 1) and
  1876.             not (paMultiSelect in Editor.GetAttributes)) or
  1877.             not Editor.ValueAvailable then
  1878.             Candidates.Delete(I);
  1879.       finally
  1880.         Editor.Free;
  1881.       end;
  1882.     end;
  1883.     PropLists := TList.Create;
  1884.     try
  1885.       PropLists.Capacity := CompCount;
  1886.       for I := 0 to CompCount - 1 do
  1887.         PropLists.Add(TPropInfoList.Create(Components[I], Filter));
  1888.       for I := 0 to CompCount - 1 do
  1889.         Candidates.Intersect(TPropInfoList(PropLists[I]));
  1890.       for I := 0 to CompCount - 1 do
  1891.         TPropInfoList(PropLists[I]).Intersect(Candidates);
  1892.       for I := 0 to Candidates.Count - 1 do
  1893.       begin
  1894.         Editor := GetEditorClass(Candidates[I],
  1895.           CompType).Create(Designer, CompCount);
  1896.         try
  1897.           AddEditor := True;
  1898.           for J := 0 to CompCount - 1 do
  1899.           begin
  1900.             if (Components[J].ClassType <> CompType) and
  1901.               (GetEditorClass(TPropInfoList(PropLists[J])[I],
  1902.                 Components[J].ClassType) <> Editor.ClassType) then
  1903.             begin
  1904.               AddEditor := False;
  1905.               Break;
  1906.             end;
  1907.             Editor.SetPropEntry(J, Components[J],
  1908.               TPropInfoList(PropLists[J])[I]);
  1909.           end;
  1910.         except
  1911.           Editor.Free;
  1912.           raise;
  1913.         end;
  1914.         if AddEditor then
  1915.         begin
  1916.           Editor.Initialize;
  1917.           if Editor.ValueAvailable then
  1918.             Proc(Editor) else
  1919.             Editor.Free;
  1920.         end
  1921.         else Editor.Free;
  1922.       end;
  1923.     finally
  1924.       for I := 0 to PropLists.Count - 1 do TPropInfoList(PropLists[I]).Free;
  1925.       PropLists.Free;
  1926.     end;
  1927.   finally
  1928.     Candidates.Free;
  1929.   end;
  1930. end;
  1931.  
  1932. { RegisterComponentEditor }
  1933.  
  1934. type
  1935.   PComponentClassRec = ^TComponentClassRec;
  1936.   TComponentClassRec = record
  1937.     Next: PComponentClassRec;
  1938.     ComponentClass: TComponentClass;
  1939.     EditorClass: TComponentEditorClass;
  1940.   end;
  1941.  
  1942. var
  1943.   ComponentClassList: PComponentClassRec = nil;
  1944.  
  1945. procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  1946.   ComponentEditor: TComponentEditorClass);
  1947. var
  1948.   P: PComponentClassRec;
  1949. begin
  1950.   New(P);
  1951.   P^.Next := ComponentClassList;
  1952.   P^.ComponentClass := ComponentClass;
  1953.   P^.EditorClass := ComponentEditor;
  1954.   ComponentClassList := P;
  1955. end;
  1956.  
  1957. { GetComponentEditor }
  1958.  
  1959. function GetComponentEditor(Component: TComponent;
  1960.   Designer: TFormDesigner): TComponentEditor;
  1961. var
  1962.   P: PComponentClassRec;
  1963.   ComponentClass: TComponentClass;
  1964.   EditorClass: TComponentEditorClass;
  1965. begin
  1966.   P := ComponentClassList;
  1967.   ComponentClass := TComponent;
  1968.   EditorClass := TDefaultEditor;
  1969.   while P <> nil do
  1970.   begin
  1971.     if (Component is P^.ComponentClass) and
  1972.       (P^.ComponentClass.InheritsFrom(ComponentClass)) then
  1973.     begin
  1974.       EditorClass := P^.EditorClass;
  1975.       ComponentClass := P^.ComponentClass;
  1976.     end;
  1977.     P := P^.Next;
  1978.   end;
  1979.   Result := EditorClass.Create(Component, Designer);
  1980. end;
  1981.  
  1982. { TComponentEditor }
  1983.  
  1984. constructor TComponentEditor.Create(AComponent: TComponent; ADesigner: TFormDesigner);
  1985. begin
  1986.   inherited Create;
  1987.   FComponent := AComponent;
  1988.   FDesigner := ADesigner;
  1989. end;
  1990.  
  1991. procedure TComponentEditor.Edit;
  1992. begin
  1993.   if GetVerbCount > 0 then ExecuteVerb(0);
  1994. end;
  1995.  
  1996. function TComponentEditor.GetVerbCount: Integer;
  1997. begin
  1998.   Result := 0;
  1999. end;
  2000.  
  2001. function TComponentEditor.GetVerb(Index: Integer): string;
  2002. begin
  2003. end;
  2004.  
  2005. procedure TComponentEditor.ExecuteVerb(Index: Integer);
  2006. begin
  2007. end;
  2008.  
  2009. procedure TComponentEditor.Copy;
  2010. begin
  2011. end;
  2012.  
  2013. { TDefaultEditor }
  2014.  
  2015. procedure TDefaultEditor.CheckEdit(PropertyEditor: TPropertyEditor);
  2016. var
  2017.   FreeEditor: Boolean;
  2018. begin
  2019.   FreeEditor := True;
  2020.   try
  2021.     if FContinue then EditProperty(PropertyEditor, FContinue, FreeEditor);
  2022.   finally
  2023.     if FreeEditor then PropertyEditor.Free;
  2024.   end;
  2025. end;
  2026.  
  2027. procedure TDefaultEditor.EditProperty(PropertyEditor: TPropertyEditor;
  2028.   var Continue, FreeEditor: Boolean);
  2029. var
  2030.   PropName: string;
  2031.   BestName: string;
  2032.  
  2033.   procedure ReplaceBest;
  2034.   begin
  2035.     FBest.Free;
  2036.     FBest := PropertyEditor;
  2037.     if FFirst = FBest then FFirst := nil;
  2038.     FreeEditor := False;
  2039.   end;
  2040.  
  2041. begin
  2042.   if not Assigned(FFirst) and (PropertyEditor is TMethodProperty) then
  2043.   begin
  2044.     FreeEditor := False;
  2045.     FFirst := PropertyEditor;
  2046.   end;
  2047.   PropName := PropertyEditor.GetName;
  2048.   BestName := '';
  2049.   if Assigned(FBest) then BestName := FBest.GetName;
  2050.   if AnsiCompareText(PropName, 'ONCREATE') = 0 then
  2051.     ReplaceBest
  2052.   else if AnsiCompareText(BestName, 'ONCREATE') <> 0 then
  2053.     if AnsiCompareText(PropName, 'ONCHANGE') = 0 then
  2054.       ReplaceBest
  2055.     else if AnsiCompareText(BestName, 'ONCHANGE') <> 0 then
  2056.       if AnsiCompareText(PropName, 'ONCLICK') = 0 then
  2057.         ReplaceBest;
  2058. end;
  2059.  
  2060. procedure TDefaultEditor.Edit;
  2061. var
  2062.   Components: TComponentList;
  2063. begin
  2064.   Components := TComponentList.Create;
  2065.   try
  2066.     FContinue := True;
  2067.     Components.Add(Component);
  2068.     FFirst := nil;
  2069.     FBest := nil;
  2070.     try
  2071.       GetComponentProperties(Components, tkAny, Designer, CheckEdit);
  2072.       if FContinue then
  2073.         if Assigned(FBest) then
  2074.           FBest.Edit
  2075.         else if Assigned(FFirst) then
  2076.           FFirst.Edit;
  2077.     finally
  2078.       FFirst.Free;
  2079.       FBest.Free;
  2080.     end;
  2081.   finally
  2082.     Components.Free;
  2083.   end;
  2084. end;
  2085.  
  2086. end.
  2087.