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