home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 May / Pcwk0597.iso / borland / cb / setup / cbuilder / data.z / DSGNINTF.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-28  |  66KB  |  2,188 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 property 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. { TFontCharsetProperty
  426.   Editor for the TFont.Charset property.  Displays a drop-down list of the
  427.   character-set by Windows.}
  428.  
  429.   TFontCharsetProperty = class(TIntegerProperty)
  430.   public
  431.     function GetAttributes: TPropertyAttributes; override;
  432.     function GetValue: string; override;
  433.     procedure GetValues(Proc: TGetStrProc); override;
  434.     procedure SetValue(const Value: string); override;
  435.   end;
  436.  
  437. { TImeNameProperty
  438.   Editor for the TImeName property.  Displays a drop-down list of all
  439.   the IME names known by Windows.}
  440.  
  441.   TImeNameProperty = class(TStringProperty)
  442.   public
  443.     function GetAttributes: TPropertyAttributes; override;
  444.     procedure GetValues(Proc: TGetStrProc); override;
  445.   end;
  446.  
  447. { TColorProperty
  448.   Property editor for the TColor type.  Displays the color as a clXXX value
  449.   if one exists, otherwise displays the value as hex.  Also allows the
  450.   clXXX value to be picked from a list. }
  451.  
  452.   TColorProperty = class(TIntegerProperty)
  453.   public
  454.     procedure Edit; override;
  455.     function GetAttributes: TPropertyAttributes; override;
  456.     function GetValue: string; override;
  457.     procedure GetValues(Proc: TGetStrProc); override;
  458.     procedure SetValue(const Value: string); override;
  459.   end;
  460.  
  461. { TCursorProperty
  462.   Property editor for the TCursor type.  Displays the color as a crXXX value
  463.   if one exists, otherwise displays the value as hex.  Also allows the
  464.   clXXX value to be picked from a list. }
  465.  
  466.   TCursorProperty = class(TIntegerProperty)
  467.   public
  468.     function GetAttributes: TPropertyAttributes; override;
  469.     function GetValue: string; override;
  470.     procedure GetValues(Proc: TGetStrProc); override;
  471.     procedure SetValue(const Value: string); override;
  472.   end;
  473.  
  474. { TFontProperty
  475.   Property editor the Font property.  Brings up the font dialog as well as
  476.   allowing the properties of the object to be edited. }
  477.  
  478.   TFontProperty = class(TClassProperty)
  479.   public
  480.     procedure Edit; override;
  481.     function GetAttributes: TPropertyAttributes; override;
  482.   end;
  483.  
  484. { TModalResultProperty }
  485.  
  486.   TModalResultProperty = class(TIntegerProperty)
  487.   public
  488.     function GetAttributes: TPropertyAttributes; override;
  489.     function GetValue: string; override;
  490.     procedure GetValues(Proc: TGetStrProc); override;
  491.     procedure SetValue(const Value: string); override;
  492.   end;
  493.  
  494. { TShortCutProperty
  495.   Property editor the the ShortCut property.  Allows both typing in a short
  496.   cut value or picking a short-cut value from a list. }
  497.  
  498.   TShortCutProperty = class(TOrdinalProperty)
  499.   public
  500.     function GetAttributes: TPropertyAttributes; override;
  501.     function GetValue: string; override;
  502.     procedure GetValues(Proc: TGetStrProc); override;
  503.     procedure SetValue(const Value: string); override;
  504.   end;
  505.  
  506. { TMPFilenameProperty
  507.   Property editor for the TMediaPlayer.  Displays an File Open Dialog
  508.   for the name of the media file.}
  509.  
  510.   TMPFilenameProperty = class(TStringProperty)
  511.   public
  512.     procedure Edit; override;
  513.     function GetAttributes: TPropertyAttributes; override;
  514.   end;
  515.  
  516. { TTabOrderProperty
  517.   Property editor for the TabOrder property.  Prevents the property from being
  518.   displayed when more than one component is selected. }
  519.  
  520.   TTabOrderProperty = class(TIntegerProperty)
  521.   public
  522.     function GetAttributes: TPropertyAttributes; override;
  523.   end;
  524.  
  525. { TCaptionProperty
  526.   Property editor for the Caption and Text properties.  Updates the value of
  527.   the property for each change instead on when the property is approved. }
  528.  
  529.   TCaptionProperty = class(TStringProperty)
  530.   public
  531.     function GetAttributes: TPropertyAttributes; override;
  532.   end;
  533.  
  534.   EPropertyError = class(Exception);
  535.  
  536. { TComponentEditor
  537.   A component editor is created for each component that is selected in the
  538.   form designer based on the component's type (see GetComponentEditor and
  539.   RegisterComponentEditor).  When the component is double-clicked the Edit
  540.   method is called.  When the context menu for the component is invoked the
  541.   GetVerbCount and GetVerb methods are called to build the menu.  If one
  542.   of the verbs are selected ExecuteVerb is called.  Paste is called whenever
  543.   the component is pasted to the clipboard.  You only need to create a
  544.   component editor if you wish to add verbs to the context menu, change
  545.   the default double-click behavior, or paste an additional clipboard format.
  546.   The default component editor (TDefaultEditor) implements Edit to searchs the
  547.   properties of the component and generates (or navigates to) the OnCreate,
  548.   OnChanged, or OnClick event (whichever it finds first).  Whenever the
  549.   component modifies the component is *must* call Designer.Modified to inform
  550.   the designer that the form has been modified.
  551.  
  552.     Create(AComponent, ADesigner)
  553.       Called to create the component editor.  AComponent is the component to
  554.       be edited by the editor.  ADesigner is an interface to the designer to
  555.       find controls and create methods (this is not use often).
  556.     Edit
  557.       Called when the user double-clicks the component. The component editor can
  558.       bring up a dialog in responce to this method, for example, or some kind
  559.       of design expert.  If GetVerbCount is greater than zero, edit will execute
  560.       the first verb in the list (ExecuteVerb(0)).
  561.     ExecuteVerb(Index)
  562.       The Index'ed verb was selected by the use off the context menu.  The
  563.       meaning of this is determined by component editor.
  564.     GetVerb
  565.       The component editor should return a string that will be displayed in the
  566.       context menu.  It is the responsibility of the component editor to place
  567.       the & character and the '...' characters as appropriate.
  568.     GetVerbCount
  569.       The number of valid indexs to GetVerb and Execute verb.  The index assumed
  570.       to be zero based (i.e. 0..GetVerbCount - 1).
  571.     Copy
  572.       Called when the component is being copyied to the clipboard.  The
  573.       component's filed image is already on the clipboard.  This gives the
  574.       component editor a chance to paste a different type of format which is
  575.       ignored by the designer but might be recoginized by another application. }
  576.  
  577.   TComponentEditor = class
  578.   private
  579.     FComponent: TComponent;
  580.     FDesigner: TFormDesigner;
  581.   public
  582.     constructor Create(AComponent: TComponent; ADesigner: TFormDesigner); virtual;
  583.     procedure Edit; virtual;
  584.     procedure ExecuteVerb(Index: Integer); virtual;
  585.     function GetVerb(Index: Integer): string; virtual;
  586.     function GetVerbCount: Integer; virtual;
  587.     procedure Copy; virtual;
  588.     property Component: TComponent read FComponent;
  589.     property Designer: TFormDesigner read FDesigner;
  590.   end;
  591.  
  592.   TComponentEditorClass = class of TComponentEditor;
  593.  
  594.   TDefaultEditor = class(TComponentEditor)
  595.   private
  596.     FFirst: TPropertyEditor;
  597.     FBest: TPropertyEditor;
  598.     FContinue: Boolean;
  599.     procedure CheckEdit(PropertyEditor: TPropertyEditor);
  600.   protected
  601.     procedure EditProperty(PropertyEditor: TPropertyEditor;
  602.       var Continue, FreeEditor: Boolean); virtual;
  603.   public
  604.     procedure Edit; override;
  605.   end;
  606.  
  607.   TPropertyMapperFunc = function(Component: TComponent;
  608.     PropInfo: PPropInfo): TPropertyEditorClass;
  609.  
  610. { RegisterPropertyEditor
  611.   Registers a new property editor for the given type.  When a component is
  612.   selected the Object Inspector will create a property editor for each
  613.   of the component's properties.  The property editor is created based on
  614.   the type of the property.  If, for example, the property type is an
  615.   Integer, the property editor for Integer will be created (by default
  616.   that would be TIntegerProperty). Most properties do not need specialized
  617.   property editors.  For example, if the property is an ordinal type the
  618.   default property editor will restrict the range to the ordinal subtype
  619.   range (e.g. a property of type TMyRange = 1..10 will only allow values
  620.   between 1 and 10 to be entered into the property).  Enumerated types will
  621.   display a drop-down list of all the enumerated values (e.g. TShapes =
  622.   (sCircle, sSquare, sTriangle) will be edited by a drop-down list containing
  623.   only sCircle, sSquare and sTriangle).  A property editor need only be
  624.   created if default property editor or none of the existing property editors
  625.   are sufficient to edit the property.  This is typically because the
  626.   property is an object.  The properties are looked up newest to oldest.
  627.   This allows and existing property editor replaced by a custom property
  628.   editor.
  629.  
  630.     PropertyType
  631.       The type information pointer returned by the TypeInfo built-in function
  632.       (e.g. TypeInfo(TMyRange) or TypeInfo(TShapes)).
  633.  
  634.     ComponentClass
  635.       Type type of the component to which to restrict this type editor.  This
  636.       parameter can be left nil which will mean this type editor applies to all
  637.       properties of PropertyType.
  638.  
  639.     PropertyName
  640.       The name of the property to which to restrict this type editor.  This
  641.       parameter is ignored if ComponentClass is nil.  This paramter can be
  642.       an empty string ('') which will mean that this editor applies to all
  643.       properties of PropertyType in ComponentClass.
  644.  
  645.     EditorClass
  646.       The class of the editor to be created whenever a property of the type
  647.       passed in PropertyTypeInfo is displayed in the Object Inspector.  The
  648.       class will be created by calling EditorClass.Create. }
  649.  
  650. procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  651.   const PropertyName: string; EditorClass: TPropertyEditorClass);
  652.  
  653. procedure RegisterPropertyMapper(Mapper: TPropertyMapperFunc);
  654.  
  655. procedure GetComponentProperties(Components: TComponentList;
  656.   Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);
  657.  
  658. procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  659.   ComponentEditor: TComponentEditorClass);
  660.  
  661. function GetComponentEditor(Component: TComponent;
  662.   Designer: TFormDesigner): TComponentEditor;
  663.  
  664. implementation
  665.  
  666. uses Windows, Menus, Dialogs, Consts, IniFiles;
  667.  
  668. type
  669.   TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;
  670.  
  671. type
  672.   PPropertyClassRec = ^TPropertyClassRec;
  673.   TPropertyClassRec = record
  674.     Next: PPropertyClassRec;
  675.     PropertyType: PTypeInfo;
  676.     PropertyName: string;
  677.     ComponentClass: TClass;
  678.     EditorClass: TPropertyEditorClass;
  679.   end;
  680.  
  681. type
  682.   PPropertyMapperRec = ^TPropertyMapperRec;
  683.   TPropertyMapperRec = record
  684.     Next: PPropertyMapperRec;
  685.     Mapper: TPropertyMapperFunc;
  686.   end;
  687.  
  688. const
  689.   PropClassMap: array[TTypeKind] of TPropertyEditorClass = (
  690.     TPropertyEditor, TIntegerProperty, TCharProperty, TEnumProperty,
  691.     TFloatProperty, TStringProperty, TSetProperty, TClassProperty,
  692.     TMethodProperty, TPropertyEditor, TStringProperty, TPropertyEditor,
  693.     TPropertyEditor);
  694.  
  695. var
  696.   PropertyClassList: PPropertyClassRec = nil;
  697.   PropertyMapperList: PPropertyMapperRec = nil;
  698.  
  699. const
  700.  
  701.   { context ids for the Font editor and the Color Editor, etc. }
  702.   hcDFontEditor       = 25000;
  703.   hcDColorEditor      = 25010;
  704.   hcDMediaPlayerOpen  = 25020;
  705.  
  706. { TComponentList }
  707.  
  708. constructor TComponentList.Create;
  709. begin
  710.   inherited Create;
  711.   FList := TList.Create;
  712. end;
  713.  
  714. destructor TComponentList.Destroy;
  715. begin
  716.   FList.Free;
  717.   inherited Destroy;
  718. end;
  719.  
  720. function TComponentList.Get(Index: Integer): TComponent;
  721. begin
  722.   Result := FList[Index];
  723. end;
  724.  
  725. function TComponentList.GetCount: Integer;
  726. begin
  727.   Result := FList.Count;
  728. end;
  729.  
  730. function TComponentList.Add(Item: TComponent): Integer;
  731. begin
  732.   Result := FList.Add(Item);
  733. end;
  734.  
  735. function TComponentList.Equals(List: TComponentList): Boolean;
  736. var
  737.   I: Integer;
  738. begin
  739.   Result := False;
  740.   if List.Count <> FList.Count then Exit;
  741.   for I := 0 to List.Count - 1 do if List[I] <> FList[I] then Exit;
  742.   Result := True;
  743. end;
  744.  
  745. { TPropertyEditor }
  746.  
  747. constructor TPropertyEditor.Create(ADesigner: TFormDesigner;
  748.   APropCount: Integer);
  749. begin
  750.   FDesigner := ADesigner;
  751.   GetMem(FPropList, APropCount * SizeOf(TInstProp));
  752.   FPropCount := APropCount;
  753. end;
  754.  
  755. destructor TPropertyEditor.Destroy;
  756. begin
  757.   if FPropList <> nil then
  758.     FreeMem(FPropList, FPropCount * SizeOf(TInstProp));
  759. end;
  760.  
  761. procedure TPropertyEditor.Activate;
  762. begin
  763. end;
  764.  
  765. function TPropertyEditor.AllEqual: Boolean;
  766. begin
  767.   Result := FPropCount = 1;
  768. end;
  769.  
  770. procedure TPropertyEditor.Edit;
  771. type
  772.   TGetStrFunc = function(const Value: string): Integer of object;
  773. var
  774.   I: Integer;
  775.   Values: TStringList;
  776.   AddValue: TGetStrFunc;
  777. begin
  778.   Values := TStringList.Create;
  779.   Values.Sorted := paSortList in GetAttributes;
  780.   try
  781.     AddValue := Values.Add;
  782.     GetValues(TGetStrProc(AddValue));
  783.     if Values.Count > 0 then
  784.     begin
  785.       I := Values.IndexOf(Value) + 1;
  786.       if I = Values.Count then I := 0;
  787.       Value := Values[I];
  788.     end;
  789.   finally
  790.     Values.Free;
  791.   end;
  792. end;
  793.  
  794. function TPropertyEditor.GetAttributes: TPropertyAttributes;
  795. begin
  796.   Result := [paMultiSelect, paRevertable];
  797. end;
  798.  
  799. function TPropertyEditor.GetComponent(Index: Integer): TComponent;
  800. begin
  801.   Result := FPropList^[Index].Instance;
  802. end;
  803.  
  804. function TPropertyEditor.GetFloatValue: Extended;
  805. begin
  806.   Result := GetFloatValueAt(0);
  807. end;
  808.  
  809. function TPropertyEditor.GetFloatValueAt(Index: Integer): Extended;
  810. begin
  811.   with FPropList^[Index] do Result := GetFloatProp(Instance, PropInfo);
  812. end;
  813.  
  814. function TPropertyEditor.GetMethodValue: TMethod;
  815. begin
  816.   Result := GetMethodValueAt(0);
  817. end;
  818.  
  819. function TPropertyEditor.GetMethodValueAt(Index: Integer): TMethod;
  820. begin
  821.   with FPropList^[Index] do Result := GetMethodProp(Instance, PropInfo);
  822. end;
  823.  
  824. function TPropertyEditor.GetEditLimit: Integer;
  825. begin
  826.   Result := 255;
  827. end;
  828.  
  829. function TPropertyEditor.GetName: string;
  830. begin
  831.   Result := FPropList^[0].PropInfo^.Name;
  832. end;
  833.  
  834. function TPropertyEditor.GetOrdValue: Longint;
  835. begin
  836.   Result := GetOrdValueAt(0);
  837. end;
  838.  
  839. function TPropertyEditor.GetOrdValueAt(Index: Integer): Longint;
  840. begin
  841.   with FPropList^[Index] do Result := GetOrdProp(Instance, PropInfo);
  842. end;
  843.  
  844. function TPropertyEditor.GetPrivateDirectory: string;
  845. begin
  846.   Result := Designer.GetPrivateDirectory;
  847. end;
  848.  
  849. procedure TPropertyEditor.GetProperties(Proc: TGetPropEditProc);
  850. begin
  851. end;
  852.  
  853. function TPropertyEditor.GetPropInfo: PPropInfo;
  854. begin
  855.   Result := FPropList^[0].PropInfo;
  856. end;
  857.  
  858. function TPropertyEditor.GetPropType: PTypeInfo;
  859. begin
  860.   Result := FPropList^[0].PropInfo^.PropType;
  861. end;
  862.  
  863. function TPropertyEditor.GetStrValue: string;
  864. begin
  865.   Result := GetStrValueAt(0);
  866. end;
  867.  
  868. function TPropertyEditor.GetStrValueAt(Index: Integer): string;
  869. begin
  870.   with FPropList^[Index] do Result := GetStrProp(Instance, PropInfo);
  871. end;
  872.  
  873. function TPropertyEditor.GetVarValue: Variant;
  874. begin
  875.   Result := GetVarValueAt(0);
  876. end;
  877.  
  878. function TPropertyEditor.GetVarValueAt(Index: Integer): Variant;
  879. begin
  880.   VarClear(Result);
  881.   with FPropList^[Index] do Result := GetVariantProp(Instance, PropInfo);
  882. end;
  883.  
  884. function TPropertyEditor.GetValue: string;
  885. begin
  886.   Result := LoadStr(srUnknown);
  887. end;
  888.  
  889. procedure TPropertyEditor.GetValues(Proc: TGetStrProc);
  890. begin
  891. end;
  892.  
  893. procedure TPropertyEditor.Initialize;
  894. begin
  895. end;
  896.  
  897. procedure TPropertyEditor.Modified;
  898. begin
  899.   Designer.Modified;
  900. end;
  901.  
  902. procedure TPropertyEditor.SetFloatValue(Value: Extended);
  903. var
  904.   I: Integer;
  905. begin
  906.   for I := 0 to FPropCount - 1 do
  907.     with FPropList^[I] do SetFloatProp(Instance, PropInfo, Value);
  908.   Modified;
  909. end;
  910.  
  911. procedure TPropertyEditor.SetMethodValue(const Value: TMethod);
  912. var
  913.   I: Integer;
  914. begin
  915.   for I := 0 to FPropCount - 1 do
  916.     with FPropList^[I] do SetMethodProp(Instance, PropInfo, Value);
  917.   Modified;
  918. end;
  919.  
  920. procedure TPropertyEditor.SetOrdValue(Value: Longint);
  921. var
  922.   I: Integer;
  923. begin
  924.   for I := 0 to FPropCount - 1 do
  925.     with FPropList^[I] do SetOrdProp(Instance, PropInfo, Value);
  926.   Modified;
  927. end;
  928.  
  929. procedure TPropertyEditor.SetPropEntry(Index: Integer;
  930.   AInstance: TComponent; APropInfo: PPropInfo);
  931. begin
  932.   with FPropList^[Index] do
  933.   begin
  934.     Instance := AInstance;
  935.     PropInfo := APropInfo;
  936.   end;
  937. end;
  938.  
  939. procedure TPropertyEditor.SetStrValue(const Value: string);
  940. var
  941.   I: Integer;
  942. begin
  943.   for I := 0 to FPropCount - 1 do
  944.     with FPropList^[I] do SetStrProp(Instance, PropInfo, Value);
  945.   Modified;
  946. end;
  947.  
  948. procedure TPropertyEditor.SetVarValue(const Value: Variant);
  949. var
  950.   I: Integer;
  951. begin
  952.   for I := 0 to FPropCount - 1 do
  953.     with FPropList^[I] do SetVariantProp(Instance, PropInfo, Value);
  954.   Modified;
  955. end;
  956.  
  957. procedure TPropertyEditor.Revert;
  958. var
  959.   I: Integer;
  960. begin
  961.   for I := 0 to FPropCount - 1 do
  962.     with FPropList^[I] do Designer.Revert(Instance, PropInfo);
  963. end;
  964.  
  965. procedure TPropertyEditor.SetValue(const Value: string);
  966. begin
  967. end;
  968.  
  969. function TPropertyEditor.ValueAvailable: Boolean;
  970. var
  971.   I: Integer;
  972.   S: string;
  973. begin
  974.   Result := True;
  975.   for I := 0 to FPropCount - 1 do
  976.   begin
  977.     if csCheckPropAvail in FPropList^[I].Instance.ComponentStyle then
  978.     begin
  979.       try
  980.         S := GetValue;
  981.         AllEqual;
  982.       except
  983.         Result := False;
  984.       end;
  985.       Exit;
  986.     end;
  987.   end;
  988. end;
  989.  
  990. { TOrdinalProperty }
  991.  
  992. function TOrdinalProperty.AllEqual: Boolean;
  993. var
  994.   I: Integer;
  995.   V: Longint;
  996. begin
  997.   Result := False;
  998.   if PropCount > 1 then
  999.   begin
  1000.     V := GetOrdValue;
  1001.     for I := 1 to PropCount - 1 do
  1002.       if GetOrdValueAt(I) <> V then Exit;
  1003.   end;
  1004.   Result := True;
  1005. end;
  1006.  
  1007. function TOrdinalProperty.GetEditLimit: Integer;
  1008. begin
  1009.   Result := 63;
  1010. end;
  1011.  
  1012. { TIntegerProperty }
  1013.  
  1014. function TIntegerProperty.GetValue: string;
  1015. begin
  1016.   Result := IntToStr(GetOrdValue);
  1017. end;
  1018.  
  1019. procedure TIntegerProperty.SetValue(const Value: String);
  1020. var
  1021.   L: Longint;
  1022. begin
  1023.   L := StrToInt(Value);
  1024.   with GetTypeData(GetPropType)^ do
  1025.     if (L < MinValue) or (L > MaxValue) then
  1026.      {NOTE: C++ 'unsigned long', unlike Cardinals, stretch up to 4G }
  1027.      if not ((MinValue = 0) and (MaxValue = -1)) then
  1028.       raise EPropertyError.CreateResFmt(SOutOfRange, [MinValue, MaxValue]);
  1029.   SetOrdValue(L);
  1030. end;
  1031.  
  1032. { TCharProperty }
  1033.  
  1034. function TCharProperty.GetValue: string;
  1035. var
  1036.   Ch: Char;
  1037. begin
  1038.   Ch := Chr(GetOrdValue);
  1039.   if Ch in [#33..#127] then
  1040.     Result := Ch else
  1041.     FmtStr(Result, '#%d', [Ord(Ch)]);
  1042. end;
  1043.  
  1044. procedure TCharProperty.SetValue(const Value: string);
  1045. var
  1046.   L: Longint;
  1047. begin
  1048.   if Length(Value) = 0 then L := 0 else
  1049.     if Length(Value) = 1 then L := Ord(Value[1]) else
  1050.       if Value[1] = '#' then L := StrToInt(Copy(Value, 2, Maxint)) else
  1051.         raise EPropertyError.CreateRes(SInvalidPropertyValue);
  1052.   with GetTypeData(GetPropType)^ do
  1053.     if (L < MinValue) or (L > MaxValue) then
  1054.       raise EPropertyError.CreateResFmt(SOutOfRange, [MinValue, MaxValue]);
  1055.   SetOrdValue(L);
  1056. end;
  1057.  
  1058. { TEnumProperty }
  1059.  
  1060. function TEnumProperty.GetAttributes: TPropertyAttributes;
  1061. begin
  1062.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1063. end;
  1064.  
  1065. function TEnumProperty.GetValue: string;
  1066. var
  1067.   L: Longint;
  1068. begin
  1069.   L := GetOrdValue;
  1070.   with GetTypeData(GetPropType)^ do
  1071.     if (L < MinValue) or (L > MaxValue) then L := MaxValue;
  1072.   Result := GetEnumName(GetPropType, L);
  1073. end;
  1074.  
  1075. procedure TEnumProperty.GetValues(Proc: TGetStrProc);
  1076. var
  1077.   I: Integer;
  1078.   EnumType: PTypeInfo;
  1079. begin
  1080.   EnumType := GetPropType;
  1081.   with GetTypeData(EnumType)^ do
  1082.     for I := MinValue to MaxValue do Proc(GetEnumName(EnumType, I));
  1083. end;
  1084.  
  1085. procedure TEnumProperty.SetValue(const Value: string);
  1086. var
  1087.   I: Integer;
  1088. begin
  1089.   I := GetEnumValue(GetPropType, Value);
  1090.   if I < 0 then raise EPropertyError.CreateRes(SInvalidPropertyValue);
  1091.   SetOrdValue(I);
  1092. end;
  1093.  
  1094. { TFloatProperty }
  1095.  
  1096. function TFloatProperty.AllEqual: Boolean;
  1097. var
  1098.   I: Integer;
  1099.   V: Extended;
  1100. begin
  1101.   Result := False;
  1102.   if PropCount > 1 then
  1103.   begin
  1104.     V := GetFloatValue;
  1105.     for I := 1 to PropCount - 1 do
  1106.       if GetFloatValueAt(I) <> V then Exit;
  1107.   end;
  1108.   Result := True;
  1109. end;
  1110.  
  1111. function TFloatProperty.GetValue: string;
  1112. const
  1113.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 18);
  1114. begin
  1115.   Result := FloatToStrF(GetFloatValue, ffGeneral,
  1116.     Precisions[GetTypeData(GetPropType)^.FloatType], 0);
  1117. end;
  1118.  
  1119. procedure TFloatProperty.SetValue(const Value: string);
  1120. begin
  1121.   SetFloatValue(StrToFloat(Value));
  1122. end;
  1123.  
  1124. { TStringProperty }
  1125.  
  1126. function TStringProperty.AllEqual: Boolean;
  1127. var
  1128.   I: Integer;
  1129.   V: string;
  1130. begin
  1131.   Result := False;
  1132.   if PropCount > 1 then
  1133.   begin
  1134.     V := GetStrValue;
  1135.     for I := 1 to PropCount - 1 do
  1136.       if GetStrValueAt(I) <> V then Exit;
  1137.   end;
  1138.   Result := True;
  1139. end;
  1140.  
  1141. function TStringProperty.GetEditLimit: Integer;
  1142. begin
  1143.   if GetPropType^.Kind = tkString then
  1144.     Result := GetTypeData(GetPropType)^.MaxLength else
  1145.     Result := 255;
  1146. end;
  1147.  
  1148. function TStringProperty.GetValue: string;
  1149. begin
  1150.   Result := GetStrValue;
  1151. end;
  1152.  
  1153. procedure TStringProperty.SetValue(const Value: string);
  1154. begin
  1155.   SetStrValue(Value);
  1156. end;
  1157.  
  1158. { TComponentNameProperty }
  1159.  
  1160. function TComponentNameProperty.GetAttributes: TPropertyAttributes;
  1161. begin
  1162.   Result := [];
  1163. end;
  1164.  
  1165. function TComponentNameProperty.GetEditLimit: Integer;
  1166. begin
  1167.   Result := 32;
  1168. end;
  1169.  
  1170. { TSetElementProperty }
  1171.  
  1172. constructor TSetElementProperty.Create(ADesigner: TFormDesigner;
  1173.   APropList: PInstPropList; APropCount: Integer; AElement: Integer);
  1174. begin
  1175.   FDesigner := ADesigner;
  1176.   FPropList := APropList;
  1177.   FPropCount := APropCount;
  1178.   FElement := AElement;
  1179. end;
  1180.  
  1181. destructor TSetElementProperty.Destroy;
  1182. begin
  1183. end;
  1184.  
  1185. function TSetElementProperty.AllEqual: Boolean;
  1186. var
  1187.   I: Integer;
  1188.   S: TIntegerSet;
  1189.   V: Boolean;
  1190. begin
  1191.   Result := False;
  1192.   if PropCount > 1 then
  1193.   begin
  1194.     Integer(S) := GetOrdValue;
  1195.     V := FElement in S;
  1196.     for I := 1 to PropCount - 1 do
  1197.     begin
  1198.       Integer(S) := GetOrdValueAt(I);
  1199.       if (FElement in S) <> V then Exit;
  1200.     end;
  1201.   end;
  1202.   Result := True;
  1203. end;
  1204.  
  1205. function TSetElementProperty.GetAttributes: TPropertyAttributes;
  1206. begin
  1207.   Result := [paMultiSelect, paValueList, paSortList];
  1208. end;
  1209.  
  1210. function TSetElementProperty.GetName: string;
  1211. begin
  1212.   Result := GetEnumName(GetTypeData(GetPropType)^.CompType, FElement);
  1213. end;
  1214.  
  1215. function TSetElementProperty.GetValue: string;
  1216. var
  1217.   S: TIntegerSet;
  1218. begin
  1219.   Integer(S) := GetOrdValue;
  1220.   if FElement in S then Result := 'true' else Result := 'false';
  1221. end;
  1222.  
  1223. procedure TSetElementProperty.GetValues(Proc: TGetStrProc);
  1224. begin
  1225.   Proc('false');
  1226.   Proc('true');
  1227. end;
  1228.  
  1229. procedure TSetElementProperty.SetValue(const Value: string);
  1230. var
  1231.   S: TIntegerSet;
  1232. begin
  1233.   Integer(S) := GetOrdValue;
  1234.   if CompareText(Value, 'True') = 0 then
  1235.     Include(S, FElement) else
  1236.     Exclude(S, FElement);
  1237.   SetOrdValue(Integer(S));
  1238. end;
  1239.  
  1240. { TSetProperty }
  1241.  
  1242. function TSetProperty.GetAttributes: TPropertyAttributes;
  1243. begin
  1244.   Result := [paMultiSelect, paSubProperties, paReadOnly, paRevertable];
  1245. end;
  1246.  
  1247. procedure TSetProperty.GetProperties(Proc: TGetPropEditProc);
  1248. var
  1249.   I: Integer;
  1250. begin
  1251.   with GetTypeData(GetTypeData(GetPropType)^.CompType)^ do
  1252.     for I := MinValue to MaxValue do
  1253.       Proc(TSetElementProperty.Create(FDesigner, FPropList, FPropCount, I));
  1254. end;
  1255.  
  1256. function TSetProperty.GetValue: string;
  1257. var
  1258.   S: TIntegerSet;
  1259.   TypeInfo: PTypeInfo;
  1260.   I: Integer;
  1261. begin
  1262.   Integer(S) := GetOrdValue;
  1263.   TypeInfo := GetTypeData(GetPropType)^.CompType;
  1264.   Result := '[';
  1265.   for I := 0 to SizeOf(Integer) * 8 - 1 do
  1266.     if I in S then
  1267.     begin
  1268.       if Length(Result) <> 1 then Result := Result + ',';
  1269.       Result := Result + GetEnumName(TypeInfo, I);
  1270.     end;
  1271.   Result := Result + ']';
  1272. end;
  1273.  
  1274. { TClassProperty }
  1275.  
  1276. function TClassProperty.GetAttributes: TPropertyAttributes;
  1277. begin
  1278.   Result := [paMultiSelect, paSubProperties, paReadOnly];
  1279. end;
  1280.  
  1281. procedure TClassProperty.GetProperties(Proc: TGetPropEditProc);
  1282. var
  1283.   I: Integer;
  1284.   Components: TComponentList;
  1285. begin
  1286.   Components := TComponentList.Create;
  1287.   try
  1288.     for I := 0 to PropCount - 1 do
  1289.       Components.Add(TComponent(GetOrdValueAt(I)));
  1290.     GetComponentProperties(Components, tkProperties, Designer, Proc);
  1291.   finally
  1292.     Components.Free;
  1293.   end;
  1294. end;
  1295.  
  1296. function TClassProperty.GetValue: string;
  1297. begin
  1298.   FmtStr(Result, '(%s)', [GetPropType^.Name]);
  1299. end;
  1300.  
  1301. { TComponentProperty }
  1302.  
  1303. function TComponentProperty.GetAttributes: TPropertyAttributes;
  1304. begin
  1305.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1306. end;
  1307.  
  1308. function TComponentProperty.GetEditLimit: Integer;
  1309. begin
  1310.   Result := 127;
  1311. end;
  1312.  
  1313. function TComponentProperty.GetValue: string;
  1314. begin
  1315.   Result := Designer.GetComponentName(TComponent(GetOrdValue));
  1316. end;
  1317.  
  1318. procedure TComponentProperty.GetValues(Proc: TGetStrProc);
  1319. begin
  1320.   Designer.GetComponentNames(GetTypeData(GetPropType), Proc);
  1321. end;
  1322.  
  1323. procedure TComponentProperty.SetValue(const Value: string);
  1324. var
  1325.   Component: TComponent;
  1326. begin
  1327.   if Value = '' then Component := nil else
  1328.   begin
  1329.     Component := Designer.GetComponent(Value);
  1330.     if not (Component is GetTypeData(GetPropType)^.ClassType) then
  1331.       raise EPropertyError.CreateRes(SInvalidPropertyValue);
  1332.   end;
  1333.   SetOrdValue(Longint(Component));
  1334. end;
  1335.  
  1336. { TMethodProperty }
  1337.  
  1338. function TMethodProperty.AllEqual: Boolean;
  1339. var
  1340.   I: Integer;
  1341.   V, T: TMethod;
  1342. begin
  1343.   Result := False;
  1344.   if PropCount > 1 then
  1345.   begin
  1346.     V := GetMethodValue;
  1347.     for I := 1 to PropCount - 1 do
  1348.     begin
  1349.       T := GetMethodValueAt(I);
  1350.       if (T.Code <> V.Code) or (T.Data <> V.Data) then Exit;
  1351.     end;
  1352.   end;
  1353.   Result := True;
  1354. end;
  1355.  
  1356. procedure TMethodProperty.Edit;
  1357. var
  1358.   FormMethodName, EventName: string;
  1359. begin
  1360.   FormMethodName := GetValue;
  1361.   if (FormMethodName = '') or
  1362.     Designer.MethodFromAncestor(GetMethodValue) then
  1363.   begin
  1364.     if FormMethodName = '' then
  1365.     begin
  1366.       if GetComponent(0) = Designer.Form then
  1367.         FormMethodName := 'Form' else
  1368.         FormMethodName := GetComponent(0).Name;
  1369.       if FormMethodName = '' then
  1370.         raise EPropertyError.CreateRes(SCannotCreateName);
  1371.       EventName := GetName;
  1372.       if CompareText(Copy(EventName, 1, 2), 'ON') = 0 then
  1373.         EventName := Copy(EventName, 3, Maxint);
  1374.       FormMethodName := FormMethodName + EventName;
  1375.     end;
  1376.     SetMethodValue(Designer.CreateMethod(FormMethodName,
  1377.       GetTypeData(GetPropType)));
  1378.   end;
  1379.   Designer.ShowMethod(FormMethodName);
  1380. end;
  1381.  
  1382. function TMethodProperty.GetAttributes: TPropertyAttributes;
  1383. begin
  1384.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1385. end;
  1386.  
  1387. function TMethodProperty.GetEditLimit: Integer;
  1388. begin
  1389.   Result := 32;
  1390. end;
  1391.  
  1392. function TMethodProperty.GetValue: string;
  1393. begin
  1394.   Result := Designer.GetMethodName(GetMethodValue);
  1395. end;
  1396.  
  1397. procedure TMethodProperty.GetValues(Proc: TGetStrProc);
  1398. begin
  1399.   Designer.GetMethods(GetTypeData(GetPropType), Proc);
  1400. end;
  1401.  
  1402. procedure TMethodProperty.SetValue(const AValue: string);
  1403. var
  1404.   NewMethod: Boolean;
  1405.   CurValue: string;
  1406. begin
  1407.   CurValue:= GetValue;
  1408.   if (CurValue <> '') and (AValue <> '') and
  1409.     ((CompareText(CurValue, AValue) = 0) or
  1410.     not Designer.MethodExists(AValue)) then
  1411.     Designer.RenameMethod(CurValue, AValue)
  1412.   else
  1413.   begin
  1414.     NewMethod := (AValue <> '') and not Designer.MethodExists(AValue);
  1415.     SetMethodValue(Designer.CreateMethod(AValue, GetTypeData(GetPropType)));
  1416.     if NewMethod then Designer.ShowMethod(AValue);
  1417.   end;
  1418. end;
  1419.  
  1420. { TFontNameProperty }
  1421.  
  1422. function TFontNameProperty.GetAttributes: TPropertyAttributes;
  1423. begin
  1424.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1425. end;
  1426.  
  1427. procedure TFontNameProperty.GetValues(Proc: TGetStrProc);
  1428. var
  1429.   I: Integer;
  1430. begin
  1431.   for I := 0 to Screen.Fonts.Count - 1 do Proc(Screen.Fonts[I]);
  1432. end;
  1433.  
  1434. { TFontCharsetProperty }
  1435.  
  1436. function TFontCharsetProperty.GetAttributes: TPropertyAttributes;
  1437. begin
  1438.   Result := [paMultiSelect, paSortList, paValueList];
  1439. end;
  1440.  
  1441. function TFontCharsetProperty.GetValue: string;
  1442. begin
  1443.   if not CharsetToIdent(TFontCharset(GetOrdValue), Result) then
  1444.     FmtStr(Result, '%d', [GetOrdValue]);
  1445. end;
  1446.  
  1447. procedure TFontCharsetProperty.GetValues(Proc: TGetStrProc);
  1448. begin
  1449.   GetCharsetValues(Proc);
  1450. end;
  1451.  
  1452. procedure TFontCharsetProperty.SetValue(const Value: string);
  1453. var
  1454.   NewValue: Longint;
  1455. begin
  1456.   if IdentToCharset(Value, NewValue) then
  1457.     SetOrdValue(NewValue)
  1458.   else inherited SetValue(Value);
  1459. end;
  1460.  
  1461. { TImeNameProperty }
  1462.  
  1463. function TImeNameProperty.GetAttributes: TPropertyAttributes;
  1464. begin
  1465.   Result := [paValueList, paSortList, paMultiSelect];
  1466. end;
  1467.  
  1468. procedure TImeNameProperty.GetValues(Proc: TGetStrProc);
  1469. var
  1470.   I: Integer;
  1471. begin
  1472.   for I := 0 to Screen.Imes.Count - 1 do Proc(Screen.Imes[I]);
  1473. end;
  1474.  
  1475. { TMPFilenameProperty }
  1476.  
  1477. procedure TMPFilenameProperty.Edit;
  1478. var
  1479.   MPFileOpen: TOpenDialog;
  1480. begin
  1481.   MPFileOpen := TOpenDialog.Create(Application);
  1482.   MPFileOpen.Filename := GetValue;
  1483.   MPFileOpen.Filter := LoadStr(SMPOpenFilter);
  1484.   MPFileOpen.HelpContext := hcDMediaPlayerOpen;
  1485.   MPFileOpen.Options := MPFileOpen.Options + [ofShowHelp, ofPathMustExist,
  1486.     ofFileMustExist];
  1487.   try
  1488.     if MPFileOpen.Execute then SetValue(MPFileOpen.Filename);
  1489.   finally
  1490.     MPFileOpen.Free;
  1491.   end;
  1492. end;
  1493.  
  1494. function TMPFilenameProperty.GetAttributes: TPropertyAttributes;
  1495. begin
  1496.   Result := [paDialog, paRevertable];
  1497. end;
  1498.  
  1499. { TColorProperty }
  1500.  
  1501. procedure TColorProperty.Edit;
  1502. var
  1503.   ColorDialog: TColorDialog;
  1504.   IniFile: TIniFile;
  1505.  
  1506.   procedure GetCustomColors;
  1507.   begin
  1508.     IniFile := TIniFile.Create('DELPHI32.INI');
  1509.     try
  1510.       IniFile.ReadSectionValues(LoadStr(SCustomColors),
  1511.         ColorDialog.CustomColors);
  1512.     except
  1513.       { Ignore errors reading values }
  1514.     end;
  1515.   end;
  1516.  
  1517.   procedure SaveCustomColors;
  1518.   var
  1519.     I, P: Integer;
  1520.     S: string;
  1521.   begin
  1522.     if IniFile <> nil then
  1523.       with ColorDialog do
  1524.         for I := 0 to CustomColors.Count - 1 do
  1525.         begin
  1526.           S := CustomColors.Strings[I];
  1527.           P := Pos('=', S);
  1528.           if P <> 0 then
  1529.           begin
  1530.             S := Copy(S, 1, P - 1);
  1531.             IniFile.WriteString(LoadStr(SCustomColors), S,
  1532.               CustomColors.Values[S]);
  1533.           end;
  1534.         end;
  1535.   end;
  1536.  
  1537. begin
  1538.   IniFile := nil;
  1539.   ColorDialog := TColorDialog.Create(Application);
  1540.   try
  1541.     GetCustomColors;
  1542.     ColorDialog.Color := GetOrdValue;
  1543.     ColorDialog.HelpContext := hcDColorEditor;
  1544.     ColorDialog.Options := [cdShowHelp];
  1545.     if ColorDialog.Execute then SetOrdValue(ColorDialog.Color);
  1546.     SaveCustomColors;
  1547.   finally
  1548.     if IniFile <> nil then IniFile.Free;
  1549.     ColorDialog.Free;
  1550.   end;
  1551. end;
  1552.  
  1553. function TColorProperty.GetAttributes: TPropertyAttributes;
  1554. begin
  1555.   Result := [paMultiSelect, paDialog, paValueList, paRevertable];
  1556. end;
  1557.  
  1558. function TColorProperty.GetValue: string;
  1559. begin
  1560.   Result := ColorToString(TColor(GetOrdValue));
  1561. end;
  1562.  
  1563. procedure TColorProperty.GetValues(Proc: TGetStrProc);
  1564. begin
  1565.   GetColorValues(Proc);
  1566. end;
  1567.  
  1568. procedure TColorProperty.SetValue(const Value: string);
  1569. var
  1570.   NewValue: Longint;
  1571. begin
  1572.   if IdentToColor(Value, NewValue) then
  1573.     SetOrdValue(NewValue)
  1574.   else inherited SetValue(Value);
  1575. end;
  1576.  
  1577. { TCursorProperty }
  1578.  
  1579. function TCursorProperty.GetAttributes: TPropertyAttributes;
  1580. begin
  1581.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1582. end;
  1583.  
  1584. function TCursorProperty.GetValue: string;
  1585. begin
  1586.   Result := CursorToString(TCursor(GetOrdValue));
  1587. end;
  1588.  
  1589. procedure TCursorProperty.GetValues(Proc: TGetStrProc);
  1590. begin
  1591.   GetCursorValues(Proc);
  1592. end;
  1593.  
  1594. procedure TCursorProperty.SetValue(const Value: string);
  1595. var
  1596.   NewValue: Longint;
  1597. begin
  1598.   if IdentToCursor(Value, NewValue) then
  1599.     SetOrdValue(NewValue)
  1600.   else inherited SetValue(Value);
  1601. end;
  1602.  
  1603. { TFontProperty }
  1604.  
  1605. procedure TFontProperty.Edit;
  1606. var
  1607.   FontDialog: TFontDialog;
  1608. begin
  1609.   FontDialog := TFontDialog.Create(Application);
  1610.   try
  1611.     FontDialog.Font := TFont(GetOrdValue);
  1612.     FontDialog.HelpContext := hcDFontEditor;
  1613.     FontDialog.Options := FontDialog.Options + [fdShowHelp, fdForceFontExist];
  1614.     if FontDialog.Execute then SetOrdValue(Longint(FontDialog.Font));
  1615.   finally
  1616.     FontDialog.Free;
  1617.   end;
  1618. end;
  1619.  
  1620. function TFontProperty.GetAttributes: TPropertyAttributes;
  1621. begin
  1622.   Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
  1623. end;
  1624.  
  1625. { TModalResultProperty }
  1626.  
  1627. const
  1628.   ModalResults: array[mrNone..mrNo] of string = (
  1629.     'mrNone',
  1630.     'mrOk',
  1631.     'mrCancel',
  1632.     'mrAbort',
  1633.     'mrRetry',
  1634.     'mrIgnore',
  1635.     'mrYes',
  1636.     'mrNo');
  1637.  
  1638. function TModalResultProperty.GetAttributes: TPropertyAttributes;
  1639. begin
  1640.   Result := [paMultiSelect, paValueList, paRevertable];
  1641. end;
  1642.  
  1643. function TModalResultProperty.GetValue: string;
  1644. var
  1645.   CurValue: Longint;
  1646. begin
  1647.   CurValue := GetOrdValue;
  1648.   case CurValue of
  1649.     Low(ModalResults)..High(ModalResults):
  1650.       Result := ModalResults[CurValue];
  1651.   else
  1652.     Result := IntToStr(CurValue);
  1653.   end;
  1654. end;
  1655.  
  1656. procedure TModalResultProperty.GetValues(Proc: TGetStrProc);
  1657. var
  1658.   I: Integer;
  1659. begin
  1660.   for I := Low(ModalResults) to High(ModalResults) do Proc(ModalResults[I]);
  1661. end;
  1662.  
  1663. procedure TModalResultProperty.SetValue(const Value: string);
  1664. var
  1665.   I: Integer;
  1666. begin
  1667.   if Value = '' then
  1668.   begin
  1669.     SetOrdValue(0);
  1670.     Exit;
  1671.   end;
  1672.   for I := Low(ModalResults) to High(ModalResults) do
  1673.     if CompareText(ModalResults[I], Value) = 0 then
  1674.     begin
  1675.       SetOrdValue(I);
  1676.       Exit;
  1677.     end;
  1678.   inherited SetValue(Value);
  1679. end;
  1680.  
  1681. { TShortCutProperty }
  1682.  
  1683. const
  1684.   ShortCuts: array[0..82] of TShortCut = (
  1685.     scNone,
  1686.     Byte('A') or scCtrl,
  1687.     Byte('B') or scCtrl,
  1688.     Byte('C') or scCtrl,
  1689.     Byte('D') or scCtrl,
  1690.     Byte('E') or scCtrl,
  1691.     Byte('F') or scCtrl,
  1692.     Byte('G') or scCtrl,
  1693.     Byte('H') or scCtrl,
  1694.     Byte('I') or scCtrl,
  1695.     Byte('J') or scCtrl,
  1696.     Byte('K') or scCtrl,
  1697.     Byte('L') or scCtrl,
  1698.     Byte('M') or scCtrl,
  1699.     Byte('N') or scCtrl,
  1700.     Byte('O') or scCtrl,
  1701.     Byte('P') or scCtrl,
  1702.     Byte('Q') or scCtrl,
  1703.     Byte('R') or scCtrl,
  1704.     Byte('S') or scCtrl,
  1705.     Byte('T') or scCtrl,
  1706.     Byte('U') or scCtrl,
  1707.     Byte('V') or scCtrl,
  1708.     Byte('W') or scCtrl,
  1709.     Byte('X') or scCtrl,
  1710.     Byte('Y') or scCtrl,
  1711.     Byte('Z') or scCtrl,
  1712.     VK_F1,
  1713.     VK_F2,
  1714.     VK_F3,
  1715.     VK_F4,
  1716.     VK_F5,
  1717.     VK_F6,
  1718.     VK_F7,
  1719.     VK_F8,
  1720.     VK_F9,
  1721.     VK_F10,
  1722.     VK_F11,
  1723.     VK_F12,
  1724.     VK_F1 or scCtrl,
  1725.     VK_F2 or scCtrl,
  1726.     VK_F3 or scCtrl,
  1727.     VK_F4 or scCtrl,
  1728.     VK_F5 or scCtrl,
  1729.     VK_F6 or scCtrl,
  1730.     VK_F7 or scCtrl,
  1731.     VK_F8 or scCtrl,
  1732.     VK_F9 or scCtrl,
  1733.     VK_F10 or scCtrl,
  1734.     VK_F11 or scCtrl,
  1735.     VK_F12 or scCtrl,
  1736.     VK_F1 or scShift,
  1737.     VK_F2 or scShift,
  1738.     VK_F3 or scShift,
  1739.     VK_F4 or scShift,
  1740.     VK_F5 or scShift,
  1741.     VK_F6 or scShift,
  1742.     VK_F7 or scShift,
  1743.     VK_F8 or scShift,
  1744.     VK_F9 or scShift,
  1745.     VK_F10 or scShift,
  1746.     VK_F11 or scShift,
  1747.     VK_F12 or scShift,
  1748.     VK_F1 or scShift or scCtrl,
  1749.     VK_F2 or scShift or scCtrl,
  1750.     VK_F3 or scShift or scCtrl,
  1751.     VK_F4 or scShift or scCtrl,
  1752.     VK_F5 or scShift or scCtrl,
  1753.     VK_F6 or scShift or scCtrl,
  1754.     VK_F7 or scShift or scCtrl,
  1755.     VK_F8 or scShift or scCtrl,
  1756.     VK_F9 or scShift or scCtrl,
  1757.     VK_F10 or scShift or scCtrl,
  1758.     VK_F11 or scShift or scCtrl,
  1759.     VK_F12 or scShift or scCtrl,
  1760.     VK_INSERT,
  1761.     VK_INSERT or scShift,
  1762.     VK_INSERT or scCtrl,
  1763.     VK_DELETE,
  1764.     VK_DELETE or scShift,
  1765.     VK_DELETE or scCtrl,
  1766.     VK_BACK or scAlt,
  1767.     VK_BACK or scShift or scAlt);
  1768.  
  1769. function TShortCutProperty.GetAttributes: TPropertyAttributes;
  1770. begin
  1771.   Result := [paMultiSelect, paValueList, paRevertable];
  1772. end;
  1773.  
  1774. function TShortCutProperty.GetValue: string;
  1775. var
  1776.   CurValue: TShortCut;
  1777. begin
  1778.   CurValue := GetOrdValue;
  1779.   if CurValue = scNone then
  1780.     Result := LoadStr(srNone) else
  1781.     Result := ShortCutToText(CurValue);
  1782. end;
  1783.  
  1784. procedure TShortCutProperty.GetValues(Proc: TGetStrProc);
  1785. var
  1786.   I: Integer;
  1787. begin
  1788.   Proc(LoadStr(srNone));
  1789.   for I := 1 to High(ShortCuts) do Proc(ShortCutToText(ShortCuts[I]));
  1790. end;
  1791.  
  1792. procedure TShortCutProperty.SetValue(const Value: string);
  1793. var
  1794.   NewValue: TShortCut;
  1795. begin
  1796.   NewValue := 0;
  1797.   if (Value <> '') and (AnsiCompareText(Value, LoadStr(srNone)) <> 0) then
  1798.   begin
  1799.     NewValue := TextToShortCut(Value);
  1800.     if NewValue = 0 then
  1801.       raise EPropertyError.CreateRes(SInvalidPropertyValue);
  1802.   end;
  1803.   SetOrdValue(NewValue);
  1804. end;
  1805.  
  1806. { TTabOrderProperty }
  1807.  
  1808. function TTabOrderProperty.GetAttributes: TPropertyAttributes;
  1809. begin
  1810.   Result := [];
  1811. end;
  1812.  
  1813. { TCaptionProperty }
  1814.  
  1815. function TCaptionProperty.GetAttributes: TPropertyAttributes;
  1816. begin
  1817.   Result := [paMultiSelect, paAutoUpdate, paRevertable];
  1818. end;
  1819.  
  1820. { TPropInfoList }
  1821.  
  1822. type
  1823.   TPropInfoList = class
  1824.   private
  1825.     FList: PPropList;
  1826.     FCount: Integer;
  1827.     FSize: Integer;
  1828.     function Get(Index: Integer): PPropInfo;
  1829.   public
  1830.     constructor Create(Component: TComponent; Filter: TTypeKinds);
  1831.     destructor Destroy; override;
  1832.     function Contains(P: PPropInfo): Boolean;
  1833.     procedure Delete(Index: Integer);
  1834.     procedure Intersect(List: TPropInfoList);
  1835.     property Count: Integer read FCount;
  1836.     property Items[Index: Integer]: PPropInfo read Get; default;
  1837.   end;
  1838.  
  1839. constructor TPropInfoList.Create(Component: TComponent; Filter: TTypeKinds);
  1840. begin
  1841.   FCount := GetPropList(Component.ClassInfo, Filter, nil);
  1842.   FSize := FCount * SizeOf(Pointer);
  1843.   GetMem(FList, FSize);
  1844.   GetPropList(Component.ClassInfo, Filter, FList);
  1845. end;
  1846.  
  1847. destructor TPropInfoList.Destroy;
  1848. begin
  1849.   if FList <> nil then FreeMem(FList, FSize);
  1850. end;
  1851.  
  1852. function TPropInfoList.Contains(P: PPropInfo): Boolean;
  1853. var
  1854.   I: Integer;
  1855. begin
  1856.   for I := 0 to FCount - 1 do
  1857.     with FList^[I]^ do
  1858.       if (PropType = P^.PropType) and (CompareText(Name, P^.Name) = 0) then
  1859.       begin
  1860.         Result := True;
  1861.         Exit;
  1862.       end;
  1863.   Result := False;
  1864. end;
  1865.  
  1866. procedure TPropInfoList.Delete(Index: Integer);
  1867. begin
  1868.   Dec(FCount);
  1869.   if Index < FCount then
  1870.     Move(FList^[Index + 1], FList^[Index],
  1871.       (FCount - Index) * SizeOf(Pointer));
  1872. end;
  1873.  
  1874. function TPropInfoList.Get(Index: Integer): PPropInfo;
  1875. begin
  1876.   Result := FList^[Index];
  1877. end;
  1878.  
  1879. procedure TPropInfoList.Intersect(List: TPropInfoList);
  1880. var
  1881.   I: Integer;
  1882. begin
  1883.   for I := FCount - 1 downto 0 do
  1884.     if not List.Contains(FList^[I]) then Delete(I);
  1885. end;
  1886.  
  1887. { GetComponentProperties }
  1888.  
  1889. procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  1890.   const PropertyName: string; EditorClass: TPropertyEditorClass);
  1891. var
  1892.   P: PPropertyClassRec;
  1893. begin
  1894.   New(P);
  1895.   P^.Next := PropertyClassList;
  1896.   P^.PropertyType := PropertyType;
  1897.   P^.ComponentClass := ComponentClass;
  1898.   P^.PropertyName := '';
  1899.   if Assigned(ComponentClass) then P^.PropertyName := PropertyName;
  1900.   P^.EditorClass := EditorClass;
  1901.   PropertyClassList := P;
  1902. end;
  1903.  
  1904. procedure RegisterPropertyMapper(Mapper: TPropertyMapperFunc);
  1905. var
  1906.   P: PPropertyMapperRec;
  1907. begin
  1908.   New(P);
  1909.   P^.Next := PropertyMapperList;
  1910.   P^.Mapper := Mapper;
  1911.   PropertyMapperList := P;
  1912. end;
  1913.  
  1914. function GetEditorClass(PropInfo: PPropInfo;
  1915.   Component: TComponent): TPropertyEditorClass;
  1916. var
  1917.   ComponentClass: TClass;
  1918.   PropType: PTypeInfo;
  1919.   P, C: PPropertyClassRec;
  1920.   M: PPropertyMapperRec;
  1921. begin
  1922.   M := PropertyMapperList;
  1923.   while M <> nil do
  1924.   begin
  1925.     Result := M^.Mapper(Component, PropInfo);
  1926.     if Result <> nil then Exit;
  1927.     M := M^.Next;
  1928.   end;
  1929.   ComponentClass := Component.ClassType;
  1930.   PropType := PropInfo^.PropType;
  1931.   P := PropertyClassList;
  1932.   C := nil;
  1933.   while P <> nil do
  1934.   begin
  1935.     if ((P^.PropertyType = PropType) or ((PropType^.Kind = tkClass) and
  1936.       (P^.PropertyType^.Kind = tkClass) and
  1937.       GetTypeData(PropType)^.ClassType.InheritsFrom(GetTypeData(P^.PropertyType)^.ClassType))) and
  1938.       ((P^.ComponentClass = nil) or (ComponentClass.InheritsFrom(P^.ComponentClass))) and
  1939.       ((P^.PropertyName = '') or (CompareText(PropInfo^.Name, P^.PropertyName) = 0)) then
  1940.       if (C = nil) or ((C^.ComponentClass = nil) and (P^.ComponentClass <> nil))
  1941.         or ((C^.PropertyName = '') and (P^.PropertyName <> '')) then C := P;
  1942.     P := P^.Next;
  1943.   end;
  1944.   if C <> nil then
  1945.     Result := C^.EditorClass else
  1946.     Result := PropClassMap[PropType^.Kind];
  1947. end;
  1948.  
  1949. procedure GetComponentProperties(Components: TComponentList;
  1950.   Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);
  1951. var
  1952.   I, J, CompCount: Integer;
  1953.   Component: TComponent;
  1954.   CompType: TClass;
  1955.   Candidates: TPropInfoList;
  1956.   PropLists: TList;
  1957.   Editor: TPropertyEditor;
  1958.   PropInfo: PPropInfo;
  1959.   AddEditor: Boolean;
  1960. begin
  1961.   if (Components = nil) or (Components.Count = 0) then Exit;
  1962.   CompCount := Components.Count;
  1963.   Component := Components[0];
  1964.   CompType := Component.ClassType;
  1965.   Candidates := TPropInfoList.Create(Components[0], Filter);
  1966.   try
  1967.     for I := Candidates.Count - 1 downto 0 do
  1968.     begin
  1969.       PropInfo := Candidates[I];
  1970.       Editor := GetEditorClass(PropInfo, Component).Create(Designer, 1);
  1971.       try
  1972.         Editor.SetPropEntry(0, Components[0], PropInfo);
  1973.         Editor.Initialize;
  1974.         with PropInfo^ do
  1975.           if (GetProc = nil) or ((PropType^.Kind <> tkClass) and
  1976.             (SetProc = nil)) or ((CompCount > 1) and
  1977.             not (paMultiSelect in Editor.GetAttributes)) or
  1978.             not Editor.ValueAvailable then
  1979.             Candidates.Delete(I);
  1980.       finally
  1981.         Editor.Free;
  1982.       end;
  1983.     end;
  1984.     PropLists := TList.Create;
  1985.     try
  1986.       PropLists.Capacity := CompCount;
  1987.       for I := 0 to CompCount - 1 do
  1988.         PropLists.Add(TPropInfoList.Create(Components[I], Filter));
  1989.       for I := 0 to CompCount - 1 do
  1990.         Candidates.Intersect(TPropInfoList(PropLists[I]));
  1991.       for I := 0 to CompCount - 1 do
  1992.         TPropInfoList(PropLists[I]).Intersect(Candidates);
  1993.       for I := 0 to Candidates.Count - 1 do
  1994.       begin
  1995.         Editor := GetEditorClass(Candidates[I],
  1996.           Component).Create(Designer, CompCount);
  1997.         try
  1998.           AddEditor := True;
  1999.           for J := 0 to CompCount - 1 do
  2000.           begin
  2001.             if (Components[J].ClassType <> CompType) and
  2002.               (GetEditorClass(TPropInfoList(PropLists[J])[I],
  2003.                 Components[J]) <> Editor.ClassType) then
  2004.             begin
  2005.               AddEditor := False;
  2006.               Break;
  2007.             end;
  2008.             Editor.SetPropEntry(J, Components[J],
  2009.               TPropInfoList(PropLists[J])[I]);
  2010.           end;
  2011.         except
  2012.           Editor.Free;
  2013.           raise;
  2014.         end;
  2015.         if AddEditor then
  2016.         begin
  2017.           Editor.Initialize;
  2018.           if Editor.ValueAvailable then
  2019.             Proc(Editor) else
  2020.             Editor.Free;
  2021.         end
  2022.         else Editor.Free;
  2023.       end;
  2024.     finally
  2025.       for I := 0 to PropLists.Count - 1 do TPropInfoList(PropLists[I]).Free;
  2026.       PropLists.Free;
  2027.     end;
  2028.   finally
  2029.     Candidates.Free;
  2030.   end;
  2031. end;
  2032.  
  2033. { RegisterComponentEditor }
  2034.  
  2035. type
  2036.   PComponentClassRec = ^TComponentClassRec;
  2037.   TComponentClassRec = record
  2038.     Next: PComponentClassRec;
  2039.     ComponentClass: TComponentClass;
  2040.     EditorClass: TComponentEditorClass;
  2041.   end;
  2042.  
  2043. var
  2044.   ComponentClassList: PComponentClassRec = nil;
  2045.  
  2046. procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  2047.   ComponentEditor: TComponentEditorClass);
  2048. var
  2049.   P: PComponentClassRec;
  2050. begin
  2051.   New(P);
  2052.   P^.Next := ComponentClassList;
  2053.   P^.ComponentClass := ComponentClass;
  2054.   P^.EditorClass := ComponentEditor;
  2055.   ComponentClassList := P;
  2056. end;
  2057.  
  2058. { GetComponentEditor }
  2059.  
  2060. function GetComponentEditor(Component: TComponent;
  2061.   Designer: TFormDesigner): TComponentEditor;
  2062. var
  2063.   P: PComponentClassRec;
  2064.   ComponentClass: TComponentClass;
  2065.   EditorClass: TComponentEditorClass;
  2066. begin
  2067.   P := ComponentClassList;
  2068.   ComponentClass := TComponent;
  2069.   EditorClass := TDefaultEditor;
  2070.   while P <> nil do
  2071.   begin
  2072.     if (Component is P^.ComponentClass) and
  2073.       (P^.ComponentClass.InheritsFrom(ComponentClass)) then
  2074.     begin
  2075.       EditorClass := P^.EditorClass;
  2076.       ComponentClass := P^.ComponentClass;
  2077.     end;
  2078.     P := P^.Next;
  2079.   end;
  2080.   Result := EditorClass.Create(Component, Designer);
  2081. end;
  2082.  
  2083. { TComponentEditor }
  2084.  
  2085. constructor TComponentEditor.Create(AComponent: TComponent; ADesigner: TFormDesigner);
  2086. begin
  2087.   inherited Create;
  2088.   FComponent := AComponent;
  2089.   FDesigner := ADesigner;
  2090. end;
  2091.  
  2092. procedure TComponentEditor.Edit;
  2093. begin
  2094.   if GetVerbCount > 0 then ExecuteVerb(0);
  2095. end;
  2096.  
  2097. function TComponentEditor.GetVerbCount: Integer;
  2098. begin
  2099.   Result := 0;
  2100. end;
  2101.  
  2102. function TComponentEditor.GetVerb(Index: Integer): string;
  2103. begin
  2104. end;
  2105.  
  2106. procedure TComponentEditor.ExecuteVerb(Index: Integer);
  2107. begin
  2108. end;
  2109.  
  2110. procedure TComponentEditor.Copy;
  2111. begin
  2112. end;
  2113.  
  2114. { TDefaultEditor }
  2115.  
  2116. procedure TDefaultEditor.CheckEdit(PropertyEditor: TPropertyEditor);
  2117. var
  2118.   FreeEditor: Boolean;
  2119. begin
  2120.   FreeEditor := True;
  2121.   try
  2122.     if FContinue then EditProperty(PropertyEditor, FContinue, FreeEditor);
  2123.   finally
  2124.     if FreeEditor then PropertyEditor.Free;
  2125.   end;
  2126. end;
  2127.  
  2128. procedure TDefaultEditor.EditProperty(PropertyEditor: TPropertyEditor;
  2129.   var Continue, FreeEditor: Boolean);
  2130. var
  2131.   PropName: string;
  2132.   BestName: string;
  2133.  
  2134.   procedure ReplaceBest;
  2135.   begin
  2136.     FBest.Free;
  2137.     FBest := PropertyEditor;
  2138.     if FFirst = FBest then FFirst := nil;
  2139.     FreeEditor := False;
  2140.   end;
  2141.  
  2142. begin
  2143.   if not Assigned(FFirst) and (PropertyEditor is TMethodProperty) then
  2144.   begin
  2145.     FreeEditor := False;
  2146.     FFirst := PropertyEditor;
  2147.   end;
  2148.   PropName := PropertyEditor.GetName;
  2149.   BestName := '';
  2150.   if Assigned(FBest) then BestName := FBest.GetName;
  2151.   if CompareText(PropName, 'ONCREATE') = 0 then
  2152.     ReplaceBest
  2153.   else if CompareText(BestName, 'ONCREATE') <> 0 then
  2154.     if CompareText(PropName, 'ONCHANGE') = 0 then
  2155.       ReplaceBest
  2156.     else if CompareText(BestName, 'ONCHANGE') <> 0 then
  2157.       if CompareText(PropName, 'ONCLICK') = 0 then
  2158.         ReplaceBest;
  2159. end;
  2160.  
  2161. procedure TDefaultEditor.Edit;
  2162. var
  2163.   Components: TComponentList;
  2164. begin
  2165.   Components := TComponentList.Create;
  2166.   try
  2167.     FContinue := True;
  2168.     Components.Add(Component);
  2169.     FFirst := nil;
  2170.     FBest := nil;
  2171.     try
  2172.       GetComponentProperties(Components, tkAny, Designer, CheckEdit);
  2173.       if FContinue then
  2174.         if Assigned(FBest) then
  2175.           FBest.Edit
  2176.         else if Assigned(FFirst) then
  2177.           FFirst.Edit;
  2178.     finally
  2179.       FFirst.Free;
  2180.       FBest.Free;
  2181.     end;
  2182.   finally
  2183.     Components.Free;
  2184.   end;
  2185. end;
  2186.  
  2187. end.
  2188.