home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / SOURCE / TOOLSAPI / DSGNINTF.PAS next >
Encoding:
Pascal/Delphi Source File  |  1997-08-04  |  75.9 KB  |  2,593 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 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): TPersistent;
  26.     function GetCount: Integer;
  27.   public
  28.     constructor Create;
  29.     destructor Destroy; override;
  30.     function Add(Item: TPersistent): Integer;
  31.     function Equals(List: TComponentList): Boolean;
  32.     property Count: Integer read GetCount;
  33.     property Items[Index: Integer]: TPersistent read Get; default;
  34.   end;
  35.  
  36. { Forward declaration }
  37.  
  38.   TComponentEditor = class;
  39.  
  40. { TFormDesigner }
  41.  
  42.   TFormDesigner = class(TDesigner)
  43.   public
  44.     function CreateMethod(const Name: string; TypeData: PTypeData): TMethod; virtual; abstract;
  45.     function GetMethodName(const Method: TMethod): string; virtual; abstract;
  46.     procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc); virtual; abstract;
  47.     function GetPrivateDirectory: string; virtual; abstract;
  48.     procedure GetSelections(List: TComponentList); virtual; abstract;
  49.     function MethodExists(const Name: string): Boolean; virtual; abstract;
  50.     procedure RenameMethod(const CurName, NewName: string); virtual; abstract;
  51.     procedure SelectComponent(Instance: TPersistent); virtual; abstract;
  52.     procedure SetSelections(List: TComponentList); virtual; abstract;
  53.     procedure ShowMethod(const Name: string); virtual; abstract;
  54.     function UniqueName(const BaseName: string): string; virtual; abstract;
  55.     procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc); virtual; abstract;
  56.     function GetComponent(const Name: string): TComponent; virtual; abstract;
  57.     function GetComponentName(Component: TComponent): string; virtual; abstract;
  58.     function GetObject(const Name: string): TPersistent; virtual; abstract;
  59.     function GetObjectName(Instance: TPersistent): string; virtual; abstract;
  60.     procedure GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc); virtual; abstract;
  61.     function MethodFromAncestor(const Method: TMethod): Boolean; virtual; abstract;
  62.     function CreateComponent(ComponentClass: TComponentClass; Parent: TComponent;
  63.       Left, Top, Width, Height: Integer): TComponent; virtual; abstract;
  64.     function IsComponentLinkable(Component: TComponent): Boolean; virtual; abstract;
  65.     procedure MakeComponentLinkable(Component: TComponent); virtual; abstract;
  66.     function GetRoot: TComponent; virtual; abstract;
  67.     procedure Revert(Instance: TPersistent; PropInfo: PPropInfo); virtual; abstract;
  68.     function GetIsDormant: Boolean; virtual; abstract;
  69.     function HasInterface: Boolean; virtual; abstract;
  70.     function HasInterfaceMember(const Name: string): Boolean; virtual; abstract;
  71.     procedure AddInterfaceMember(const MemberText: string); virtual; abstract;
  72.     property IsDormant: Boolean read GetIsDormant;
  73.   end;
  74.  
  75. { TPropertyEditor
  76.   Edits a property of a component, or list of components, selected into the
  77.   Object Inspector.  The property editor is created based on the type of the
  78.   property being edited as determined by the types registered by
  79.   RegisterPropertyEditor.  The Object Inspector uses the a TPropertyEditor
  80.   for all modification to a property. GetName and GetValue are called to display
  81.   the name and value of the property.  SetValue is called whenever the user
  82.   requests to change the value.  Edit is called when the user double-clicks the
  83.   property in the Object Inspector. GetValues is called when the drop-down
  84.   list of a property is displayed.  GetProperties is called when the property
  85.   is expanded to show sub-properties.  AllEqual is called to decide whether or
  86.   not to display the value of the property when more than one component is
  87.   selected.
  88.  
  89.   The following are methods that can be overriden to change the behavior of
  90.   the property editor:
  91.  
  92.     Activate
  93.       Called whenever the property becomes selected in the object inspector.
  94.       This is potientially useful to allow certian property attributes to
  95.       to only be determined whenever the property is selected in the object
  96.       inspector. Only paSubProperties and paMultiSelect, returned from
  97.       GetAttributes, need to be accurate before this method is called.
  98.     AllEqual
  99.       Called whenever there are more than one components selected.  If this
  100.       method returns true, GetValue is called, otherwise blank is displayed
  101.       in the Object Inspector.  This is called only when GetAttributes
  102.       returns paMultiSelect.
  103.     Edit
  104.       Called when the '...' button is pressed or the property is double-clicked.
  105.       This can, for example, bring up a dialog to allow the editing the
  106.       component in some more meaningful fashion than by text (e.g. the Font
  107.       property).
  108.     GetAttributes
  109.       Returns the information for use in the Object Inspector to be able to
  110.       show the approprate tools.  GetAttributes return a set of type
  111.       TPropertyAttributes:
  112.         paValueList:     The property editor can return an enumerated list of
  113.                          values for the property.  If GetValues calls Proc
  114.                          with values then this attribute should be set.  This
  115.                          will cause the drop-down button to appear to the right
  116.                          of the property in the Object Inspector.
  117.         paSortList:      Object Inspector to sort the list returned by
  118.                          GetValues.
  119.         paSubProperties: The property editor has sub-properties that will be
  120.                          displayed indented and below the current property in
  121.                          standard outline format. If GetProperties will
  122.                          generate property objects then this attribute should
  123.                          be set.
  124.         paDialog:        Indicates that the Edit method will bring up a
  125.                          dialog.  This will cause the '...' button to be
  126.                          displayed to the right of the property in the Object
  127.                          Inspector.
  128.         paMultiSelect:   Allows the property to be displayed when more than
  129.                          one component is selected.  Some properties are not
  130.                          approprate for multi-selection (e.g. the Name
  131.                          property).
  132.         paAutoUpdate:    Causes the SetValue method to be called on each
  133.                          change made to the editor instead of after the change
  134.                          has been approved (e.g. the Caption property).
  135.         paReadOnly:      Value is not allowed to change.
  136.         paRevertable:    Allows the property to be reverted to the original
  137.                          value.  Things that shouldn't be reverted are nested
  138.                          properties (e.g. Fonts) and elements of a composite
  139.                          property such as set element values.
  140.     GetComponent
  141.       Returns the Index'th component being edited by this property editor.  This
  142.       is used to retieve the components.  A property editor can only refer to
  143.       multiple components when paMultiSelect is returned from GetAttributes.
  144.     GetEditLimit
  145.       Returns the number of character the user is allowed to enter for the
  146.       value.  The inplace editor of the object inspector will be have its
  147.       text limited set to the return value.  By default this limit is 255.
  148.     GetName
  149.       Returns a the name of the property.  By default the value is retrieved
  150.       from the type information with all underbars replaced by spaces.  This
  151.       should only be overriden if the name of the property is not the name
  152.       that should appear in the Object Inspector.
  153.     GetProperties
  154.       Should be overriden to call PropertyProc for every sub-property (or nested
  155.       property) of the property begin edited and passing a new TPropertyEdtior
  156.       for each sub-property.  By default, PropertyProc is not called and no
  157.       sub-properties are assumed.  TClassProperty will pass a new property
  158.       editor for each published property in a class.  TSetProperty passes a
  159.       new editor for each element in the set.
  160.     GetPropType
  161.       Returns the type information pointer for the propertie(s) being edited.
  162.     GetValue
  163.       Returns the string value of the property. By default this returns
  164.       '(unknown)'.  This should be overriden to return the appropriate value.
  165.     GetValues
  166.       Called when paValueList is returned in GetAttributes.  Should call Proc
  167.       for every value that is acceptable for this property.  TEnumProperty
  168.       will pass every element in the enumeration.
  169.     Initialize
  170.       Called after the property editor has been created but before it is used.
  171.       Many times property editors are created and because they are not a common
  172.       property across the entire selection they are thrown away.  Initialize is
  173.       called after it is determined the property editor is going to be used by
  174.       the object inspector and not just thrown away.
  175.     SetValue(Value)
  176.       Called to set the value of the property.  The property editor should be
  177.       able to translate the string and call one of the SetXxxValue methods. If
  178.       the string is not in the correct format or not an allowed value, the
  179.       property editor should generate an exception describing the problem. Set
  180.       value can ignore all changes and allow all editing of the property be
  181.       accomplished through the Edit method (e.g. the Picture property).
  182.  
  183.   Properties and methods useful in creating a new TPropertyEditor classes:
  184.  
  185.     Name property
  186.       Returns the name of the property returned by GetName
  187.     PrivateDirectory property
  188.       It is either the .EXE or the "working directory" as specified in
  189.       the registry under the key:
  190.         "HKEY_CURRENT_USER\Software\Borland\Delphi\3.0\Globals\PrivateDir"
  191.       If the property editor needs auxilury or state files (templates, examples,
  192.       etc) they should be stored in this directory.
  193.     Properties indexed property
  194.       The TProperty objects representing all the components being edited
  195.       by the property editor.  If more than one component is selected, one
  196.       TProperty object is created for each component.  Typically, it is not
  197.       necessary to use this array since the Get/SetXxxValue methods will
  198.       propagate the values appropriatly.
  199.     Value property
  200.       The current value, as a string, of the property as returned by GetValue.
  201.     Modified
  202.       Called to indicate the value of the property has been modified.  Called
  203.       automatically by the SetXxxValue methods.  If you call a TProperty
  204.       SetXxxValue method directly, you *must* call Modified as well.
  205.     GetXxxValue
  206.       Gets the value of the first property in the Properties property.  Calls
  207.       the appropriate TProperty GetXxxValue method to retrieve the value.
  208.     SetXxxValue
  209.       Sets the value of all the properties in the Properties property.  Calls
  210.       the approprate TProperty SetXxxxValue methods to set the value. }
  211.  
  212.   TPropertyAttribute = (paValueList, paSubProperties, paDialog,
  213.     paMultiSelect, paAutoUpdate, paSortList, paReadOnly, paRevertable);
  214.   TPropertyAttributes = set of TPropertyAttribute;
  215.  
  216.   TPropertyEditor = class;
  217.  
  218.   TInstProp = record
  219.     Instance: TPersistent;
  220.     PropInfo: PPropInfo;
  221.   end;
  222.  
  223.   PInstPropList = ^TInstPropList;
  224.   TInstPropList = array[0..1023] of TInstProp;
  225.  
  226.   TGetPropEditProc = procedure(Prop: TPropertyEditor) of object;
  227.  
  228.   TPropertyEditor = class
  229.   private
  230.     FDesigner: TFormDesigner;
  231.     FPropList: PInstPropList;
  232.     FPropCount: Integer;
  233.     constructor Create(ADesigner: TFormDesigner; APropCount: Integer);
  234.     function GetPrivateDirectory: string;
  235.     procedure SetPropEntry(Index: Integer; AInstance: TPersistent;
  236.       APropInfo: PPropInfo);
  237.   protected
  238.     function GetPropInfo: PPropInfo;
  239.     function GetFloatValue: Extended;
  240.     function GetFloatValueAt(Index: Integer): Extended;
  241.     function GetMethodValue: TMethod;
  242.     function GetMethodValueAt(Index: Integer): TMethod;
  243.     function GetOrdValue: Longint;
  244.     function GetOrdValueAt(Index: Integer): Longint;
  245.     function GetStrValue: string;
  246.     function GetStrValueAt(Index: Integer): string;
  247.     function GetVarValue: Variant;
  248.     function GetVarValueAt(Index: Integer): Variant;
  249.     procedure Modified;
  250.     procedure SetFloatValue(Value: Extended);
  251.     procedure SetMethodValue(const Value: TMethod);
  252.     procedure SetOrdValue(Value: Longint);
  253.     procedure SetStrValue(const Value: string);
  254.     procedure SetVarValue(const Value: Variant);
  255.   public
  256.     destructor Destroy; override;
  257.     procedure Activate; virtual;
  258.     function AllEqual: Boolean; virtual;
  259.     procedure Edit; virtual;
  260.     function GetAttributes: TPropertyAttributes; virtual;
  261.     function GetComponent(Index: Integer): TPersistent;
  262.     function GetEditLimit: Integer; virtual;
  263.     function GetName: string; virtual;
  264.     procedure GetProperties(Proc: TGetPropEditProc); virtual;
  265.     function GetPropType: PTypeInfo;
  266.     function GetValue: string; virtual;
  267.     procedure GetValues(Proc: TGetStrProc); virtual;
  268.     procedure Initialize; virtual;
  269.     procedure Revert;
  270.     procedure SetValue(const Value: string); virtual;
  271.     function ValueAvailable: Boolean;
  272.     property Designer: TFormDesigner read FDesigner;
  273.     property PrivateDirectory: string read GetPrivateDirectory;
  274.     property PropCount: Integer read FPropCount;
  275.     property Value: string read GetValue write SetValue;
  276.   end;
  277.  
  278.   TPropertyEditorClass = class of TPropertyEditor;
  279.  
  280. { TOrdinalProperty
  281.   The base class of all ordinal property editors.  It established that ordinal
  282.   properties are all equal if the GetOrdValue all return the same value. }
  283.  
  284.   TOrdinalProperty = class(TPropertyEditor)
  285.     function AllEqual: Boolean; override;
  286.     function GetEditLimit: Integer; override;
  287.   end;
  288.  
  289. { TIntegerProperty
  290.   Default editor for all Longint properties and all subtypes of the Longint
  291.   type (i.e. Integer, Word, 1..10, etc.).  Retricts the value entrered into
  292.   the property to the range of the sub-type. }
  293.  
  294.   TIntegerProperty = class(TOrdinalProperty)
  295.   public
  296.     function GetValue: string; override;
  297.     procedure SetValue(const Value: string); override;
  298.   end;
  299.  
  300. { TCharProperty
  301.   Default editor for all Char properties and sub-types of Char (i.e. Char,
  302.   'A'..'Z', etc.). }
  303.  
  304.   TCharProperty = class(TOrdinalProperty)
  305.   public
  306.     function GetValue: string; override;
  307.     procedure SetValue(const Value: string); override;
  308.   end;
  309.  
  310. { TEnumProperty
  311.   The default property editor for all enumerated properties (e.g. TShape =
  312.   (sCircle, sTriangle, sSquare), etc.). }
  313.  
  314.   TEnumProperty = class(TOrdinalProperty)
  315.   public
  316.     function GetAttributes: TPropertyAttributes; override;
  317.     function GetValue: string; override;
  318.     procedure GetValues(Proc: TGetStrProc); override;
  319.     procedure SetValue(const Value: string); override;
  320.   end;
  321.  
  322.   TBoolProperty = class(TEnumProperty)
  323.     function GetValue: string; override;
  324.     procedure GetValues(Proc: TGetStrProc); override;
  325.     procedure SetValue(const Value: string); override;
  326.   end;
  327.  
  328. { TFloatProperty
  329.   The default property editor for all floating point types (e.g. Float,
  330.   Single, Double, etc.) }
  331.  
  332.   TFloatProperty = class(TPropertyEditor)
  333.   public
  334.     function AllEqual: Boolean; override;
  335.     function GetValue: string; override;
  336.     procedure SetValue(const Value: string); override;
  337.   end;
  338.  
  339. { TStringProperty
  340.   The default property editor for all strings and sub types (e.g. string,
  341.   string[20], etc.). }
  342.  
  343.   TStringProperty = class(TPropertyEditor)
  344.   public
  345.     function AllEqual: Boolean; override;
  346.     function GetEditLimit: Integer; override;
  347.     function GetValue: string; override;
  348.     procedure SetValue(const Value: string); override;
  349.   end;
  350.  
  351. { TSetElementProperty
  352.   A property editor that edits an individual set element.  GetName is
  353.   changed to display the set element name instead of the property name and
  354.   Get/SetValue is changed to reflect the individual element state.  This
  355.   editor is created by the TSetProperty editor. }
  356.  
  357.   TSetElementProperty = class(TPropertyEditor)
  358.   private
  359.     FElement: Integer;
  360.     constructor Create(ADesigner: TFormDesigner; APropList: PInstPropList;
  361.       APropCount: Integer; AElement: Integer);
  362.   public
  363.     destructor Destroy; override;
  364.     function AllEqual: Boolean; override;
  365.     function GetAttributes: TPropertyAttributes; override;
  366.     function GetName: string; override;
  367.     function GetValue: string; override;
  368.     procedure GetValues(Proc: TGetStrProc); override;
  369.     procedure SetValue(const Value: string); override;
  370.    end;
  371.  
  372. { TSetProperty
  373.   Default property editor for all set properties. This editor does not edit
  374.   the set directly but will display sub-properties for each element of the
  375.   set. GetValue displays the value of the set in standard set syntax. }
  376.  
  377.   TSetProperty = class(TOrdinalProperty)
  378.   public
  379.     function GetAttributes: TPropertyAttributes; override;
  380.     procedure GetProperties(Proc: TGetPropEditProc); override;
  381.     function GetValue: string; override;
  382.   end;
  383.  
  384. { TClassProperty
  385.   Default property editor for all objects.  Does not allow modifing the
  386.   property but does display the class name of the object and will allow the
  387.   editing of the object's properties as sub-properties of the property. }
  388.  
  389.   TClassProperty = class(TPropertyEditor)
  390.   public
  391.     function GetAttributes: TPropertyAttributes; override;
  392.     procedure GetProperties(Proc: TGetPropEditProc); override;
  393.     function GetValue: string; override;
  394.   end;
  395.  
  396. { TMethodProperty
  397.   Property editor for all method properties. }
  398.  
  399.   TMethodProperty = class(TPropertyEditor)
  400.   public
  401.     function AllEqual: Boolean; override;
  402.     procedure Edit; override;
  403.     function GetAttributes: TPropertyAttributes; override;
  404.     function GetEditLimit: Integer; override;
  405.     function GetValue: string; override;
  406.     procedure GetValues(Proc: TGetStrProc); override;
  407.     procedure SetValue(const AValue: string); override;
  408.     function GetFormMethodName: string; virtual;
  409.     function GetTrimmedEventName: string;
  410.   end;
  411.  
  412. { TComponentProperty
  413.   The default editor for TComponents.  It does not allow editing of the
  414.   properties of the component.  It allow the user to set the value of this
  415.   property to point to a component in the same form that is type compatible
  416.   with the property being edited (e.g. the ActiveControl property). }
  417.  
  418.   TComponentProperty = class(TPropertyEditor)
  419.   public
  420.     function GetAttributes: TPropertyAttributes; override;
  421.     function GetEditLimit: Integer; override;
  422.     function GetValue: string; override;
  423.     procedure GetValues(Proc: TGetStrProc); override;
  424.     procedure SetValue(const Value: string); override;
  425.   end;
  426.  
  427. { TComponentNameProperty
  428.   Property editor for the Name property.  It restricts the name property
  429.   from being displayed when more than one component is selected. }
  430.  
  431.   TComponentNameProperty = class(TStringProperty)
  432.   public
  433.     function GetAttributes: TPropertyAttributes; override;
  434.     function GetEditLimit: Integer; override;
  435.   end;
  436.  
  437. { TFontNameProperty
  438.   Editor for the TFont.FontName property.  Displays a drop-down list of all
  439.   the fonts known by Windows.}
  440.  
  441.   TFontNameProperty = class(TStringProperty)
  442.   public
  443.     function GetAttributes: TPropertyAttributes; override;
  444.     procedure GetValues(Proc: TGetStrProc); override;
  445.   end;
  446.  
  447. { TFontCharsetProperty
  448.   Editor for the TFont.Charset property.  Displays a drop-down list of the
  449.   character-set by Windows.}
  450.  
  451.   TFontCharsetProperty = class(TIntegerProperty)
  452.   public
  453.     function GetAttributes: TPropertyAttributes; override;
  454.     function GetValue: string; override;
  455.     procedure GetValues(Proc: TGetStrProc); override;
  456.     procedure SetValue(const Value: string); override;
  457.   end;
  458.  
  459. { TImeNameProperty
  460.   Editor for the TImeName property.  Displays a drop-down list of all
  461.   the IME names known by Windows.}
  462.  
  463.   TImeNameProperty = class(TStringProperty)
  464.   public
  465.     function GetAttributes: TPropertyAttributes; override;
  466.     procedure GetValues(Proc: TGetStrProc); override;
  467.   end;
  468.  
  469. { TColorProperty
  470.   Property editor for the TColor type.  Displays the color as a clXXX value
  471.   if one exists, otherwise displays the value as hex.  Also allows the
  472.   clXXX value to be picked from a list. }
  473.  
  474.   TColorProperty = class(TIntegerProperty)
  475.   public
  476.     procedure Edit; override;
  477.     function GetAttributes: TPropertyAttributes; override;
  478.     function GetValue: string; override;
  479.     procedure GetValues(Proc: TGetStrProc); override;
  480.     procedure SetValue(const Value: string); override;
  481.   end;
  482.  
  483. { TCursorProperty
  484.   Property editor for the TCursor type.  Displays the color as a crXXX value
  485.   if one exists, otherwise displays the value as hex.  Also allows the
  486.   clXXX value to be picked from a list. }
  487.  
  488.   TCursorProperty = class(TIntegerProperty)
  489.   public
  490.     function GetAttributes: TPropertyAttributes; override;
  491.     function GetValue: string; override;
  492.     procedure GetValues(Proc: TGetStrProc); override;
  493.     procedure SetValue(const Value: string); override;
  494.   end;
  495.  
  496. { TFontProperty
  497.   Property editor the Font property.  Brings up the font dialog as well as
  498.   allowing the properties of the object to be edited. }
  499.  
  500.   TFontProperty = class(TClassProperty)
  501.   public
  502.     procedure Edit; override;
  503.     function GetAttributes: TPropertyAttributes; override;
  504.   end;
  505.  
  506. { TModalResultProperty }
  507.  
  508.   TModalResultProperty = class(TIntegerProperty)
  509.   public
  510.     function GetAttributes: TPropertyAttributes; override;
  511.     function GetValue: string; override;
  512.     procedure GetValues(Proc: TGetStrProc); override;
  513.     procedure SetValue(const Value: string); override;
  514.   end;
  515.  
  516. { TShortCutProperty
  517.   Property editor the the ShortCut property.  Allows both typing in a short
  518.   cut value or picking a short-cut value from a list. }
  519.  
  520.   TShortCutProperty = class(TOrdinalProperty)
  521.   public
  522.     function GetAttributes: TPropertyAttributes; override;
  523.     function GetValue: string; override;
  524.     procedure GetValues(Proc: TGetStrProc); override;
  525.     procedure SetValue(const Value: string); override;
  526.   end;
  527.  
  528. { TMPFilenameProperty
  529.   Property editor for the TMediaPlayer.  Displays an File Open Dialog
  530.   for the name of the media file.}
  531.  
  532.   TMPFilenameProperty = class(TStringProperty)
  533.   public
  534.     procedure Edit; override;
  535.     function GetAttributes: TPropertyAttributes; override;
  536.   end;
  537.  
  538. { TTabOrderProperty
  539.   Property editor for the TabOrder property.  Prevents the property from being
  540.   displayed when more than one component is selected. }
  541.  
  542.   TTabOrderProperty = class(TIntegerProperty)
  543.   public
  544.     function GetAttributes: TPropertyAttributes; override;
  545.   end;
  546.  
  547. { TCaptionProperty
  548.   Property editor for the Caption and Text properties.  Updates the value of
  549.   the property for each change instead on when the property is approved. }
  550.  
  551.   TCaptionProperty = class(TStringProperty)
  552.   public
  553.     function GetAttributes: TPropertyAttributes; override;
  554.   end;
  555.  
  556. { TDateProperty
  557.   Property editor for date portion of TDateTime type. }
  558.  
  559.   TDateProperty = class(TPropertyEditor)
  560.     function GetAttributes: TPropertyAttributes; override;
  561.     function GetValue: string; override;
  562.     procedure SetValue(const Value: string); override;
  563.   end;
  564.  
  565. { TTimeProperty
  566.   Property editor for time portion of TDateTime type. }
  567.  
  568.   TTimeProperty = class(TPropertyEditor)
  569.     function GetAttributes: TPropertyAttributes; override;
  570.     function GetValue: string; override;
  571.     procedure SetValue(const Value: string); override;
  572.   end;
  573.  
  574. { TDateTimeProperty
  575.   Edits both date and time data... simultaneously!  }
  576.  
  577.   TDateTimeProperty = class(TPropertyEditor)
  578.     function GetAttributes: TPropertyAttributes; override;
  579.     function GetValue: string; override;
  580.     procedure SetValue(const Value: string); override;
  581.   end;
  582.  
  583.   EPropertyError = class(Exception);
  584.  
  585. { TComponentEditor
  586.   A component editor is created for each component that is selected in the
  587.   form designer based on the component's type (see GetComponentEditor and
  588.   RegisterComponentEditor).  When the component is double-clicked the Edit
  589.   method is called.  When the context menu for the component is invoked the
  590.   GetVerbCount and GetVerb methods are called to build the menu.  If one
  591.   of the verbs are selected ExecuteVerb is called.  Paste is called whenever
  592.   the component is pasted to the clipboard.  You only need to create a
  593.   component editor if you wish to add verbs to the context menu, change
  594.   the default double-click behavior, or paste an additional clipboard format.
  595.   The default component editor (TDefaultEditor) implements Edit to searchs the
  596.   properties of the component and generates (or navigates to) the OnCreate,
  597.   OnChanged, or OnClick event (whichever it finds first).  Whenever the
  598.   component modifies the component is *must* call Designer.Modified to inform
  599.   the designer that the form has been modified.
  600.  
  601.     Create(AComponent, ADesigner)
  602.       Called to create the component editor.  AComponent is the component to
  603.       be edited by the editor.  ADesigner is an interface to the designer to
  604.       find controls and create methods (this is not use often).
  605.     Edit
  606.       Called when the user double-clicks the component. The component editor can
  607.       bring up a dialog in responce to this method, for example, or some kind
  608.       of design expert.  If GetVerbCount is greater than zero, edit will execute
  609.       the first verb in the list (ExecuteVerb(0)).
  610.     ExecuteVerb(Index)
  611.       The Index'ed verb was selected by the use off the context menu.  The
  612.       meaning of this is determined by component editor.
  613.     GetVerb
  614.       The component editor should return a string that will be displayed in the
  615.       context menu.  It is the responsibility of the component editor to place
  616.       the & character and the '...' characters as appropriate.
  617.     GetVerbCount
  618.       The number of valid indexs to GetVerb and Execute verb.  The index assumed
  619.       to be zero based (i.e. 0..GetVerbCount - 1).
  620.     Copy
  621.       Called when the component is being copyied to the clipboard.  The
  622.       component's filed image is already on the clipboard.  This gives the
  623.       component editor a chance to paste a different type of format which is
  624.       ignored by the designer but might be recoginized by another application. }
  625.  
  626.   TComponentEditor = class
  627.   private
  628.     FComponent: TComponent;
  629.     FDesigner: TFormDesigner;
  630.   public
  631.     constructor Create(AComponent: TComponent; ADesigner: TFormDesigner); virtual;
  632.     procedure Edit; virtual;
  633.     procedure ExecuteVerb(Index: Integer); virtual;
  634.     function GetVerb(Index: Integer): string; virtual;
  635.     function GetVerbCount: Integer; virtual;
  636.     procedure Copy; virtual;
  637.     property Component: TComponent read FComponent;
  638.     property Designer: TFormDesigner read FDesigner;
  639.   end;
  640.  
  641.   TComponentEditorClass = class of TComponentEditor;
  642.  
  643.   TDefaultEditor = class(TComponentEditor)
  644.   private
  645.     FFirst: TPropertyEditor;
  646.     FBest: TPropertyEditor;
  647.     FContinue: Boolean;
  648.     procedure CheckEdit(PropertyEditor: TPropertyEditor);
  649.   protected
  650.     procedure EditProperty(PropertyEditor: TPropertyEditor;
  651.       var Continue, FreeEditor: Boolean); virtual;
  652.   public
  653.     procedure Edit; override;
  654.   end;
  655.  
  656. { Global variables initialized internally by the form designer }
  657.  
  658. type
  659.   TFreeCustomModulesProc = procedure (Group: Integer);
  660.  
  661. var
  662.   FreeCustomModulesProc: TFreeCustomModulesProc;
  663.  
  664. { RegisterPropertyEditor
  665.   Registers a new property editor for the given type.  When a component is
  666.   selected the Object Inspector will create a property editor for each
  667.   of the component's properties.  The property editor is created based on
  668.   the type of the property.  If, for example, the property type is an
  669.   Integer, the property editor for Integer will be created (by default
  670.   that would be TIntegerProperty). Most properties do not need specialized
  671.   property editors.  For example, if the property is an ordinal type the
  672.   default property editor will restrict the range to the ordinal subtype
  673.   range (e.g. a property of type TMyRange = 1..10 will only allow values
  674.   between 1 and 10 to be entered into the property).  Enumerated types will
  675.   display a drop-down list of all the enumerated values (e.g. TShapes =
  676.   (sCircle, sSquare, sTriangle) will be edited by a drop-down list containing
  677.   only sCircle, sSquare and sTriangle).  A property editor need only be
  678.   created if default property editor or none of the existing property editors
  679.   are sufficient to edit the property.  This is typically because the
  680.   property is an object.  The properties are looked up newest to oldest.
  681.   This allows and existing property editor replaced by a custom property
  682.   editor.
  683.  
  684.     PropertyType
  685.       The type information pointer returned by the TypeInfo built-in function
  686.       (e.g. TypeInfo(TMyRange) or TypeInfo(TShapes)).
  687.  
  688.     ComponentClass
  689.       Type type of the component to which to restrict this type editor.  This
  690.       parameter can be left nil which will mean this type editor applies to all
  691.       properties of PropertyType.
  692.  
  693.     PropertyName
  694.       The name of the property to which to restrict this type editor.  This
  695.       parameter is ignored if ComponentClass is nil.  This paramter can be
  696.       an empty string ('') which will mean that this editor applies to all
  697.       properties of PropertyType in ComponentClass.
  698.  
  699.     EditorClass
  700.       The class of the editor to be created whenever a property of the type
  701.       passed in PropertyTypeInfo is displayed in the Object Inspector.  The
  702.       class will be created by calling EditorClass.Create. }
  703.  
  704. procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  705.   const PropertyName: string; EditorClass: TPropertyEditorClass);
  706.  
  707. type
  708.   TPropertyMapperFunc = function(Obj: TPersistent;
  709.     PropInfo: PPropInfo): TPropertyEditorClass;
  710.     
  711. procedure RegisterPropertyMapper(Mapper: TPropertyMapperFunc);
  712.  
  713. procedure GetComponentProperties(Components: TComponentList;
  714.   Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);
  715.  
  716. procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  717.   ComponentEditor: TComponentEditorClass);
  718.  
  719. function GetComponentEditor(Component: TComponent;
  720.   Designer: TFormDesigner): TComponentEditor;
  721.  
  722. { Custom modules }
  723. { A custom module allows containers that descend from classes other than TForm
  724.   to be created and edited by the form designer. This is useful for other form
  725.   like containers (e.g. a report designer) or for specialized forms (e.g. an
  726.   ActiveForm) or for generic component containers (e.g. a TDataModule). It is
  727.   assumed that the base class registered will call InitInheritedComponent in its
  728.   constructor which will initialize the component from the associated DFM file
  729.   stored in the programs resources. See the constructors of TDataModule and
  730.   TForm for examples of how to write such a constructor.
  731.  
  732.   The following designer assumptions are made, depending on the base components
  733.   ancestor,
  734.  
  735.     If ComponentBaseClass descends from TForm,
  736.  
  737.        it is designed by creating an instance of the component as the form.
  738.        Allows designing TForm descendents and modifying their properties as
  739.        well as the form properties
  740.  
  741.     If ComponentBaseClass descends from TWinControl (but not TForm),
  742.  
  743.        it is designed by creating an instance of the control, placing it into a
  744.        design-time form.  The form's client size is in the default size of the
  745.        control.
  746.  
  747.     If ComponentBaseClass descends from TDataModule,
  748.  
  749.        it is designed by creating and instance of the class and creating a
  750.        special non-visual container designer to edit the components and display
  751.        the icons of the contained components.
  752.  
  753.   The module will appear in the project file with a colon and the base class
  754.   name appended after the component name (e.g. MyDataModle: TDataModule).
  755.  
  756.   Note it is not legal to register anything that does not desend from one of
  757.   the above.
  758.  
  759.   TCustomModule class
  760.     This an instance of this class is created for each custom module that is
  761.     loaded. This class is also destroyed whenever the module is unloaded.
  762.     The Saving method is called prior to the file being saved. When the context
  763.     menu for the module is invoked the GetVerbCount and GetVerb methods are
  764.     called to build the menu.  If one of the verbs are selected ExecuteVerb is
  765.     called.
  766.  
  767.     ExecuteVerb(Index)
  768.       The Index'ed verb was selected by the use off the context menu.  The
  769.       meaning of this is determined by custom module.
  770.     GetAttributes
  771.       Only used for TWinControl object to determine if the control is "client
  772.       aligned" in the designer or if the object should sized independently
  773.       from the designer.  This is a set for future expansion.
  774.     GetVerb(Index)
  775.       The custom module should return a string that will be displayed in the
  776.       context menu.  It is the responsibility of the custom module to place
  777.       the & character and the '...' characters as appropriate.
  778.     GetVerbCount
  779.       The number of valid indexs to GetVerb and Execute verb.  The index assumed
  780.       to be zero based (i.e. 0..GetVerbCount - 1).
  781.     Saving
  782.       Called prior to the module being saved.
  783.     ValidateComponent(Component)
  784.       ValidateCompoennt is called whenever a component is created by the
  785.       user for the designer to contain.  The intent is for this procedure to
  786.       raise an exception with a descriptive message if the component is not
  787.       applicable for the container. For example, a TComponent module should
  788.       throw an exception if the component descends from TControl.
  789.     Root
  790.       This is the instance being designed.}
  791.  
  792. type
  793.   TCustomModuleAttribute = (cmaVirtualSize);
  794.   TCustomModuleAttributes = set of TCustomModuleAttribute;
  795.  
  796.   TCustomModule = class
  797.   private
  798.     FRoot: TComponent;
  799.   public
  800.     constructor Create(ARoot: TComponent); virtual;
  801.     procedure ExecuteVerb(Index: Integer); virtual;
  802.     function GetAttributes: TCustomModuleAttributes; virtual;
  803.     function GetVerb(Index: Integer): string; virtual;
  804.     function GetVerbCount: Integer; virtual;
  805.     procedure Saving; virtual;
  806.     procedure ValidateComponent(Component: TComponent); virtual;
  807.     property Root: TComponent read FRoot;
  808.   end;
  809.  
  810.   TCustomModuleClass = class of TCustomModule;
  811.  
  812.   TRegisterCustomModuleProc = procedure (Group: Integer;
  813.     ComponentBaseClass: TComponentClass;
  814.     CustomModuleClass: TCustomModuleClass);
  815.  
  816. procedure RegisterCustomModule(ComponentBaseClass: TComponentClass;
  817.   CustomModuleClass: TCustomModuleClass);
  818.  
  819. var
  820.   RegisterCustomModuleProc: TRegisterCustomModuleProc;
  821.  
  822. { Routines used by the form designer for package management }
  823.  
  824. function NewEditorGroup: Integer;
  825. procedure FreeEditorGroup(Group: Integer);
  826.  
  827. implementation
  828.  
  829. uses Windows, Menus, Dialogs, Consts, Registry;
  830.  
  831. type
  832.   TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;
  833.  
  834. type
  835.   PPropertyClassRec = ^TPropertyClassRec;
  836.   TPropertyClassRec = record
  837.     Group: Integer;
  838.     PropertyType: PTypeInfo;
  839.     PropertyName: string;
  840.     ComponentClass: TClass;
  841.     EditorClass: TPropertyEditorClass;
  842.   end;
  843.  
  844. type
  845.   PPropertyMapperRec = ^TPropertyMapperRec;
  846.   TPropertyMapperRec = record
  847.     Group: Integer;
  848.     Mapper: TPropertyMapperFunc;
  849.   end;
  850.  
  851. const
  852.   PropClassMap: array[TTypeKind] of TPropertyEditorClass = (
  853.     nil, TIntegerProperty, TCharProperty, TEnumProperty,
  854.     TFloatProperty, TStringProperty, TSetProperty, TClassProperty,
  855.     TMethodProperty, TPropertyEditor, TStringProperty, TStringProperty,
  856.     TPropertyEditor, nil, nil, nil); (* tkInterface, tkArray, tkRecord *)
  857.  
  858. var
  859.   PropertyClassList: TList = nil;
  860.   EditorGroupList: TBits = nil;
  861.   PropertyMapperList: TList = nil;
  862.  
  863. const
  864.  
  865.   { context ids for the Font editor and the Color Editor, etc. }
  866.   hcDFontEditor       = 25000;
  867.   hcDColorEditor      = 25010;
  868.   hcDMediaPlayerOpen  = 25020;
  869.  
  870. { TComponentList }
  871.  
  872. constructor TComponentList.Create;
  873. begin
  874.   inherited Create;
  875.   FList := TList.Create;
  876. end;
  877.  
  878. destructor TComponentList.Destroy;
  879. begin
  880.   FList.Free;
  881.   inherited Destroy;
  882. end;
  883.  
  884. function TComponentList.Get(Index: Integer): TPersistent;
  885. begin
  886.   Result := FList[Index];
  887. end;
  888.  
  889. function TComponentList.GetCount: Integer;
  890. begin
  891.   Result := FList.Count;
  892. end;
  893.  
  894. function TComponentList.Add(Item: TPersistent): Integer;
  895. begin
  896.   Result := FList.Add(Item);
  897. end;
  898.  
  899. function TComponentList.Equals(List: TComponentList): Boolean;
  900. var
  901.   I: Integer;
  902. begin
  903.   Result := False;
  904.   if List.Count <> FList.Count then Exit;
  905.   for I := 0 to List.Count - 1 do if List[I] <> FList[I] then Exit;
  906.   Result := True;
  907. end;
  908.  
  909. { TPropertyEditor }
  910.  
  911. constructor TPropertyEditor.Create(ADesigner: TFormDesigner;
  912.   APropCount: Integer);
  913. begin
  914.   FDesigner := ADesigner;
  915.   GetMem(FPropList, APropCount * SizeOf(TInstProp));
  916.   FPropCount := APropCount;
  917. end;
  918.  
  919. destructor TPropertyEditor.Destroy;
  920. begin
  921.   if FPropList <> nil then
  922.     FreeMem(FPropList, FPropCount * SizeOf(TInstProp));
  923. end;
  924.  
  925. procedure TPropertyEditor.Activate;
  926. begin
  927. end;
  928.  
  929. function TPropertyEditor.AllEqual: Boolean;
  930. begin
  931.   Result := FPropCount = 1;
  932. end;
  933.  
  934. procedure TPropertyEditor.Edit;
  935. type
  936.   TGetStrFunc = function(const Value: string): Integer of object;
  937. var
  938.   I: Integer;
  939.   Values: TStringList;
  940.   AddValue: TGetStrFunc;
  941. begin
  942.   Values := TStringList.Create;
  943.   Values.Sorted := paSortList in GetAttributes;
  944.   try
  945.     AddValue := Values.Add;
  946.     GetValues(TGetStrProc(AddValue));
  947.     if Values.Count > 0 then
  948.     begin
  949.       I := Values.IndexOf(Value) + 1;
  950.       if I = Values.Count then I := 0;
  951.       Value := Values[I];
  952.     end;
  953.   finally
  954.     Values.Free;
  955.   end;
  956. end;
  957.  
  958. function TPropertyEditor.GetAttributes: TPropertyAttributes;
  959. begin
  960.   Result := [paMultiSelect, paRevertable];
  961. end;
  962.  
  963. function TPropertyEditor.GetComponent(Index: Integer): TPersistent;
  964. begin
  965.   Result := FPropList^[Index].Instance;
  966. end;
  967.  
  968. function TPropertyEditor.GetFloatValue: Extended;
  969. begin
  970.   Result := GetFloatValueAt(0);
  971. end;
  972.  
  973. function TPropertyEditor.GetFloatValueAt(Index: Integer): Extended;
  974. begin
  975.   with FPropList^[Index] do Result := GetFloatProp(Instance, PropInfo);
  976. end;
  977.  
  978. function TPropertyEditor.GetMethodValue: TMethod;
  979. begin
  980.   Result := GetMethodValueAt(0);
  981. end;
  982.  
  983. function TPropertyEditor.GetMethodValueAt(Index: Integer): TMethod;
  984. begin
  985.   with FPropList^[Index] do Result := GetMethodProp(Instance, PropInfo);
  986. end;
  987.  
  988. function TPropertyEditor.GetEditLimit: Integer;
  989. begin
  990.   Result := 255;
  991. end;
  992.  
  993. function TPropertyEditor.GetName: string;
  994. begin
  995.   Result := FPropList^[0].PropInfo^.Name;
  996. end;
  997.  
  998. function TPropertyEditor.GetOrdValue: Longint;
  999. begin
  1000.   Result := GetOrdValueAt(0);
  1001. end;
  1002.  
  1003. function TPropertyEditor.GetOrdValueAt(Index: Integer): Longint;
  1004. begin
  1005.   with FPropList^[Index] do Result := GetOrdProp(Instance, PropInfo);
  1006. end;
  1007.  
  1008. function TPropertyEditor.GetPrivateDirectory: string;
  1009. begin
  1010.   Result := Designer.GetPrivateDirectory;
  1011. end;
  1012.  
  1013. procedure TPropertyEditor.GetProperties(Proc: TGetPropEditProc);
  1014. begin
  1015. end;
  1016.  
  1017. function TPropertyEditor.GetPropInfo: PPropInfo;
  1018. begin
  1019.   Result := FPropList^[0].PropInfo;
  1020. end;
  1021.  
  1022. function TPropertyEditor.GetPropType: PTypeInfo;
  1023. begin
  1024.   Result := FPropList^[0].PropInfo^.PropType^;
  1025. end;
  1026.  
  1027. function TPropertyEditor.GetStrValue: string;
  1028. begin
  1029.   Result := GetStrValueAt(0);
  1030. end;
  1031.  
  1032. function TPropertyEditor.GetStrValueAt(Index: Integer): string;
  1033. begin
  1034.   with FPropList^[Index] do Result := GetStrProp(Instance, PropInfo);
  1035. end;
  1036.  
  1037. function TPropertyEditor.GetVarValue: Variant;
  1038. begin
  1039.   Result := GetVarValueAt(0);
  1040. end;
  1041.  
  1042. function TPropertyEditor.GetVarValueAt(Index: Integer): Variant;
  1043. begin
  1044.   with FPropList^[Index] do Result := GetVariantProp(Instance, PropInfo);
  1045. end;
  1046.  
  1047. function TPropertyEditor.GetValue: string;
  1048. begin
  1049.   Result := srUnknown;
  1050. end;
  1051.  
  1052. procedure TPropertyEditor.GetValues(Proc: TGetStrProc);
  1053. begin
  1054. end;
  1055.  
  1056. procedure TPropertyEditor.Initialize;
  1057. begin
  1058. end;
  1059.  
  1060. procedure TPropertyEditor.Modified;
  1061. begin
  1062.   Designer.Modified;
  1063. end;
  1064.  
  1065. procedure TPropertyEditor.SetFloatValue(Value: Extended);
  1066. var
  1067.   I: Integer;
  1068. begin
  1069.   for I := 0 to FPropCount - 1 do
  1070.     with FPropList^[I] do SetFloatProp(Instance, PropInfo, Value);
  1071.   Modified;
  1072. end;
  1073.  
  1074. procedure TPropertyEditor.SetMethodValue(const Value: TMethod);
  1075. var
  1076.   I: Integer;
  1077. begin
  1078.   for I := 0 to FPropCount - 1 do
  1079.     with FPropList^[I] do SetMethodProp(Instance, PropInfo, Value);
  1080.   Modified;
  1081. end;
  1082.  
  1083. procedure TPropertyEditor.SetOrdValue(Value: Longint);
  1084. var
  1085.   I: Integer;
  1086. begin
  1087.   for I := 0 to FPropCount - 1 do
  1088.     with FPropList^[I] do SetOrdProp(Instance, PropInfo, Value);
  1089.   Modified;
  1090. end;
  1091.  
  1092. procedure TPropertyEditor.SetPropEntry(Index: Integer;
  1093.   AInstance: TPersistent; APropInfo: PPropInfo);
  1094. begin
  1095.   with FPropList^[Index] do
  1096.   begin
  1097.     Instance := AInstance;
  1098.     PropInfo := APropInfo;
  1099.   end;
  1100. end;
  1101.  
  1102. procedure TPropertyEditor.SetStrValue(const Value: string);
  1103. var
  1104.   I: Integer;
  1105. begin
  1106.   for I := 0 to FPropCount - 1 do
  1107.     with FPropList^[I] do SetStrProp(Instance, PropInfo, Value);
  1108.   Modified;
  1109. end;
  1110.  
  1111. procedure TPropertyEditor.SetVarValue(const Value: Variant);
  1112. var
  1113.   I: Integer;
  1114. begin
  1115.   for I := 0 to FPropCount - 1 do
  1116.     with FPropList^[I] do SetVariantProp(Instance, PropInfo, Value);
  1117.   Modified;
  1118. end;
  1119.  
  1120. procedure TPropertyEditor.Revert;
  1121. var
  1122.   I: Integer;
  1123. begin
  1124.   for I := 0 to FPropCount - 1 do
  1125.     with FPropList^[I] do Designer.Revert(Instance, PropInfo);
  1126. end;
  1127.  
  1128. procedure TPropertyEditor.SetValue(const Value: string);
  1129. begin
  1130. end;
  1131.  
  1132. function TPropertyEditor.ValueAvailable: Boolean;
  1133. var
  1134.   I: Integer;
  1135.   S: string;
  1136. begin
  1137.   Result := True;
  1138.   for I := 0 to FPropCount - 1 do
  1139.   begin
  1140.     if (FPropList^[I].Instance is TComponent) and
  1141.       (csCheckPropAvail in TComponent(FPropList^[I].Instance).ComponentStyle) then
  1142.     begin
  1143.       try
  1144.         S := GetValue;
  1145.         AllEqual;
  1146.       except
  1147.         Result := False;
  1148.       end;
  1149.       Exit;
  1150.     end;
  1151.   end;
  1152. end;
  1153.  
  1154. { TOrdinalProperty }
  1155.  
  1156. function TOrdinalProperty.AllEqual: Boolean;
  1157. var
  1158.   I: Integer;
  1159.   V: Longint;
  1160. begin
  1161.   Result := False;
  1162.   if PropCount > 1 then
  1163.   begin
  1164.     V := GetOrdValue;
  1165.     for I := 1 to PropCount - 1 do
  1166.       if GetOrdValueAt(I) <> V then Exit;
  1167.   end;
  1168.   Result := True;
  1169. end;
  1170.  
  1171. function TOrdinalProperty.GetEditLimit: Integer;
  1172. begin
  1173.   Result := 63;
  1174. end;
  1175.  
  1176. { TIntegerProperty }
  1177.  
  1178. function TIntegerProperty.GetValue: string;
  1179. begin
  1180.   Result := IntToStr(GetOrdValue);
  1181. end;
  1182.  
  1183. procedure TIntegerProperty.SetValue(const Value: String);
  1184. var
  1185.   L: Longint;
  1186. begin
  1187.   L := StrToInt(Value);
  1188.   with GetTypeData(GetPropType)^ do
  1189.     if (L < MinValue) or (L > MaxValue) then
  1190.       raise EPropertyError.CreateFmt(SOutOfRange, [MinValue, MaxValue]);
  1191.   SetOrdValue(L);
  1192. end;
  1193.  
  1194. { TCharProperty }
  1195.  
  1196. function TCharProperty.GetValue: string;
  1197. var
  1198.   Ch: Char;
  1199. begin
  1200.   Ch := Chr(GetOrdValue);
  1201.   if Ch in [#33..#127] then
  1202.     Result := Ch else
  1203.     FmtStr(Result, '#%d', [Ord(Ch)]);
  1204. end;
  1205.  
  1206. procedure TCharProperty.SetValue(const Value: string);
  1207. var
  1208.   L: Longint;
  1209. begin
  1210.   if Length(Value) = 0 then L := 0 else
  1211.     if Length(Value) = 1 then L := Ord(Value[1]) else
  1212.       if Value[1] = '#' then L := StrToInt(Copy(Value, 2, Maxint)) else
  1213.         raise EPropertyError.Create(SInvalidPropertyValue);
  1214.   with GetTypeData(GetPropType)^ do
  1215.     if (L < MinValue) or (L > MaxValue) then
  1216.       raise EPropertyError.CreateFmt(SOutOfRange, [MinValue, MaxValue]);
  1217.   SetOrdValue(L);
  1218. end;
  1219.  
  1220. { TEnumProperty }
  1221.  
  1222. function TEnumProperty.GetAttributes: TPropertyAttributes;
  1223. begin
  1224.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1225. end;
  1226.  
  1227. function TEnumProperty.GetValue: string;
  1228. var
  1229.   L: Longint;
  1230. begin
  1231.   L := GetOrdValue;
  1232.   with GetTypeData(GetPropType)^ do
  1233.     if (L < MinValue) or (L > MaxValue) then L := MaxValue;
  1234.   Result := GetEnumName(GetPropType, L);
  1235. end;
  1236.  
  1237. procedure TEnumProperty.GetValues(Proc: TGetStrProc);
  1238. var
  1239.   I: Integer;
  1240.   EnumType: PTypeInfo;
  1241. begin
  1242.   EnumType := GetPropType;
  1243.   with GetTypeData(EnumType)^ do
  1244.     for I := MinValue to MaxValue do Proc(GetEnumName(EnumType, I));
  1245. end;
  1246.  
  1247. procedure TEnumProperty.SetValue(const Value: string);
  1248. var
  1249.   I: Integer;
  1250. begin
  1251.   I := GetEnumValue(GetPropType, Value);
  1252.   if I < 0 then raise EPropertyError.Create(SInvalidPropertyValue);
  1253.   SetOrdValue(I);
  1254. end;
  1255.  
  1256. { TBoolProperty  }
  1257.  
  1258. function TBoolProperty.GetValue: string;
  1259. begin
  1260.   if GetOrdValue = 0 then
  1261.     Result := 'False'
  1262.   else
  1263.     Result := 'True';
  1264. end;
  1265.  
  1266. procedure TBoolProperty.GetValues(Proc: TGetStrProc);
  1267. begin
  1268.   Proc('False');
  1269.   Proc('True');
  1270. end;
  1271.  
  1272. procedure TBoolProperty.SetValue(const Value: string);
  1273. var
  1274.   I: Integer;
  1275. begin
  1276.   if CompareText(Value, 'False') = 0 then
  1277.     I := 0
  1278.   else if CompareText(Value, 'True') = 0 then
  1279.     I := -1
  1280.   else
  1281.     I := StrToInt(Value);
  1282.   SetOrdValue(I);
  1283. end;
  1284.  
  1285. { TFloatProperty }
  1286.  
  1287. function TFloatProperty.AllEqual: Boolean;
  1288. var
  1289.   I: Integer;
  1290.   V: Extended;
  1291. begin
  1292.   Result := False;
  1293.   if PropCount > 1 then
  1294.   begin
  1295.     V := GetFloatValue;
  1296.     for I := 1 to PropCount - 1 do
  1297.       if GetFloatValueAt(I) <> V then Exit;
  1298.   end;
  1299.   Result := True;
  1300. end;
  1301.  
  1302. function TFloatProperty.GetValue: string;
  1303. const
  1304.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 18);
  1305. begin
  1306.   Result := FloatToStrF(GetFloatValue, ffGeneral,
  1307.     Precisions[GetTypeData(GetPropType)^.FloatType], 0);
  1308. end;
  1309.  
  1310. procedure TFloatProperty.SetValue(const Value: string);
  1311. begin
  1312.   SetFloatValue(StrToFloat(Value));
  1313. end;
  1314.  
  1315. { TStringProperty }
  1316.  
  1317. function TStringProperty.AllEqual: Boolean;
  1318. var
  1319.   I: Integer;
  1320.   V: string;
  1321. begin
  1322.   Result := False;
  1323.   if PropCount > 1 then
  1324.   begin
  1325.     V := GetStrValue;
  1326.     for I := 1 to PropCount - 1 do
  1327.       if GetStrValueAt(I) <> V then Exit;
  1328.   end;
  1329.   Result := True;
  1330. end;
  1331.  
  1332. function TStringProperty.GetEditLimit: Integer;
  1333. begin
  1334.   if GetPropType^.Kind = tkString then
  1335.     Result := GetTypeData(GetPropType)^.MaxLength else
  1336.     Result := 255;
  1337. end;
  1338.  
  1339. function TStringProperty.GetValue: string;
  1340. begin
  1341.   Result := GetStrValue;
  1342. end;
  1343.  
  1344. procedure TStringProperty.SetValue(const Value: string);
  1345. begin
  1346.   SetStrValue(Value);
  1347. end;
  1348.  
  1349. { TComponentNameProperty }
  1350.  
  1351. function TComponentNameProperty.GetAttributes: TPropertyAttributes;
  1352. begin
  1353.   Result := [];
  1354. end;
  1355.  
  1356. function TComponentNameProperty.GetEditLimit: Integer;
  1357. begin
  1358.   Result := 63;
  1359. end;
  1360.  
  1361. { TSetElementProperty }
  1362.  
  1363. constructor TSetElementProperty.Create(ADesigner: TFormDesigner;
  1364.   APropList: PInstPropList; APropCount: Integer; AElement: Integer);
  1365. begin
  1366.   FDesigner := ADesigner;
  1367.   FPropList := APropList;
  1368.   FPropCount := APropCount;
  1369.   FElement := AElement;
  1370. end;
  1371.  
  1372. destructor TSetElementProperty.Destroy;
  1373. begin
  1374. end;
  1375.  
  1376. function TSetElementProperty.AllEqual: Boolean;
  1377. var
  1378.   I: Integer;
  1379.   S: TIntegerSet;
  1380.   V: Boolean;
  1381. begin
  1382.   Result := False;
  1383.   if PropCount > 1 then
  1384.   begin
  1385.     Integer(S) := GetOrdValue;
  1386.     V := FElement in S;
  1387.     for I := 1 to PropCount - 1 do
  1388.     begin
  1389.       Integer(S) := GetOrdValueAt(I);
  1390.       if (FElement in S) <> V then Exit;
  1391.     end;
  1392.   end;
  1393.   Result := True;
  1394. end;
  1395.  
  1396. function TSetElementProperty.GetAttributes: TPropertyAttributes;
  1397. begin
  1398.   Result := [paMultiSelect, paValueList, paSortList];
  1399. end;
  1400.  
  1401. function TSetElementProperty.GetName: string;
  1402. begin
  1403.   Result := GetEnumName(GetTypeData(GetPropType)^.CompType^, FElement);
  1404. end;
  1405.  
  1406. function TSetElementProperty.GetValue: string;
  1407. var
  1408.   S: TIntegerSet;
  1409. begin
  1410.   Integer(S) := GetOrdValue;
  1411.   if FElement in S then Result := 'True' else Result := 'False';
  1412. end;
  1413.  
  1414. procedure TSetElementProperty.GetValues(Proc: TGetStrProc);
  1415. begin
  1416.   Proc('False');
  1417.   Proc('True');
  1418. end;
  1419.  
  1420. procedure TSetElementProperty.SetValue(const Value: string);
  1421. var
  1422.   S: TIntegerSet;
  1423. begin
  1424.   Integer(S) := GetOrdValue;
  1425.   if CompareText(Value, 'True') = 0 then
  1426.     Include(S, FElement) else
  1427.     Exclude(S, FElement);
  1428.   SetOrdValue(Integer(S));
  1429. end;
  1430.  
  1431. { TSetProperty }
  1432.  
  1433. function TSetProperty.GetAttributes: TPropertyAttributes;
  1434. begin
  1435.   Result := [paMultiSelect, paSubProperties, paReadOnly, paRevertable];
  1436. end;
  1437.  
  1438. procedure TSetProperty.GetProperties(Proc: TGetPropEditProc);
  1439. var
  1440.   I: Integer;
  1441. begin
  1442.   with GetTypeData(GetTypeData(GetPropType)^.CompType^)^ do
  1443.     for I := MinValue to MaxValue do
  1444.       Proc(TSetElementProperty.Create(FDesigner, FPropList, FPropCount, I));
  1445. end;
  1446.  
  1447. function TSetProperty.GetValue: string;
  1448. var
  1449.   S: TIntegerSet;
  1450.   TypeInfo: PTypeInfo;
  1451.   I: Integer;
  1452. begin
  1453.   Integer(S) := GetOrdValue;
  1454.   TypeInfo := GetTypeData(GetPropType)^.CompType^;
  1455.   Result := '[';
  1456.   for I := 0 to SizeOf(Integer) * 8 - 1 do
  1457.     if I in S then
  1458.     begin
  1459.       if Length(Result) <> 1 then Result := Result + ',';
  1460.       Result := Result + GetEnumName(TypeInfo, I);
  1461.     end;
  1462.   Result := Result + ']';
  1463. end;
  1464.  
  1465. { TClassProperty }
  1466.  
  1467. function TClassProperty.GetAttributes: TPropertyAttributes;
  1468. begin
  1469.   Result := [paMultiSelect, paSubProperties, paReadOnly];
  1470. end;
  1471.  
  1472. procedure TClassProperty.GetProperties(Proc: TGetPropEditProc);
  1473. var
  1474.   I: Integer;
  1475.   Components: TComponentList;
  1476. begin
  1477.   Components := TComponentList.Create;
  1478.   try
  1479.     for I := 0 to PropCount - 1 do
  1480.       Components.Add(TComponent(GetOrdValueAt(I)));
  1481.     GetComponentProperties(Components, tkProperties, Designer, Proc);
  1482.   finally
  1483.     Components.Free;
  1484.   end;
  1485. end;
  1486.  
  1487. function TClassProperty.GetValue: string;
  1488. begin
  1489.   FmtStr(Result, '(%s)', [GetPropType^.Name]);
  1490. end;
  1491.  
  1492. { TComponentProperty }
  1493.  
  1494. function TComponentProperty.GetAttributes: TPropertyAttributes;
  1495. begin
  1496.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1497. end;
  1498.  
  1499. function TComponentProperty.GetEditLimit: Integer;
  1500. begin
  1501.   Result := 127;
  1502. end;
  1503.  
  1504. function TComponentProperty.GetValue: string;
  1505. begin
  1506.   Result := Designer.GetComponentName(TComponent(GetOrdValue));
  1507. end;
  1508.  
  1509. procedure TComponentProperty.GetValues(Proc: TGetStrProc);
  1510. begin
  1511.   Designer.GetComponentNames(GetTypeData(GetPropType), Proc);
  1512. end;
  1513.  
  1514. procedure TComponentProperty.SetValue(const Value: string);
  1515. var
  1516.   Component: TComponent;
  1517. begin
  1518.   if Value = '' then Component := nil else
  1519.   begin
  1520.     Component := Designer.GetComponent(Value);
  1521.     if not (Component is GetTypeData(GetPropType)^.ClassType) then
  1522.       raise EPropertyError.Create(SInvalidPropertyValue);
  1523.   end;
  1524.   SetOrdValue(Longint(Component));
  1525. end;
  1526.  
  1527. { TMethodProperty }
  1528.  
  1529. function TMethodProperty.AllEqual: Boolean;
  1530. var
  1531.   I: Integer;
  1532.   V, T: TMethod;
  1533. begin
  1534.   Result := False;
  1535.   if PropCount > 1 then
  1536.   begin
  1537.     V := GetMethodValue;
  1538.     for I := 1 to PropCount - 1 do
  1539.     begin
  1540.       T := GetMethodValueAt(I);
  1541.       if (T.Code <> V.Code) or (T.Data <> V.Data) then Exit;
  1542.     end;
  1543.   end;
  1544.   Result := True;
  1545. end;
  1546.  
  1547. procedure TMethodProperty.Edit;
  1548. var
  1549.   FormMethodName: string;
  1550. begin
  1551.   FormMethodName := GetValue;
  1552.   if (FormMethodName = '') or
  1553.     Designer.MethodFromAncestor(GetMethodValue) then
  1554.   begin
  1555.     if FormMethodName = '' then
  1556.       FormMethodName := GetFormMethodName;
  1557.     if FormMethodName = '' then
  1558.       raise EPropertyError.Create(SCannotCreateName);
  1559.     SetMethodValue(Designer.CreateMethod(FormMethodName,
  1560.       GetTypeData(GetPropType)));
  1561.   end;
  1562.   Designer.ShowMethod(FormMethodName);
  1563. end;
  1564.  
  1565. function TMethodProperty.GetAttributes: TPropertyAttributes;
  1566. begin
  1567.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1568. end;
  1569.  
  1570. function TMethodProperty.GetEditLimit: Integer;
  1571. begin
  1572.   Result := 63;
  1573. end;
  1574.  
  1575. function TMethodProperty.GetFormMethodName: string;
  1576. var
  1577.   I: Integer;
  1578. begin
  1579.   if GetComponent(0) = Designer.Form then
  1580.     Result := 'Form'
  1581.   else
  1582.   begin
  1583.     Result := Designer.GetObjectName(GetComponent(0));
  1584.     for I := Length(Result) downto 1 do
  1585.       if Result[I] in ['.','[',']'] then
  1586.         Delete(Result, I, 1);
  1587.   end;
  1588.   if Result = '' then
  1589.     raise EPropertyError.Create(SCannotCreateName);
  1590.   Result := Result + GetTrimmedEventName;
  1591. end;
  1592.  
  1593. function TMethodProperty.GetTrimmedEventName: string;
  1594. begin
  1595.   Result := GetName;
  1596.   if (Length(Result) >= 2) and
  1597.     (Result[1] in ['O','o']) and (Result[2] in ['N','n']) then
  1598.     Delete(Result,1,2);
  1599. end;
  1600.  
  1601. function TMethodProperty.GetValue: string;
  1602. begin
  1603.   Result := Designer.GetMethodName(GetMethodValue);
  1604. end;
  1605.  
  1606. procedure TMethodProperty.GetValues(Proc: TGetStrProc);
  1607. begin
  1608.   Designer.GetMethods(GetTypeData(GetPropType), Proc);
  1609. end;
  1610.  
  1611. procedure TMethodProperty.SetValue(const AValue: string);
  1612. var
  1613.   NewMethod: Boolean;
  1614.   CurValue: string;
  1615. begin
  1616.   CurValue:= GetValue;
  1617.   if (CurValue <> '') and (AValue <> '') and
  1618.     ((CompareText(CurValue, AValue) = 0) or
  1619.     not Designer.MethodExists(AValue)) then
  1620.     Designer.RenameMethod(CurValue, AValue)
  1621.   else
  1622.   begin
  1623.     NewMethod := (AValue <> '') and not Designer.MethodExists(AValue);
  1624.     SetMethodValue(Designer.CreateMethod(AValue, GetTypeData(GetPropType)));
  1625.     if NewMethod then Designer.ShowMethod(AValue);
  1626.   end;
  1627. end;
  1628.  
  1629. { TFontNameProperty }
  1630.  
  1631. function TFontNameProperty.GetAttributes: TPropertyAttributes;
  1632. begin
  1633.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1634. end;
  1635.  
  1636. procedure TFontNameProperty.GetValues(Proc: TGetStrProc);
  1637. var
  1638.   I: Integer;
  1639. begin
  1640.   for I := 0 to Screen.Fonts.Count - 1 do Proc(Screen.Fonts[I]);
  1641. end;
  1642.  
  1643. { TFontCharsetProperty }
  1644.  
  1645. function TFontCharsetProperty.GetAttributes: TPropertyAttributes;
  1646. begin
  1647.   Result := [paMultiSelect, paSortList, paValueList];
  1648. end;
  1649.  
  1650. function TFontCharsetProperty.GetValue: string;
  1651. begin
  1652.   if not CharsetToIdent(TFontCharset(GetOrdValue), Result) then
  1653.     FmtStr(Result, '%d', [GetOrdValue]);
  1654. end;
  1655.  
  1656. procedure TFontCharsetProperty.GetValues(Proc: TGetStrProc);
  1657. begin
  1658.   GetCharsetValues(Proc);
  1659. end;
  1660.  
  1661. procedure TFontCharsetProperty.SetValue(const Value: string);
  1662. var
  1663.   NewValue: Longint;
  1664. begin
  1665.   if IdentToCharset(Value, NewValue) then
  1666.     SetOrdValue(NewValue)
  1667.   else inherited SetValue(Value);
  1668. end;
  1669.  
  1670. { TImeNameProperty }
  1671.  
  1672. function TImeNameProperty.GetAttributes: TPropertyAttributes;
  1673. begin
  1674.   Result := [paValueList, paSortList, paMultiSelect];
  1675. end;
  1676.  
  1677. procedure TImeNameProperty.GetValues(Proc: TGetStrProc);
  1678. var
  1679.   I: Integer;
  1680. begin
  1681.   for I := 0 to Screen.Imes.Count - 1 do Proc(Screen.Imes[I]);
  1682. end;
  1683.  
  1684. { TMPFilenameProperty }
  1685.  
  1686. procedure TMPFilenameProperty.Edit;
  1687. var
  1688.   MPFileOpen: TOpenDialog;
  1689. begin
  1690.   MPFileOpen := TOpenDialog.Create(Application);
  1691.   MPFileOpen.Filename := GetValue;
  1692.   MPFileOpen.Filter := SMPOpenFilter;
  1693.   MPFileOpen.HelpContext := hcDMediaPlayerOpen;
  1694.   MPFileOpen.Options := MPFileOpen.Options + [ofShowHelp, ofPathMustExist,
  1695.     ofFileMustExist];
  1696.   try
  1697.     if MPFileOpen.Execute then SetValue(MPFileOpen.Filename);
  1698.   finally
  1699.     MPFileOpen.Free;
  1700.   end;
  1701. end;
  1702.  
  1703. function TMPFilenameProperty.GetAttributes: TPropertyAttributes;
  1704. begin
  1705.   Result := [paDialog, paRevertable];
  1706. end;
  1707.  
  1708. { TColorProperty }
  1709.  
  1710. procedure TColorProperty.Edit;
  1711. var
  1712.   ColorDialog: TColorDialog;
  1713.   IniFile: TRegIniFile;
  1714.  
  1715.   procedure GetCustomColors;
  1716.   begin
  1717.     IniFile := TRegIniFile.Create('\Software\Borland\Delphi\3.0');
  1718.     try
  1719.       IniFile.ReadSectionValues(SCustomColors,
  1720.         ColorDialog.CustomColors);
  1721.     except
  1722.       { Ignore errors reading values }
  1723.     end;
  1724.   end;
  1725.  
  1726.   procedure SaveCustomColors;
  1727.   var
  1728.     I, P: Integer;
  1729.     S: string;
  1730.   begin
  1731.     if IniFile <> nil then
  1732.       with ColorDialog do
  1733.         for I := 0 to CustomColors.Count - 1 do
  1734.         begin
  1735.           S := CustomColors.Strings[I];
  1736.           P := Pos('=', S);
  1737.           if P <> 0 then
  1738.           begin
  1739.             S := Copy(S, 1, P - 1);
  1740.             IniFile.WriteString(SCustomColors, S,
  1741.               CustomColors.Values[S]);
  1742.           end;
  1743.         end;
  1744.   end;
  1745.  
  1746. begin
  1747.   IniFile := nil;
  1748.   ColorDialog := TColorDialog.Create(Application);
  1749.   try
  1750.     GetCustomColors;
  1751.     ColorDialog.Color := GetOrdValue;
  1752.     ColorDialog.HelpContext := hcDColorEditor;
  1753.     ColorDialog.Options := [cdShowHelp];
  1754.     if ColorDialog.Execute then SetOrdValue(ColorDialog.Color);
  1755.     SaveCustomColors;
  1756.   finally
  1757.     if IniFile <> nil then IniFile.Free;
  1758.     ColorDialog.Free;
  1759.   end;
  1760. end;
  1761.  
  1762. function TColorProperty.GetAttributes: TPropertyAttributes;
  1763. begin
  1764.   Result := [paMultiSelect, paDialog, paValueList, paRevertable];
  1765. end;
  1766.  
  1767. function TColorProperty.GetValue: string;
  1768. begin
  1769.   Result := ColorToString(TColor(GetOrdValue));
  1770. end;
  1771.  
  1772. procedure TColorProperty.GetValues(Proc: TGetStrProc);
  1773. begin
  1774.   GetColorValues(Proc);
  1775. end;
  1776.  
  1777. procedure TColorProperty.SetValue(const Value: string);
  1778. var
  1779.   NewValue: Longint;
  1780. begin
  1781.   if IdentToColor(Value, NewValue) then
  1782.     SetOrdValue(NewValue)
  1783.   else inherited SetValue(Value);
  1784. end;
  1785.  
  1786. { TCursorProperty }
  1787.  
  1788. function TCursorProperty.GetAttributes: TPropertyAttributes;
  1789. begin
  1790.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1791. end;
  1792.  
  1793. function TCursorProperty.GetValue: string;
  1794. begin
  1795.   Result := CursorToString(TCursor(GetOrdValue));
  1796. end;
  1797.  
  1798. procedure TCursorProperty.GetValues(Proc: TGetStrProc);
  1799. begin
  1800.   GetCursorValues(Proc);
  1801. end;
  1802.  
  1803. procedure TCursorProperty.SetValue(const Value: string);
  1804. var
  1805.   NewValue: Longint;
  1806. begin
  1807.   if IdentToCursor(Value, NewValue) then
  1808.     SetOrdValue(NewValue)
  1809.   else inherited SetValue(Value);
  1810. end;
  1811.  
  1812. { TFontProperty }
  1813.  
  1814. procedure TFontProperty.Edit;
  1815. var
  1816.   FontDialog: TFontDialog;
  1817. begin
  1818.   FontDialog := TFontDialog.Create(Application);
  1819.   try
  1820.     FontDialog.Font := TFont(GetOrdValue);
  1821.     FontDialog.HelpContext := hcDFontEditor;
  1822.     FontDialog.Options := FontDialog.Options + [fdShowHelp, fdForceFontExist];
  1823.     if FontDialog.Execute then SetOrdValue(Longint(FontDialog.Font));
  1824.   finally
  1825.     FontDialog.Free;
  1826.   end;
  1827. end;
  1828.  
  1829. function TFontProperty.GetAttributes: TPropertyAttributes;
  1830. begin
  1831.   Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
  1832. end;
  1833.  
  1834. { TModalResultProperty }
  1835.  
  1836. const
  1837.   ModalResults: array[mrNone..mrYesToAll] of string = (
  1838.     'mrNone',
  1839.     'mrOk',
  1840.     'mrCancel',
  1841.     'mrAbort',
  1842.     'mrRetry',
  1843.     'mrIgnore',
  1844.     'mrYes',
  1845.     'mrNo',
  1846.     'mrAll',
  1847.     'mrNoToAll',
  1848.     'mrYesToAll');
  1849.  
  1850. function TModalResultProperty.GetAttributes: TPropertyAttributes;
  1851. begin
  1852.   Result := [paMultiSelect, paValueList, paRevertable];
  1853. end;
  1854.  
  1855. function TModalResultProperty.GetValue: string;
  1856. var
  1857.   CurValue: Longint;
  1858. begin
  1859.   CurValue := GetOrdValue;
  1860.   case CurValue of
  1861.     Low(ModalResults)..High(ModalResults):
  1862.       Result := ModalResults[CurValue];
  1863.   else
  1864.     Result := IntToStr(CurValue);
  1865.   end;
  1866. end;
  1867.  
  1868. procedure TModalResultProperty.GetValues(Proc: TGetStrProc);
  1869. var
  1870.   I: Integer;
  1871. begin
  1872.   for I := Low(ModalResults) to High(ModalResults) do Proc(ModalResults[I]);
  1873. end;
  1874.  
  1875. procedure TModalResultProperty.SetValue(const Value: string);
  1876. var
  1877.   I: Integer;
  1878. begin
  1879.   if Value = '' then
  1880.   begin
  1881.     SetOrdValue(0);
  1882.     Exit;
  1883.   end;
  1884.   for I := Low(ModalResults) to High(ModalResults) do
  1885.     if CompareText(ModalResults[I], Value) = 0 then
  1886.     begin
  1887.       SetOrdValue(I);
  1888.       Exit;
  1889.     end;
  1890.   inherited SetValue(Value);
  1891. end;
  1892.  
  1893. { TShortCutProperty }
  1894.  
  1895. const
  1896.   ShortCuts: array[0..82] of TShortCut = (
  1897.     scNone,
  1898.     Byte('A') or scCtrl,
  1899.     Byte('B') or scCtrl,
  1900.     Byte('C') or scCtrl,
  1901.     Byte('D') or scCtrl,
  1902.     Byte('E') or scCtrl,
  1903.     Byte('F') or scCtrl,
  1904.     Byte('G') or scCtrl,
  1905.     Byte('H') or scCtrl,
  1906.     Byte('I') or scCtrl,
  1907.     Byte('J') or scCtrl,
  1908.     Byte('K') or scCtrl,
  1909.     Byte('L') or scCtrl,
  1910.     Byte('M') or scCtrl,
  1911.     Byte('N') or scCtrl,
  1912.     Byte('O') or scCtrl,
  1913.     Byte('P') or scCtrl,
  1914.     Byte('Q') or scCtrl,
  1915.     Byte('R') or scCtrl,
  1916.     Byte('S') or scCtrl,
  1917.     Byte('T') or scCtrl,
  1918.     Byte('U') or scCtrl,
  1919.     Byte('V') or scCtrl,
  1920.     Byte('W') or scCtrl,
  1921.     Byte('X') or scCtrl,
  1922.     Byte('Y') or scCtrl,
  1923.     Byte('Z') or scCtrl,
  1924.     VK_F1,
  1925.     VK_F2,
  1926.     VK_F3,
  1927.     VK_F4,
  1928.     VK_F5,
  1929.     VK_F6,
  1930.     VK_F7,
  1931.     VK_F8,
  1932.     VK_F9,
  1933.     VK_F10,
  1934.     VK_F11,
  1935.     VK_F12,
  1936.     VK_F1 or scCtrl,
  1937.     VK_F2 or scCtrl,
  1938.     VK_F3 or scCtrl,
  1939.     VK_F4 or scCtrl,
  1940.     VK_F5 or scCtrl,
  1941.     VK_F6 or scCtrl,
  1942.     VK_F7 or scCtrl,
  1943.     VK_F8 or scCtrl,
  1944.     VK_F9 or scCtrl,
  1945.     VK_F10 or scCtrl,
  1946.     VK_F11 or scCtrl,
  1947.     VK_F12 or scCtrl,
  1948.     VK_F1 or scShift,
  1949.     VK_F2 or scShift,
  1950.     VK_F3 or scShift,
  1951.     VK_F4 or scShift,
  1952.     VK_F5 or scShift,
  1953.     VK_F6 or scShift,
  1954.     VK_F7 or scShift,
  1955.     VK_F8 or scShift,
  1956.     VK_F9 or scShift,
  1957.     VK_F10 or scShift,
  1958.     VK_F11 or scShift,
  1959.     VK_F12 or scShift,
  1960.     VK_F1 or scShift or scCtrl,
  1961.     VK_F2 or scShift or scCtrl,
  1962.     VK_F3 or scShift or scCtrl,
  1963.     VK_F4 or scShift or scCtrl,
  1964.     VK_F5 or scShift or scCtrl,
  1965.     VK_F6 or scShift or scCtrl,
  1966.     VK_F7 or scShift or scCtrl,
  1967.     VK_F8 or scShift or scCtrl,
  1968.     VK_F9 or scShift or scCtrl,
  1969.     VK_F10 or scShift or scCtrl,
  1970.     VK_F11 or scShift or scCtrl,
  1971.     VK_F12 or scShift or scCtrl,
  1972.     VK_INSERT,
  1973.     VK_INSERT or scShift,
  1974.     VK_INSERT or scCtrl,
  1975.     VK_DELETE,
  1976.     VK_DELETE or scShift,
  1977.     VK_DELETE or scCtrl,
  1978.     VK_BACK or scAlt,
  1979.     VK_BACK or scShift or scAlt);
  1980.  
  1981. function TShortCutProperty.GetAttributes: TPropertyAttributes;
  1982. begin
  1983.   Result := [paMultiSelect, paValueList, paRevertable];
  1984. end;
  1985.  
  1986. function TShortCutProperty.GetValue: string;
  1987. var
  1988.   CurValue: TShortCut;
  1989. begin
  1990.   CurValue := GetOrdValue;
  1991.   if CurValue = scNone then
  1992.     Result := srNone else
  1993.     Result := ShortCutToText(CurValue);
  1994. end;
  1995.  
  1996. procedure TShortCutProperty.GetValues(Proc: TGetStrProc);
  1997. var
  1998.   I: Integer;
  1999. begin
  2000.   Proc(srNone);
  2001.   for I := 1 to High(ShortCuts) do Proc(ShortCutToText(ShortCuts[I]));
  2002. end;
  2003.  
  2004. procedure TShortCutProperty.SetValue(const Value: string);
  2005. var
  2006.   NewValue: TShortCut;
  2007. begin
  2008.   NewValue := 0;
  2009.   if (Value <> '') and (AnsiCompareText(Value, srNone) <> 0) then
  2010.   begin
  2011.     NewValue := TextToShortCut(Value);
  2012.     if NewValue = 0 then
  2013.       raise EPropertyError.Create(SInvalidPropertyValue);
  2014.   end;
  2015.   SetOrdValue(NewValue);
  2016. end;
  2017.  
  2018. { TTabOrderProperty }
  2019.  
  2020. function TTabOrderProperty.GetAttributes: TPropertyAttributes;
  2021. begin
  2022.   Result := [];
  2023. end;
  2024.  
  2025. { TCaptionProperty }
  2026.  
  2027. function TCaptionProperty.GetAttributes: TPropertyAttributes;
  2028. begin
  2029.   Result := [paMultiSelect, paAutoUpdate, paRevertable];
  2030. end;
  2031.  
  2032. { TDateProperty }
  2033.  
  2034. function TDateProperty.GetAttributes: TPropertyAttributes;
  2035. begin
  2036.   Result := [paMultiSelect, paRevertable];
  2037. end;
  2038.  
  2039. function TDateProperty.GetValue: string;
  2040. var
  2041.   DT: TDateTime;
  2042. begin
  2043.   DT := GetFloatValue;
  2044.   if DT = 0.0 then Result := '' else
  2045.   Result := DateToStr(DT);
  2046. end;
  2047.  
  2048. procedure TDateProperty.SetValue(const Value: string);
  2049. var
  2050.   DT: TDateTime;
  2051. begin
  2052.   if Value = '' then DT := 0.0
  2053.   else DT := StrToDate(Value);
  2054.   SetFloatValue(DT);
  2055. end;
  2056.  
  2057. { TTimeProperty }
  2058.  
  2059. function TTimeProperty.GetAttributes: TPropertyAttributes;
  2060. begin
  2061.   Result := [paMultiSelect, paRevertable];
  2062. end;
  2063.  
  2064. function TTimeProperty.GetValue: string;
  2065. var
  2066.   DT: TDateTime;
  2067. begin
  2068.   DT := GetFloatValue;
  2069.   if DT = 0.0 then Result := '' else
  2070.   Result := TimeToStr(DT);
  2071. end;
  2072.  
  2073. procedure TTimeProperty.SetValue(const Value: string);
  2074. var
  2075.   DT: TDateTime;
  2076. begin
  2077.   if Value = '' then DT := 0.0
  2078.   else DT := StrToTime(Value);
  2079.   SetFloatValue(DT);
  2080. end;
  2081.  
  2082. function TDateTimeProperty.GetAttributes: TPropertyAttributes;
  2083. begin
  2084.   Result := [paMultiSelect, paRevertable];
  2085. end;
  2086.  
  2087. function TDateTimeProperty.GetValue: string;
  2088. var
  2089.   DT: TDateTime;
  2090. begin
  2091.   DT := GetFloatValue;
  2092.   if DT = 0.0 then Result := '' else
  2093.   Result := DateTimeToStr(DT);
  2094. end;
  2095.  
  2096. procedure TDateTimeProperty.SetValue(const Value: string);
  2097. var
  2098.   DT: TDateTime;
  2099. begin
  2100.   if Value = '' then DT := 0.0
  2101.   else DT := StrToDateTime(Value);
  2102.   SetFloatValue(DT);
  2103. end;
  2104.  
  2105. { TPropInfoList }
  2106.  
  2107. type
  2108.   TPropInfoList = class
  2109.   private
  2110.     FList: PPropList;
  2111.     FCount: Integer;
  2112.     FSize: Integer;
  2113.     function Get(Index: Integer): PPropInfo;
  2114.   public
  2115.     constructor Create(Instance: TPersistent; Filter: TTypeKinds);
  2116.     destructor Destroy; override;
  2117.     function Contains(P: PPropInfo): Boolean;
  2118.     procedure Delete(Index: Integer);
  2119.     procedure Intersect(List: TPropInfoList);
  2120.     property Count: Integer read FCount;
  2121.     property Items[Index: Integer]: PPropInfo read Get; default;
  2122.   end;
  2123.  
  2124. constructor TPropInfoList.Create(Instance: TPersistent; Filter: TTypeKinds);
  2125. begin
  2126.   FCount := GetPropList(Instance.ClassInfo, Filter, nil);
  2127.   FSize := FCount * SizeOf(Pointer);
  2128.   GetMem(FList, FSize);
  2129.   GetPropList(Instance.ClassInfo, Filter, FList);
  2130. end;
  2131.  
  2132. destructor TPropInfoList.Destroy;
  2133. begin
  2134.   if FList <> nil then FreeMem(FList, FSize);
  2135. end;
  2136.  
  2137. function TPropInfoList.Contains(P: PPropInfo): Boolean;
  2138. var
  2139.   I: Integer;
  2140. begin
  2141.   for I := 0 to FCount - 1 do
  2142.     with FList^[I]^ do
  2143.       if (PropType^ = P^.PropType^) and (CompareText(Name, P^.Name) = 0) then
  2144.       begin
  2145.         Result := True;
  2146.         Exit;
  2147.       end;
  2148.   Result := False;
  2149. end;
  2150.  
  2151. procedure TPropInfoList.Delete(Index: Integer);
  2152. begin
  2153.   Dec(FCount);
  2154.   if Index < FCount then
  2155.     Move(FList^[Index + 1], FList^[Index],
  2156.       (FCount - Index) * SizeOf(Pointer));
  2157. end;
  2158.  
  2159. function TPropInfoList.Get(Index: Integer): PPropInfo;
  2160. begin
  2161.   Result := FList^[Index];
  2162. end;
  2163.  
  2164. procedure TPropInfoList.Intersect(List: TPropInfoList);
  2165. var
  2166.   I: Integer;
  2167. begin
  2168.   for I := FCount - 1 downto 0 do
  2169.     if not List.Contains(FList^[I]) then Delete(I);
  2170. end;
  2171.  
  2172. { GetComponentProperties }
  2173.  
  2174. procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  2175.   const PropertyName: string; EditorClass: TPropertyEditorClass);
  2176. var
  2177.   P: PPropertyClassRec;
  2178. begin
  2179.   if PropertyClassList = nil then
  2180.     PropertyClassList := TList.Create;
  2181.   New(P);
  2182.   P.Group := CurrentGroup;
  2183.   P.PropertyType := PropertyType;
  2184.   P.ComponentClass := ComponentClass;
  2185.   P.PropertyName := '';
  2186.   if Assigned(ComponentClass) then P^.PropertyName := PropertyName;
  2187.   P.EditorClass := EditorClass;
  2188.   PropertyClassList.Insert(0, P);
  2189. end;
  2190.  
  2191. procedure RegisterPropertyMapper(Mapper: TPropertyMapperFunc);
  2192. var
  2193.   P: PPropertyMapperRec;
  2194. begin
  2195.   if PropertyMapperList = nil then
  2196.     PropertyMapperList := TList.Create;
  2197.   New(P);
  2198.   P^.Group := CurrentGroup;
  2199.   P^.Mapper := Mapper;
  2200.   PropertyMapperList.Insert(0, P);
  2201. end;
  2202.  
  2203. function GetEditorClass(PropInfo: PPropInfo;
  2204.   Obj: TPersistent): TPropertyEditorClass;
  2205. var
  2206.   PropType: PTypeInfo;
  2207.   P, C: PPropertyClassRec;
  2208.   I: Integer;
  2209. begin
  2210.   if PropertyMapperList <> nil then
  2211.   begin
  2212.     for I := 0 to PropertyMapperList.Count -1 do
  2213.       with PPropertyMapperRec(PropertyMapperList[I])^ do
  2214.       begin
  2215.         Result := Mapper(Obj, PropInfo);
  2216.         if Result <> nil then Exit;
  2217.       end;
  2218.   end;
  2219.   PropType := PropInfo^.PropType^;
  2220.   I := 0;
  2221.   C := nil;
  2222.   while I < PropertyClassList.Count do
  2223.   begin
  2224.     P := PropertyClassList[I];
  2225.     if ((P^.PropertyType = PropType) or ((PropType^.Kind = tkClass) and
  2226.       (P^.PropertyType^.Kind = tkClass) and
  2227.       GetTypeData(PropType)^.ClassType.InheritsFrom(GetTypeData(P^.PropertyType)^.ClassType))) and
  2228.       ((P^.ComponentClass = nil) or (Obj.InheritsFrom(P^.ComponentClass))) and
  2229.       ((P^.PropertyName = '') or (CompareText(PropInfo^.Name, P^.PropertyName) = 0)) then
  2230.       if (C = nil) or ((C^.ComponentClass = nil) and (P^.ComponentClass <> nil))
  2231.         or ((C^.PropertyName = '') and (P^.PropertyName <> '')) then C := P;
  2232.     Inc(I);
  2233.   end;
  2234.   if C <> nil then
  2235.     Result := C^.EditorClass else
  2236.     Result := PropClassMap[PropType^.Kind];
  2237. end;
  2238.  
  2239. procedure GetComponentProperties(Components: TComponentList;
  2240.   Filter: TTypeKinds; Designer: TFormDesigner; Proc: TGetPropEditProc);
  2241. var
  2242.   I, J, CompCount: Integer;
  2243.   CompType: TClass;
  2244.   Candidates: TPropInfoList;
  2245.   PropLists: TList;
  2246.   Editor: TPropertyEditor;
  2247.   EdClass: TPropertyEditorClass;
  2248.   PropInfo: PPropInfo;
  2249.   AddEditor: Boolean;
  2250.   Obj: TPersistent;
  2251. begin
  2252.   if (Components = nil) or (Components.Count = 0) then Exit;
  2253.   CompCount := Components.Count;
  2254.   Obj := Components[0];
  2255.   CompType := Components[0].ClassType;
  2256.   Candidates := TPropInfoList.Create(Components[0], Filter);
  2257.   try
  2258.     for I := Candidates.Count - 1 downto 0 do
  2259.     begin
  2260.       PropInfo := Candidates[I];
  2261.       EdClass := GetEditorClass(PropInfo, Obj);
  2262.       if EdClass = nil then
  2263.         Candidates.Delete(I)
  2264.       else
  2265.       begin
  2266.         Editor := EdClass.Create(Designer, 1);
  2267.         try
  2268.           Editor.SetPropEntry(0, Components[0], PropInfo);
  2269.           Editor.Initialize;
  2270.           with PropInfo^ do
  2271.             if (GetProc = nil) or ((PropType^.Kind <> tkClass) and
  2272.               (SetProc = nil)) or ((CompCount > 1) and
  2273.               not (paMultiSelect in Editor.GetAttributes)) or
  2274.               not Editor.ValueAvailable then
  2275.               Candidates.Delete(I);
  2276.         finally
  2277.           Editor.Free;
  2278.         end;
  2279.       end;
  2280.     end;
  2281.     PropLists := TList.Create;
  2282.     try
  2283.       PropLists.Capacity := CompCount;
  2284.       for I := 0 to CompCount - 1 do
  2285.         PropLists.Add(TPropInfoList.Create(Components[I], Filter));
  2286.       for I := 0 to CompCount - 1 do
  2287.         Candidates.Intersect(TPropInfoList(PropLists[I]));
  2288.       for I := 0 to CompCount - 1 do
  2289.         TPropInfoList(PropLists[I]).Intersect(Candidates);
  2290.       for I := 0 to Candidates.Count - 1 do
  2291.       begin
  2292.         EdClass := GetEditorClass(Candidates[I], Obj);
  2293.         if EdClass = nil then Continue;
  2294.         Editor := EdClass.Create(Designer, CompCount);
  2295.         try
  2296.           AddEditor := True;
  2297.           for J := 0 to CompCount - 1 do
  2298.           begin
  2299.             if (Components[J].ClassType <> CompType) and
  2300.               (GetEditorClass(TPropInfoList(PropLists[J])[I],
  2301.                 Components[J]) <> Editor.ClassType) then
  2302.             begin
  2303.               AddEditor := False;
  2304.               Break;
  2305.             end;
  2306.             Editor.SetPropEntry(J, Components[J],
  2307.               TPropInfoList(PropLists[J])[I]);
  2308.           end;
  2309.         except
  2310.           Editor.Free;
  2311.           raise;
  2312.         end;
  2313.         if AddEditor then
  2314.         begin
  2315.           Editor.Initialize;
  2316.           if Editor.ValueAvailable then
  2317.             Proc(Editor) else
  2318.             Editor.Free;
  2319.         end
  2320.         else Editor.Free;
  2321.       end;
  2322.     finally
  2323.       for I := 0 to PropLists.Count - 1 do TPropInfoList(PropLists[I]).Free;
  2324.       PropLists.Free;
  2325.     end;
  2326.   finally
  2327.     Candidates.Free;
  2328.   end;
  2329. end;
  2330.  
  2331. { RegisterComponentEditor }
  2332.  
  2333. type
  2334.   PComponentClassRec = ^TComponentClassRec;
  2335.   TComponentClassRec = record
  2336.     Group: Integer;
  2337.     ComponentClass: TComponentClass;
  2338.     EditorClass: TComponentEditorClass;
  2339.   end;
  2340.  
  2341. var
  2342.   ComponentClassList: TList = nil;
  2343.  
  2344. procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  2345.   ComponentEditor: TComponentEditorClass);
  2346. var
  2347.   P: PComponentClassRec;
  2348. begin
  2349.   if ComponentClassList = nil then
  2350.     ComponentClassList := TList.Create;
  2351.   New(P);
  2352.   P.Group := CurrentGroup;
  2353.   P.ComponentClass := ComponentClass;
  2354.   P.EditorClass := ComponentEditor;
  2355.   ComponentClassList.Insert(0, P);
  2356. end;
  2357.  
  2358. { GetComponentEditor }
  2359.  
  2360. function GetComponentEditor(Component: TComponent;
  2361.   Designer: TFormDesigner): TComponentEditor;
  2362. var
  2363.   P: PComponentClassRec;
  2364.   I: Integer;
  2365.   ComponentClass: TComponentClass;
  2366.   EditorClass: TComponentEditorClass;
  2367. begin
  2368.   ComponentClass := TComponentClass(TPersistent);
  2369.   EditorClass := TDefaultEditor;
  2370.   for I := 0 to ComponentClassList.Count-1 do
  2371.   begin
  2372.     P := ComponentClassList[I];
  2373.     if (Component is P^.ComponentClass) and
  2374.       (P^.ComponentClass <> ComponentClass) and
  2375.       (P^.ComponentClass.InheritsFrom(ComponentClass)) then
  2376.     begin
  2377.       EditorClass := P^.EditorClass;
  2378.       ComponentClass := P^.ComponentClass;
  2379.     end;
  2380.   end;
  2381.   Result := EditorClass.Create(Component, Designer);
  2382. end;
  2383.  
  2384. function NewEditorGroup: Integer;
  2385. begin
  2386.   if EditorGroupList = nil then
  2387.     EditorGroupList := TBits.Create;
  2388.   CurrentGroup := EditorGroupList.OpenBit;
  2389.   EditorGroupList[CurrentGroup] := True;
  2390.   Result := CurrentGroup;
  2391. end;
  2392.  
  2393. procedure FreeEditorGroup(Group: Integer);
  2394. var
  2395.   I: Integer;
  2396.   P: PPropertyClassRec;
  2397.   C: PComponentClassRec;
  2398.   M: PPropertyMapperRec;
  2399. begin
  2400.   I := PropertyClassList.Count - 1;
  2401.   while I > -1 do
  2402.   begin
  2403.     P := PropertyClassList[I];
  2404.     if P.Group = Group then
  2405.     begin
  2406.       PropertyClassList.Delete(I);
  2407.       Dispose(P);
  2408.     end;
  2409.     Dec(I);
  2410.   end;
  2411.   I := ComponentClassList.Count - 1;
  2412.   while I > -1 do
  2413.   begin
  2414.     C := ComponentClassList[I];
  2415.     if C.Group = Group then
  2416.     begin
  2417.       ComponentClassList.Delete(I);
  2418.       Dispose(C);
  2419.     end;
  2420.     Dec(I);
  2421.   end;
  2422.   if PropertyMapperList <> nil then
  2423.     for I := PropertyMapperList.Count-1 downto 0 do
  2424.     begin
  2425.       M := PropertyMapperList[I];
  2426.       if M.Group = Group then
  2427.       begin
  2428.         PropertyMapperList.Delete(I);
  2429.         Dispose(M);
  2430.       end;
  2431.     end;
  2432.   if Assigned(FreeCustomModulesProc) then FreeCustomModulesProc(Group);
  2433.   if (Group >= 0) and (Group < EditorGroupList.Size) then
  2434.     EditorGroupList[Group] := False;
  2435. end;
  2436.  
  2437. { TComponentEditor }
  2438.  
  2439. constructor TComponentEditor.Create(AComponent: TComponent; ADesigner: TFormDesigner);
  2440. begin
  2441.   inherited Create;
  2442.   FComponent := AComponent;
  2443.   FDesigner := ADesigner;
  2444. end;
  2445.  
  2446. procedure TComponentEditor.Edit;
  2447. begin
  2448.   if GetVerbCount > 0 then ExecuteVerb(0);
  2449. end;
  2450.  
  2451. function TComponentEditor.GetVerbCount: Integer;
  2452. begin
  2453.   Result := 0;
  2454. end;
  2455.  
  2456. function TComponentEditor.GetVerb(Index: Integer): string;
  2457. begin
  2458. end;
  2459.  
  2460. procedure TComponentEditor.ExecuteVerb(Index: Integer);
  2461. begin
  2462. end;
  2463.  
  2464. procedure TComponentEditor.Copy;
  2465. begin
  2466. end;
  2467.  
  2468. { TDefaultEditor }
  2469.  
  2470. procedure TDefaultEditor.CheckEdit(PropertyEditor: TPropertyEditor);
  2471. var
  2472.   FreeEditor: Boolean;
  2473. begin
  2474.   FreeEditor := True;
  2475.   try
  2476.     if FContinue then EditProperty(PropertyEditor, FContinue, FreeEditor);
  2477.   finally
  2478.     if FreeEditor then PropertyEditor.Free;
  2479.   end;
  2480. end;
  2481.  
  2482. procedure TDefaultEditor.EditProperty(PropertyEditor: TPropertyEditor;
  2483.   var Continue, FreeEditor: Boolean);
  2484. var
  2485.   PropName: string;
  2486.   BestName: string;
  2487.  
  2488.   procedure ReplaceBest;
  2489.   begin
  2490.     FBest.Free;
  2491.     FBest := PropertyEditor;
  2492.     if FFirst = FBest then FFirst := nil;
  2493.     FreeEditor := False;
  2494.   end;
  2495.  
  2496. begin
  2497.   if not Assigned(FFirst) and (PropertyEditor is TMethodProperty) then
  2498.   begin
  2499.     FreeEditor := False;
  2500.     FFirst := PropertyEditor;
  2501.   end;
  2502.   PropName := PropertyEditor.GetName;
  2503.   BestName := '';
  2504.   if Assigned(FBest) then BestName := FBest.GetName;
  2505.   if CompareText(PropName, 'ONCREATE') = 0 then
  2506.     ReplaceBest
  2507.   else if CompareText(BestName, 'ONCREATE') <> 0 then
  2508.     if CompareText(PropName, 'ONCHANGE') = 0 then
  2509.       ReplaceBest
  2510.     else if CompareText(BestName, 'ONCHANGE') <> 0 then
  2511.       if CompareText(PropName, 'ONCLICK') = 0 then
  2512.         ReplaceBest;
  2513. end;
  2514.  
  2515. procedure TDefaultEditor.Edit;
  2516. var
  2517.   Components: TComponentList;
  2518. begin
  2519.   Components := TComponentList.Create;
  2520.   try
  2521.     FContinue := True;
  2522.     Components.Add(Component);
  2523.     FFirst := nil;
  2524.     FBest := nil;
  2525.     try
  2526.       GetComponentProperties(Components, tkAny, Designer, CheckEdit);
  2527.       if FContinue then
  2528.         if Assigned(FBest) then
  2529.           FBest.Edit
  2530.         else if Assigned(FFirst) then
  2531.           FFirst.Edit;
  2532.     finally
  2533.       FFirst.Free;
  2534.       FBest.Free;
  2535.     end;
  2536.   finally
  2537.     Components.Free;
  2538.   end;
  2539. end;
  2540.  
  2541. { TCustomModule }
  2542.  
  2543. constructor TCustomModule.Create(ARoot: TComponent);
  2544. begin
  2545.   inherited Create;
  2546.   FRoot := ARoot;
  2547. end;
  2548.  
  2549. procedure TCustomModule.ExecuteVerb(Index: Integer);
  2550. begin
  2551. end;
  2552.  
  2553. function TCustomModule.GetAttributes: TCustomModuleAttributes;
  2554. begin
  2555.   Result := [];
  2556. end;
  2557.  
  2558. function TCustomModule.GetVerb(Index: Integer): string;
  2559. begin
  2560.   Result := '';
  2561. end;
  2562.  
  2563. function TCustomModule.GetVerbCount: Integer;
  2564. begin
  2565.   Result := 0;
  2566. end;
  2567.  
  2568. procedure TCustomModule.Saving;
  2569. begin
  2570. end;
  2571.  
  2572. procedure TCustomModule.ValidateComponent(Component: TComponent);
  2573. begin
  2574. end;
  2575.  
  2576. procedure RegisterCustomModule(ComponentBaseClass: TComponentClass;
  2577.   CustomModuleClass: TCustomModuleClass);
  2578. begin
  2579.   if Assigned(RegisterCustomModuleProc) then
  2580.     RegisterCustomModuleProc(CurrentGroup, ComponentBaseClass,
  2581.       CustomModuleClass);
  2582. end;
  2583.  
  2584. initialization
  2585.  
  2586. finalization
  2587.   EditorGroupList.Free;
  2588.   PropertyClassList.Free;
  2589.   ComponentClassList.Free;
  2590.   PropertyMapperList.Free;
  2591.  
  2592. end.
  2593.