home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d56 / MSYSINFO.ZIP / Borland / Delphi5 / DSGNINTF.PAS next >
Pascal/Delphi Source File  |  1999-08-11  |  138KB  |  4,487 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,99 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DsgnIntf;
  11.  
  12. interface
  13.  
  14. {$N+,S-,R-}
  15.  
  16. uses
  17.   Windows, Activex, SysUtils, Classes, Graphics, Controls, Forms, Contnrs, IniFiles,
  18.   TypInfo, Masks, Menus;
  19.  
  20. type
  21.  
  22.   TEditAction = (eaUndo, eaRedo, eaCut, eaCopy, eaPaste, eaDelete, eaSelectAll,
  23.     eaPrint, eaBringToFront, eaSendToBack, eaAlignToGrid, eaFlipChildrenAll,
  24.     eaFlipChildrenSelected);
  25.  
  26.   TEditState = set of (esCanUndo, esCanRedo, esCanCut, esCanCopy, esCanPaste,
  27.     esCanDelete, esCanZOrder, esCanAlignGrid, esCanEditOle, esCanTabOrder,
  28.     esCanCreationOrder, esCanPrint, esCanSelectAll);
  29.  
  30.   IEventInfos = interface
  31.     ['{11667FF0-7590-11D1-9FBC-0020AF3D82DA}']
  32.     function GetCount: Integer;
  33.     function GetEventValue(Index: Integer): string;
  34.     function GetEventName(Index: Integer): string;
  35.     procedure ClearEvent(Index: Integer);
  36.     property Count: Integer read GetCount;
  37.   end;
  38.  
  39.   IPersistent = interface
  40.     ['{82330133-65D1-11D1-9FBB-0020AF3D82DA}'] {Java}
  41.     procedure DestroyObject;
  42.     function Equals(const Other: IPersistent): Boolean;
  43.     function GetClassname: string;
  44.     function GetEventInfos: IEventInfos;
  45.     function GetNamePath: string;
  46.     function GetOwner: IPersistent;
  47.     function InheritsFrom(const Classname: string): Boolean;
  48.     function IsComponent: Boolean;  // object is stream createable
  49.     function IsControl: Boolean;
  50.     function IsWinControl: Boolean;
  51.     property Classname: string read GetClassname;
  52.     property Owner: IPersistent read GetOwner;
  53.     property NamePath: string read GetNamePath;
  54. //    property PersistentProps[Index: Integer]: IPersistent
  55. //    property PersistentPropCount: Integer;
  56.     property EventInfos: IEventInfos read GetEventInfos;
  57.   end;
  58.  
  59.   IComponent = interface(IPersistent)
  60.     ['{B2F6D681-5098-11D1-9FB5-0020AF3D82DA}'] {Java}
  61.     function FindComponent(const Name: string): IComponent;
  62.     function GetComponentCount: Integer;
  63.     function GetComponents(Index: Integer): IComponent;
  64.     function GetComponentState: TComponentState;
  65.     function GetComponentStyle: TComponentStyle;
  66.     function GetDesignInfo: TSmallPoint;
  67.     function GetDesignOffset: TPoint;
  68.     function GetDesignSize: TPoint;
  69.     function GetName: string;
  70.     function GetOwner: IComponent;
  71.     function GetParent: IComponent;
  72.     procedure SetDesignInfo(const Point: TSmallPoint);
  73.     procedure SetDesignOffset(const Point: TPoint);
  74.     procedure SetDesignSize(const Point: TPoint);
  75.     procedure SetName(const Value: string);
  76.     property ComponentCount: Integer read GetComponentCount;
  77.     property Components[Index: Integer]: IComponent read GetComponents;
  78.     property ComponentState: TComponentState read GetComponentState;
  79.     property ComponentStyle: TComponentStyle read GetComponentStyle;
  80.     property DesignInfo: TSmallPoint read GetDesignInfo write SetDesignInfo;
  81.     property DesignOffset: TPoint read GetDesignOffset write SetDesignOffset;
  82.     property DesignSize: TPoint read GetDesignSize write SetDesignSize;
  83.     property Name: string read GetName write SetName;
  84.     property Owner: IComponent read GetOwner;
  85.     property Parent: IComponent read GetParent;
  86.   end;
  87.  
  88.   IImplementation = interface
  89.     ['{F9D448F2-50BC-11D1-9FB5-0020AF3D82DA}']
  90.     function GetInstance: TObject;
  91.   end;
  92.  
  93.   function MakeIPersistent(Instance: TPersistent): IPersistent;
  94.   function ExtractPersistent(const Intf: IUnknown): TPersistent;
  95.   function TryExtractPersistent(const Intf: IUnknown): TPersistent;
  96.  
  97.   function MakeIComponent(Instance: TComponent): IComponent;
  98.   function ExtractComponent(const Intf: IUnknown): TComponent;
  99.   function TryExtractComponent(const Intf: IUnknown): TComponent;
  100.  
  101. var
  102.   MakeIPersistentProc: function (Instance: TPersistent): IPersistent = nil;
  103.   MakeIComponentProc: function (Instance: TComponent): IComponent = nil;
  104.  
  105. type
  106.  
  107. { IDesignerSelections  }
  108. {   Used to transport the selected objects list in and out of the form designer.
  109.     Replaces TDesignerSelectionList in form designer interface.  }
  110.  
  111.   IDesignerSelections = interface
  112.     ['{82330134-65D1-11D1-9FBB-0020AF3D82DA}'] {Java}
  113.     function Add(const Item: IPersistent): Integer;
  114.     function Equals(const List: IDesignerSelections): Boolean;
  115.     function Get(Index: Integer): IPersistent;
  116.     function GetCount: Integer;
  117.     property Count: Integer read GetCount;
  118.     property Items[Index: Integer]: IPersistent read Get; default;
  119.   end;
  120.  
  121. function CreateSelectionList: IDesignerSelections;
  122.  
  123. type
  124.  
  125.   TDesignerSelectionList = class;
  126.  
  127.   IComponentList = interface
  128.     ['{8ED8AD16-A241-11D1-AA94-00C04FB17A72}']
  129.     function GetComponentList: TDesignerSelectionList;
  130.   end;
  131.  
  132. { TDesignerSelectionList }
  133. {   Used to transport VCL component selections between property editors }
  134.  
  135.   TDesignerSelectionList = class(TInterfacedObject, IDesignerSelections,
  136.     IComponentList)
  137.   private
  138.     FList: TList;
  139.     { IDesignSelections }
  140.     function IDesignerSelections.Add = Intf_Add;
  141.     function Intf_Add(const Item: IPersistent): Integer;
  142.     function IDesignerSelections.Equals = Intf_Equals;
  143.     function Intf_Equals(const List: IDesignerSelections): Boolean;
  144.     function IDesignerSelections.Get = Intf_Get;
  145.     function Intf_Get(Index: Integer): IPersistent;
  146.     function Get(Index: Integer): TPersistent;
  147.     function GetCount: Integer;
  148.     { IComponentList }
  149.     function GetComponentList: TDesignerSelectionList;
  150.   public
  151.     constructor Create;
  152.     destructor Destroy; override;
  153.     function Add(Item: TPersistent): Integer;
  154.     function Equals(List: TDesignerSelectionList): Boolean;
  155.     property Count: Integer read GetCount;
  156.     property Items[Index: Integer]: TPersistent read Get; default;
  157.   end;
  158.  
  159. { IFormDesigner
  160.     BuildLocalMenu - Constructs and returns the popup menu for the currently
  161.     selected component(s).  Base is the popup menu that will receive additional
  162.     menu items.  If Base is nil, a default popup menu is constructed containing
  163.     the default designer menu items, like "Align to Grid".  The menu object
  164.     returned by this function is owned by the designer and will be destroyed
  165.     the next time BuildLocalMenu is called (the next time a Popup menu is
  166.     invoked on the designer).  If you pass in a Base menu, you don't own it
  167.     anymore.  It will be destroyed later.
  168. }
  169. type
  170.   TLocalMenuFilter = (lmModule, lmComponent, lmDesigner);
  171.   TLocalMenuFilters = set of TLocalMenuFilter;
  172.  
  173. const
  174.   cNoLocalMenus = [lmModule, lmComponent, lmDesigner];
  175.   cAllLocalMenus = [];
  176.   cLocalMenusIf: array [boolean] of TLocalMenuFilters =
  177.     (cNoLocalMenus, cAllLocalMenus);
  178.  
  179. type
  180.   IFormDesigner = interface(IDesigner)
  181.     ['{ADDD444D-1B03-11D3-A8F8-00C04FA32F53}']
  182.     function CreateMethod(const Name: string; TypeData: PTypeData): TMethod;
  183.     function GetMethodName(const Method: TMethod): string;
  184.     procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc);
  185.     function GetPrivateDirectory: string;
  186.     procedure GetSelections(const List: IDesignerSelections);
  187.     function MethodExists(const Name: string): Boolean;
  188.     procedure RenameMethod(const CurName, NewName: string);
  189.     procedure SelectComponent(Instance: TPersistent);
  190.     procedure SetSelections(const List: IDesignerSelections);
  191.     procedure ShowMethod(const Name: string);
  192.     procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc);
  193.     function GetComponent(const Name: string): TComponent;
  194.     function GetComponentName(Component: TComponent): string;
  195.     function GetObject(const Name: string): TPersistent;
  196.     function GetObjectName(Instance: TPersistent): string;
  197.     procedure GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc);
  198.     function MethodFromAncestor(const Method: TMethod): Boolean;
  199.     function CreateComponent(ComponentClass: TComponentClass; Parent: TComponent;
  200.       Left, Top, Width, Height: Integer): TComponent;
  201.     function IsComponentLinkable(Component: TComponent): Boolean;
  202.     procedure MakeComponentLinkable(Component: TComponent);
  203.     procedure Revert(Instance: TPersistent; PropInfo: PPropInfo);
  204.     function GetIsDormant: Boolean;
  205.     function HasInterface: Boolean;
  206.     function HasInterfaceMember(const Name: string): Boolean;
  207.     procedure AddToInterface(InvKind: Integer; const Name: string; VT: Word;
  208.       const TypeInfo: string);
  209.     procedure GetProjectModules(Proc: TGetModuleProc);
  210.     function GetAncestorDesigner: IFormDesigner;
  211.     function IsSourceReadOnly: Boolean;
  212.     function GetContainerWindow: TWinControl;
  213.     procedure SetContainerWindow(const NewContainer: TWinControl);
  214.     function GetScrollRanges(const ScrollPosition: TPoint): TPoint;
  215.     procedure Edit(const Component: IComponent);
  216.     function BuildLocalMenu(Base: TPopupMenu; Filter: TLocalMenuFilters): TPopupMenu;
  217.     procedure ChainCall(const MethodName, InstanceName, InstanceMethod: string;
  218.       TypeData: PTypeData);
  219.     procedure CopySelection;
  220.     procedure CutSelection;
  221.     function CanPaste: Boolean;
  222.     procedure PasteSelection;
  223.     procedure DeleteSelection;
  224.     procedure ClearSelection;
  225.     procedure NoSelection;
  226.     procedure ModuleFileNames(var ImplFileName, IntfFileName, FormFileName: string);
  227.     function GetRootClassName: string;
  228.     property IsDormant: Boolean read GetIsDormant;
  229.     property AncestorDesigner: IFormDesigner read GetAncestorDesigner;
  230.     property ContainerWindow: TWinControl read GetContainerWindow write SetContainerWindow;
  231.   end;
  232.  
  233.   IDesignNotification = interface
  234.     ['{3250122F-D336-11D2-B725-00C04FA35D12}']
  235.     procedure ItemDeleted(const AItem: IPersistent);
  236.     procedure ItemInserted(const AItem: IPersistent);
  237.     procedure ItemsModified(const ADesigner: IUnknown);
  238.     procedure SelectionChanged(const ASelection: IDesignerSelections);
  239.     procedure DesignerInitialized(const ADesigner: IUnknown);
  240.     procedure DesignerClosed(const ADesigner: IUnknown);
  241.   end;
  242.  
  243. { IDesignerPopulateMenu
  244.     Allows a design surface an opportunity to add context-sensitive menu items
  245.     to the designer's popup menu.  This is in addition to the component editor
  246.     verbs and the custom module verbs. }
  247.  
  248.   IDesignerPopulateMenu = interface
  249.     ['{66C7D913-EC70-11D2-AAD1-00C04FB16FBC}']
  250.     procedure PopulateMenu(const APopupMenu: TPopupMenu);
  251.   end;
  252.  
  253. { TPropertyEditor
  254.   Edits a property of a component, or list of components, selected into the
  255.   Object Inspector.  The property editor is created based on the type of the
  256.   property being edited as determined by the types registered by
  257.   RegisterPropertyEditor.  The Object Inspector uses a TPropertyEditor
  258.   for all modification to a property. GetName and GetValue are called to display
  259.   the name and value of the property.  SetValue is called whenever the user
  260.   requests to change the value.  Edit is called when the user double-clicks the
  261.   property in the Object Inspector. GetValues is called when the drop-down
  262.   list of a property is displayed.  GetProperties is called when the property
  263.   is expanded to show sub-properties.  AllEqual is called to decide whether or
  264.   not to display the value of the property when more than one component is
  265.   selected.
  266.  
  267.   The following are methods that can be overridden to change the behavior of
  268.   the property editor:
  269.  
  270.     Activate
  271.       Called whenever the property becomes selected in the object inspector.
  272.       This is potentially useful to allow certain property attributes to
  273.       to only be determined whenever the property is selected in the object
  274.       inspector. Only paSubProperties and paMultiSelect, returned from
  275.       GetAttributes, need to be accurate before this method is called.
  276.     AllEqual
  277.       Called whenever there is more than one component selected.  If this
  278.       method returns true, GetValue is called, otherwise blank is displayed
  279.       in the Object Inspector.  This is called only when GetAttributes
  280.       returns paMultiSelect.
  281.     AutoFill
  282.       Called to determine whether the values returned by GetValues can be
  283.       selected incrementally in the Object Inspector.  This is called only when
  284.       GetAttributes returns paValueList.
  285.     Edit
  286.       Called when the '...' button is pressed or the property is double-clicked.
  287.       This can, for example, bring up a dialog to allow the editing the
  288.       component in some more meaningful fashion than by text (e.g. the Font
  289.       property).
  290.     GetAttributes
  291.       Returns the information for use in the Object Inspector to be able to
  292.       show the appropriate tools.  GetAttributes returns a set of type
  293.       TPropertyAttributes:
  294.         paValueList:     The property editor can return an enumerated list of
  295.                          values for the property.  If GetValues calls Proc
  296.                          with values then this attribute should be set.  This
  297.                          will cause the drop-down button to appear to the right
  298.                          of the property in the Object Inspector.
  299.         paSortList:      Object Inspector to sort the list returned by
  300.                          GetValues.
  301.         paSubProperties: The property editor has sub-properties that will be
  302.                          displayed indented and below the current property in
  303.                          standard outline format. If GetProperties will
  304.                          generate property objects then this attribute should
  305.                          be set.
  306.         paDialog:        Indicates that the Edit method will bring up a
  307.                          dialog.  This will cause the '...' button to be
  308.                          displayed to the right of the property in the Object
  309.                          Inspector.
  310.         paMultiSelect:   Allows the property to be displayed when more than
  311.                          one component is selected.  Some properties are not
  312.                          appropriate for multi-selection (e.g. the Name
  313.                          property).
  314.         paAutoUpdate:    Causes the SetValue method to be called on each
  315.                          change made to the editor instead of after the change
  316.                          has been approved (e.g. the Caption property).
  317.         paReadOnly:      Value is not allowed to change.
  318.         paRevertable:    Allows the property to be reverted to the original
  319.                          value.  Things that shouldn't be reverted are nested
  320.                          properties (e.g. Fonts) and elements of a composite
  321.                          property such as set element values.
  322.         paFullWidthName: Tells the object inspector that the value does not
  323.                          need to be rendered and as such the name should be
  324.                          rendered the full width of the inspector.
  325.     GetComponent
  326.       Returns the Index'th component being edited by this property editor.  This
  327.       is used to retrieve the components.  A property editor can only refer to
  328.       multiple components when paMultiSelect is returned from GetAttributes.
  329.     GetEditLimit
  330.       Returns the number of character the user is allowed to enter for the
  331.       value.  The inplace editor of the object inspector will be have its
  332.       text limited set to the return value.  By default this limit is 255.
  333.     GetName
  334.       Returns the name of the property.  By default the value is retrieved
  335.       from the type information with all underbars replaced by spaces.  This
  336.       should only be overridden if the name of the property is not the name
  337.       that should appear in the Object Inspector.
  338.     GetProperties
  339.       Should be overridden to call PropertyProc for every sub-property (or
  340.       nested property) of the property begin edited and passing a new
  341.       TPropertyEdtior for each sub-property.  By default, PropertyProc is not
  342.       called and no sub-properties are assumed.  TClassProperty will pass a
  343.       new property editor for each published property in a class.  TSetProperty
  344.       passes a new editor for each element in the set.
  345.     GetPropType
  346.       Returns the type information pointer for the property(s) being edited.
  347.     GetValue
  348.       Returns the string value of the property. By default this returns
  349.       '(unknown)'.  This should be overridden to return the appropriate value.
  350.     GetValues
  351.       Called when paValueList is returned in GetAttributes.  Should call Proc
  352.       for every value that is acceptable for this property.  TEnumProperty
  353.       will pass every element in the enumeration.
  354.     Initialize
  355.       Called after the property editor has been created but before it is used.
  356.       Many times property editors are created and because they are not a common
  357.       property across the entire selection they are thrown away.  Initialize is
  358.       called after it is determined the property editor is going to be used by
  359.       the object inspector and not just thrown away.
  360.     SetValue(Value)
  361.       Called to set the value of the property.  The property editor should be
  362.       able to translate the string and call one of the SetXxxValue methods. If
  363.       the string is not in the correct format or not an allowed value, the
  364.       property editor should generate an exception describing the problem. Set
  365.       value can ignore all changes and allow all editing of the property be
  366.       accomplished through the Edit method (e.g. the Picture property).
  367.     ListMeasureWidth(Value, Canvas, AWidth)
  368.       This is called during the width calculation phase of the drop down list
  369.       preparation.
  370.     ListMeasureHeight(Value, Canvas, AHeight)
  371.       This is called during the item/value height calculation phase of the drop
  372.       down list's render.  This is very similar to TListBox's OnMeasureItem,
  373.       just slightly different parameters.
  374.     ListDrawValue(Value, Canvas, Rect, Selected)
  375.       This is called during the item/value render phase of the drop down list's
  376.       render.  This is very similar to TListBox's OnDrawItem, just slightly
  377.       different parameters.
  378.     PropDrawName(Canvas, Rect, Selected)
  379.       Called during the render of the name column of the property list.  Its
  380.       functionality is very similar to TListBox's OnDrawItem, but once again
  381.       it has slightly different parameters.
  382.     PropDrawValue(Canvas, Rect, Selected)
  383.       Called during the render of the value column of the property list.  Its
  384.       functionality is similar to PropDrawName.  If multiple items are selected
  385.       and their values don't match this procedure will be passed an empty
  386.       value.
  387.  
  388.   Properties and methods useful in creating a new TPropertyEditor classes:
  389.  
  390.     Name property
  391.       Returns the name of the property returned by GetName
  392.     PrivateDirectory property
  393.       It is either the .EXE or the "working directory" as specified in
  394.       the registry under the key:
  395.         "HKEY_CURRENT_USER\Software\Borland\Delphi\*\Globals\PrivateDir"
  396.       If the property editor needs auxiliary or state files (templates, examples,
  397.       etc) they should be stored in this directory.
  398.     Value property
  399.       The current value, as a string, of the property as returned by GetValue.
  400.     Modified
  401.       Called to indicate the value of the property has been modified.  Called
  402.       automatically by the SetXxxValue methods.  If you call a TProperty
  403.       SetXxxValue method directly, you *must* call Modified as well.
  404.     GetXxxValue
  405.       Gets the value of the first property in the Properties property.  Calls
  406.       the appropriate TProperty GetXxxValue method to retrieve the value.
  407.     SetXxxValue
  408.       Sets the value of all the properties in the Properties property.  Calls
  409.       the approprate TProperty SetXxxxValue methods to set the value.
  410.     GetVisualValue
  411.       This function will return the displayable value of the property.  If
  412.       only one item is selected or all the multi-selected items have the same
  413.       property value then this function will return the actual property value.
  414.       Otherwise this function will return an empty string.}
  415.  
  416.   TPropertyAttribute = (paValueList, paSubProperties, paDialog, paMultiSelect,
  417.     paAutoUpdate, paSortList, paReadOnly, paRevertable, paFullWidthName);
  418.   TPropertyAttributes = set of TPropertyAttribute;
  419.  
  420.   TPropertyEditor = class;
  421.  
  422.   TInstProp = record
  423.     Instance: TPersistent;
  424.     PropInfo: PPropInfo;
  425.   end;
  426.  
  427.   PInstPropList = ^TInstPropList;
  428.   TInstPropList = array[0..1023] of TInstProp;
  429.  
  430.   TGetPropEditProc = procedure(Prop: TPropertyEditor) of object;
  431.  
  432.   TPropertyEditor = class
  433.   private
  434.     FDesigner: IFormDesigner;
  435.     FPropList: PInstPropList;
  436.     FPropCount: Integer;
  437.     function GetPrivateDirectory: string;
  438.     procedure SetPropEntry(Index: Integer; AInstance: TPersistent;
  439.       APropInfo: PPropInfo);
  440.   protected
  441.     constructor Create(const ADesigner: IFormDesigner; APropCount: Integer); virtual;
  442.     function GetPropInfo: PPropInfo;
  443.     function GetFloatValue: Extended;
  444.     function GetFloatValueAt(Index: Integer): Extended;
  445.     function GetInt64Value: Int64;
  446.     function GetInt64ValueAt(Index: Integer): Int64;
  447.     function GetMethodValue: TMethod;
  448.     function GetMethodValueAt(Index: Integer): TMethod;
  449.     function GetOrdValue: Longint;
  450.     function GetOrdValueAt(Index: Integer): Longint;
  451.     function GetStrValue: string;
  452.     function GetStrValueAt(Index: Integer): string;
  453.     function GetVarValue: Variant;
  454.     function GetVarValueAt(Index: Integer): Variant;
  455.     procedure Modified; 
  456.     procedure SetFloatValue(Value: Extended);
  457.     procedure SetMethodValue(const Value: TMethod);
  458.     procedure SetInt64Value(Value: Int64);
  459.     procedure SetOrdValue(Value: Longint);
  460.     procedure SetStrValue(const Value: string);
  461.     procedure SetVarValue(const Value: Variant);
  462.   public
  463.     destructor Destroy; override;
  464.     procedure Activate; virtual;
  465.     function AllEqual: Boolean; virtual;
  466.     function AutoFill: Boolean; virtual;
  467.     procedure Edit; virtual;
  468.     function GetAttributes: TPropertyAttributes; virtual;
  469.     function GetComponent(Index: Integer): TPersistent;
  470.     function GetEditLimit: Integer; virtual;
  471.     function GetName: string; virtual;
  472.     procedure GetProperties(Proc: TGetPropEditProc); virtual;
  473.     function GetPropType: PTypeInfo;
  474.     function GetValue: string; virtual;
  475.     function GetVisualValue: string;
  476.     procedure GetValues(Proc: TGetStrProc); virtual;
  477.     procedure Initialize; virtual;
  478.     procedure Revert;
  479.     procedure SetValue(const Value: string); virtual;
  480.     function ValueAvailable: Boolean;
  481.     procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
  482.       var AWidth: Integer); dynamic;
  483.     procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;
  484.       var AHeight: Integer); dynamic;
  485.     procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
  486.       const ARect: TRect; ASelected: Boolean); dynamic;
  487.     procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect;
  488.       ASelected: Boolean); dynamic;
  489.     procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  490.       ASelected: Boolean); dynamic;
  491.     property Designer: IFormDesigner read FDesigner;
  492.     property PrivateDirectory: string read GetPrivateDirectory;
  493.     property PropCount: Integer read FPropCount;
  494.     property Value: string read GetValue write SetValue;
  495.   end;
  496.  
  497.   TPropertyEditorClass = class of TPropertyEditor;
  498.  
  499. { TOrdinalProperty
  500.   The base class of all ordinal property editors.  It established that ordinal
  501.   properties are all equal if the GetOrdValue all return the same value. }
  502.  
  503.   TOrdinalProperty = class(TPropertyEditor)
  504.     function AllEqual: Boolean; override;
  505.     function GetEditLimit: Integer; override;
  506.   end;
  507.  
  508. { TIntegerProperty
  509.   Default editor for all Longint properties and all subtypes of the Longint
  510.   type (i.e. Integer, Word, 1..10, etc.).  Restricts the value entered into
  511.   the property to the range of the sub-type. }
  512.  
  513.   TIntegerProperty = class(TOrdinalProperty)
  514.   public
  515.     function GetValue: string; override;
  516.     procedure SetValue(const Value: string); override;
  517.   end;
  518.  
  519. { TCharProperty
  520.   Default editor for all Char properties and sub-types of Char (i.e. Char,
  521.   'A'..'Z', etc.). }
  522.  
  523.   TCharProperty = class(TOrdinalProperty)
  524.   public
  525.     function GetValue: string; override;
  526.     procedure SetValue(const Value: string); override;
  527.   end;
  528.  
  529. { TEnumProperty
  530.   The default property editor for all enumerated properties (e.g. TShape =
  531.   (sCircle, sTriangle, sSquare), etc.). }
  532.  
  533.   TEnumProperty = class(TOrdinalProperty)
  534.   public
  535.     function GetAttributes: TPropertyAttributes; override;
  536.     function GetValue: string; override;
  537.     procedure GetValues(Proc: TGetStrProc); override;
  538.     procedure SetValue(const Value: string); override;
  539.   end;
  540.  
  541.   TBoolProperty = class(TEnumProperty)
  542.     function GetValue: string; override;
  543.     procedure GetValues(Proc: TGetStrProc); override;
  544.     procedure SetValue(const Value: string); override;
  545.   end;
  546.  
  547. { TInt64Property
  548.   Default editor for all Int64 properties and all subtypes of Int64.  }
  549.  
  550.   TInt64Property = class(TPropertyEditor)
  551.   public
  552.     function AllEqual: Boolean; override;
  553.     function GetEditLimit: Integer; override;
  554.     function GetValue: string; override;
  555.     procedure SetValue(const Value: string); override;
  556.   end;
  557.  
  558. { TFloatProperty
  559.   The default property editor for all floating point types (e.g. Float,
  560.   Single, Double, etc.) }
  561.  
  562.   TFloatProperty = class(TPropertyEditor)
  563.   public
  564.     function AllEqual: Boolean; override;
  565.     function GetValue: string; override;
  566.     procedure SetValue(const Value: string); override;
  567.   end;
  568.  
  569. { TStringProperty
  570.   The default property editor for all strings and sub types (e.g. string,
  571.   string[20], etc.). }
  572.  
  573.   TStringProperty = class(TPropertyEditor)
  574.   public
  575.     function AllEqual: Boolean; override;
  576.     function GetEditLimit: Integer; override;
  577.     function GetValue: string; override;
  578.     procedure SetValue(const Value: string); override;
  579.   end;
  580.  
  581. { TNestedProperty
  582.   A property editor that uses the parent's Designer, PropList and PropCount.
  583.   The constructor and destructor do not call inherited, but all derived classes
  584.   should.  This is useful for properties like the TSetElementProperty. }
  585.  
  586.   TNestedProperty = class(TPropertyEditor)
  587.   public
  588.     constructor Create(Parent: TPropertyEditor); reintroduce;
  589.     destructor Destroy; override;
  590.   end;
  591.  
  592. { TSetElementProperty
  593.   A property editor that edits an individual set element.  GetName is
  594.   changed to display the set element name instead of the property name and
  595.   Get/SetValue is changed to reflect the individual element state.  This
  596.   editor is created by the TSetProperty editor. }
  597.  
  598.   TSetElementProperty = class(TNestedProperty)
  599.   private
  600.     FElement: Integer;
  601.   protected
  602.     constructor Create(Parent: TPropertyEditor; AElement: Integer); reintroduce;
  603.   public
  604.     function AllEqual: Boolean; override;
  605.     function GetAttributes: TPropertyAttributes; override;
  606.     function GetName: string; override;
  607.     function GetValue: string; override;
  608.     procedure GetValues(Proc: TGetStrProc); override;
  609.     procedure SetValue(const Value: string); override;
  610.    end;
  611.  
  612. { TSetProperty
  613.   Default property editor for all set properties. This editor does not edit
  614.   the set directly but will display sub-properties for each element of the
  615.   set. GetValue displays the value of the set in standard set syntax. }
  616.  
  617.   TSetProperty = class(TOrdinalProperty)
  618.   public
  619.     function GetAttributes: TPropertyAttributes; override;
  620.     procedure GetProperties(Proc: TGetPropEditProc); override;
  621.     function GetValue: string; override;
  622.   end;
  623.  
  624. { TClassProperty
  625.   Default property editor for all objects.  Does not allow modifying the
  626.   property but does display the class name of the object and will allow the
  627.   editing of the object's properties as sub-properties of the property. }
  628.  
  629.   TClassProperty = class(TPropertyEditor)
  630.   public
  631.     function GetAttributes: TPropertyAttributes; override;
  632.     procedure GetProperties(Proc: TGetPropEditProc); override;
  633.     function GetValue: string; override;
  634.   end;
  635.  
  636. { TMethodProperty
  637.   Property editor for all method properties. }
  638.  
  639.   TMethodProperty = class(TPropertyEditor)
  640.   public
  641.     function AllEqual: Boolean; override;
  642.     procedure Edit; override;
  643.     function GetAttributes: TPropertyAttributes; override;
  644.     function GetEditLimit: Integer; override;
  645.     function GetValue: string; override;
  646.     procedure GetValues(Proc: TGetStrProc); override;
  647.     procedure SetValue(const AValue: string); override;
  648.     function GetFormMethodName: string; virtual;
  649.     function GetTrimmedEventName: string;
  650.   end;
  651.  
  652. { TComponentProperty
  653.   The default editor for TComponents.  It does not allow editing of the
  654.   properties of the component.  It allow the user to set the value of this
  655.   property to point to a component in the same form that is type compatible
  656.   with the property being edited (e.g. the ActiveControl property). }
  657.  
  658.   TComponentProperty = class(TPropertyEditor)
  659.   public
  660.     procedure Edit; override;
  661.     function GetAttributes: TPropertyAttributes; override;
  662.     function GetEditLimit: Integer; override;
  663.     function GetValue: string; override;
  664.     procedure GetValues(Proc: TGetStrProc); override;
  665.     procedure SetValue(const Value: string); override;
  666.   end;
  667.  
  668. { TComponentNameProperty
  669.   Property editor for the Name property.  It restricts the name property
  670.   from being displayed when more than one component is selected. }
  671.  
  672.   TComponentNameProperty = class(TStringProperty)
  673.   public
  674.     function GetAttributes: TPropertyAttributes; override;
  675.     function GetEditLimit: Integer; override;
  676.   end;
  677.  
  678. { TFontNameProperty
  679.   Editor for the TFont.FontName property.  Displays a drop-down list of all
  680.   the fonts known by Windows.  The following global variable will make
  681.   this property editor actually show examples of each of the fonts in the
  682.   drop down list.  We would have enabled this by default but it takes
  683.   too many cycles on slower machines or those with a lot of fonts.  Enable
  684.   it at your own risk. ;-}
  685. var
  686.   FontNamePropertyDisplayFontNames: Boolean = False;
  687.  
  688. type
  689.   TFontNameProperty = class(TStringProperty)
  690.   public
  691.     function GetAttributes: TPropertyAttributes; override;
  692.     procedure GetValues(Proc: TGetStrProc); override;
  693.  
  694.     procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;
  695.       var AHeight: Integer); override;
  696.     procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
  697.       var AWidth: Integer); override;
  698.     procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
  699.       const ARect: TRect; ASelected: Boolean); override;
  700.   end;
  701.  
  702. { TFontCharsetProperty
  703.   Editor for the TFont.Charset property.  Displays a drop-down list of the
  704.   character-set by Windows.}
  705.  
  706.   TFontCharsetProperty = class(TIntegerProperty)
  707.   public
  708.     function GetAttributes: TPropertyAttributes; override;
  709.     function GetValue: string; override;
  710.     procedure GetValues(Proc: TGetStrProc); override;
  711.     procedure SetValue(const Value: string); override;
  712.   end;
  713.  
  714. { TImeNameProperty
  715.   Editor for the TImeName property.  Displays a drop-down list of all
  716.   the IME names known by Windows.}
  717.  
  718.   TImeNameProperty = class(TStringProperty)
  719.   public
  720.     function GetAttributes: TPropertyAttributes; override;
  721.     procedure GetValues(Proc: TGetStrProc); override;
  722.   end;
  723.  
  724. { TColorProperty
  725.   Property editor for the TColor type.  Displays the color as a clXXX value
  726.   if one exists, otherwise displays the value as hex.  Also allows the
  727.   clXXX value to be picked from a list. }
  728.  
  729.   TColorProperty = class(TIntegerProperty)
  730.   public
  731.     procedure Edit; override;
  732.     function GetAttributes: TPropertyAttributes; override;
  733.     function GetValue: string; override;
  734.     procedure GetValues(Proc: TGetStrProc); override;
  735.     procedure SetValue(const Value: string); override;
  736.  
  737.     procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
  738.       var AWidth: Integer); override;
  739.     procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
  740.       const ARect: TRect; ASelected: Boolean); override;
  741.     procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  742.       ASelected: Boolean); override;
  743.   end;
  744.  
  745. { TBrushStyleProperty
  746.   Property editor for TBrush's Style.  Simply provides for custom render. }
  747.  
  748.   TBrushStyleProperty = class(TEnumProperty)
  749.   public
  750.     procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
  751.       var AWidth: Integer); override;
  752.     procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
  753.       const ARect: TRect; ASelected: Boolean); override;
  754.     procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  755.       ASelected: Boolean); override;
  756.   end;
  757.  
  758. { TPenStyleProperty
  759.   Property editor for TPen's Style.  Simply provides for custom render. }
  760.  
  761.   TPenStyleProperty = class(TEnumProperty)
  762.   public
  763.     procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
  764.       var AWidth: Integer); override;
  765.     procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
  766.       const ARect: TRect; ASelected: Boolean); override;
  767.     procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  768.       ASelected: Boolean); override;
  769.   end;
  770.  
  771. { TCursorProperty
  772.   Property editor for the TCursor type.  Displays the cursor as a clXXX value
  773.   if one exists, otherwise displays the value as hex.  Also allows the
  774.   clXXX value to be picked from a list. }
  775.  
  776.   TCursorProperty = class(TIntegerProperty)
  777.   public
  778.     function GetAttributes: TPropertyAttributes; override;
  779.     function GetValue: string; override;
  780.     procedure GetValues(Proc: TGetStrProc); override;
  781.     procedure SetValue(const Value: string); override;
  782.     procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;
  783.       var AHeight: Integer); override;
  784.     procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
  785.       var AWidth: Integer); override;
  786.     procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
  787.       const ARect: TRect; ASelected: Boolean); override;
  788.   end;
  789.  
  790. { TFontProperty
  791.   Property editor for the Font property.  Brings up the font dialog as well as
  792.   allowing the properties of the object to be edited. }
  793.  
  794.   TFontProperty = class(TClassProperty)
  795.   public
  796.     procedure Edit; override;
  797.     function GetAttributes: TPropertyAttributes; override;
  798.   end;
  799.  
  800. { TModalResultProperty }
  801.  
  802.   TModalResultProperty = class(TIntegerProperty)
  803.   public
  804.     function GetAttributes: TPropertyAttributes; override;
  805.     function GetValue: string; override;
  806.     procedure GetValues(Proc: TGetStrProc); override;
  807.     procedure SetValue(const Value: string); override;
  808.   end;
  809.  
  810. { TShortCutProperty
  811.   Property editor the ShortCut property.  Allows both typing in a short
  812.   cut value or picking a short-cut value from a list. }
  813.  
  814.   TShortCutProperty = class(TOrdinalProperty)
  815.   public
  816.     function GetAttributes: TPropertyAttributes; override;
  817.     function GetValue: string; override;
  818.     procedure GetValues(Proc: TGetStrProc); override;
  819.     procedure SetValue(const Value: string); override;
  820.   end;
  821.  
  822. { TMPFilenameProperty
  823.   Property editor for the TMediaPlayer.  Displays an File Open Dialog
  824.   for the name of the media file.}
  825.  
  826.   TMPFilenameProperty = class(TStringProperty)
  827.   public
  828.     procedure Edit; override;
  829.     function GetAttributes: TPropertyAttributes; override;
  830.   end;
  831.  
  832. { TTabOrderProperty
  833.   Property editor for the TabOrder property.  Prevents the property from being
  834.   displayed when more than one component is selected. }
  835.  
  836.   TTabOrderProperty = class(TIntegerProperty)
  837.   public
  838.     function GetAttributes: TPropertyAttributes; override;
  839.   end;
  840.  
  841. { TCaptionProperty
  842.   Property editor for the Caption and Text properties.  Updates the value of
  843.   the property for each change instead on when the property is approved. }
  844.  
  845.   TCaptionProperty = class(TStringProperty)
  846.   public
  847.     function GetAttributes: TPropertyAttributes; override;
  848.   end;
  849.  
  850. { TDateProperty
  851.   Property editor for date portion of TDateTime type. }
  852.  
  853.   TDateProperty = class(TPropertyEditor)
  854.     function GetAttributes: TPropertyAttributes; override;
  855.     function GetValue: string; override;
  856.     procedure SetValue(const Value: string); override;
  857.   end;
  858.  
  859. { TTimeProperty
  860.   Property editor for time portion of TDateTime type. }
  861.  
  862.   TTimeProperty = class(TPropertyEditor)
  863.     function GetAttributes: TPropertyAttributes; override;
  864.     function GetValue: string; override;
  865.     procedure SetValue(const Value: string); override;
  866.   end;
  867.  
  868. { TDateTimeProperty
  869.   Edits both date and time data... simultaneously!  }
  870.  
  871.   TDateTimeProperty = class(TPropertyEditor)
  872.     function GetAttributes: TPropertyAttributes; override;
  873.     function GetValue: string; override;
  874.     procedure SetValue(const Value: string); override;
  875.   end;
  876.  
  877. { TComponentEditor
  878.   A component editor is created for each component that is selected in the
  879.   form designer based on the component's type (see GetComponentEditor and
  880.   RegisterComponentEditor).  When the component is double-clicked the Edit
  881.   method is called.  When the context menu for the component is invoked the
  882.   GetVerbCount and GetVerb methods are called to build the menu.  If one
  883.   of the verbs are selected ExecuteVerb is called.  Paste is called whenever
  884.   the component is pasted to the clipboard.  You only need to create a
  885.   component editor if you wish to add verbs to the context menu, change
  886.   the default double-click behavior, or paste an additional clipboard format.
  887.   The default component editor (TDefaultEditor) implements Edit to searches the
  888.   properties of the component and generates (or navigates to) the OnCreate,
  889.   OnChanged, or OnClick event (whichever it finds first).  Whenever the
  890.   component modifies the component is *must* call Designer.Modified to inform
  891.   the designer that the form has been modified.
  892.  
  893.     Create(AComponent, ADesigner)
  894.       Called to create the component editor.  AComponent is the component to
  895.       be edited by the editor.  ADesigner is an interface to the designer to
  896.       find controls and create methods (this is not use often).
  897.     Edit
  898.       Called when the user double-clicks the component. The component editor can
  899.       bring up a dialog in response to this method, for example, or some kind
  900.       of design expert.  If GetVerbCount is greater than zero, edit will execute
  901.       the first verb in the list (ExecuteVerb(0)).
  902.     ExecuteVerb(Index)
  903.       The Index'ed verb was selected by the use off the context menu.  The
  904.       meaning of this is determined by component editor.
  905.     GetVerb
  906.       The component editor should return a string that will be displayed in the
  907.       context menu.  It is the responsibility of the component editor to place
  908.       the & character and the '...' characters as appropriate.
  909.     GetVerbCount
  910.       The number of valid indices to GetVerb and Execute verb.  The index is assumed
  911.       to be zero based (i.e. 0..GetVerbCount - 1).
  912.     PrepareItem
  913.       While constructing the context menu PrepareItem will be called for
  914.       each verb.  It will be passed the menu item that will be used to represent
  915.       the verb.  The component editor can customize the menu item as it sees fit,
  916.       including adding subitems.  If you don't want that particular menu item
  917.       to be shown, don't free it, simply set its Visible property to False.
  918.     Copy
  919.       Called when the component is being copied to the clipboard.  The
  920.       component's filed image is already on the clipboard.  This gives the
  921.       component editor a chance to paste a different type of format which is
  922.       ignored by the designer but might be recognized by another application.
  923.     IsInInlined
  924.       Determines whether Component is in the Designer which owns it.  Essentially,
  925.       Components should not be able to be added to a Frame instance (collections
  926.       are fine though) so this function checks to determine whether the currently
  927.       selected component is within a Frame instance or not.
  928.     }
  929.  
  930.   IComponentEditor = interface
  931.     ['{ABBE7252-5495-11D1-9FB5-0020AF3D82DA}']
  932.     procedure Edit;
  933.     procedure ExecuteVerb(Index: Integer);
  934.     function GetIComponent: IComponent;
  935.     function GetDesigner: IFormDesigner;
  936.     function GetVerb(Index: Integer): string;
  937.     function GetVerbCount: Integer;
  938.     procedure PrepareItem(Index: Integer; const AItem: TMenuItem);
  939.     procedure Copy;
  940.   end;
  941.  
  942.   TComponentEditor = class(TInterfacedObject, IComponentEditor)
  943.   private
  944.     FComponent: TComponent;
  945.     FDesigner: IFormDesigner;
  946.   public
  947.     constructor Create(AComponent: TComponent; ADesigner: IFormDesigner); virtual;
  948.     procedure Edit; virtual;
  949.     procedure ExecuteVerb(Index: Integer); virtual;
  950.     function GetIComponent: IComponent;
  951.     function GetDesigner: IFormDesigner;
  952.     function GetVerb(Index: Integer): string; virtual;
  953.     function GetVerbCount: Integer; virtual;
  954.     function IsInInlined: Boolean;
  955.     procedure PrepareItem(Index: Integer; const AItem: TMenuItem); virtual;
  956.     procedure Copy; virtual;
  957.     property Component: TComponent read FComponent;
  958.     property Designer: IFormDesigner read GetDesigner;
  959.   end;
  960.  
  961.   TComponentEditorClass = class of TComponentEditor;
  962.  
  963.   IDefaultEditor = interface(IComponentEditor)
  964.     ['{5484FAE1-5C60-11D1-9FB6-0020AF3D82DA}']
  965.   end;
  966.  
  967.   TDefaultEditor = class(TComponentEditor, IDefaultEditor)
  968.   private
  969.     FFirst: TPropertyEditor;
  970.     FBest: TPropertyEditor;
  971.     FContinue: Boolean;
  972.     procedure CheckEdit(PropertyEditor: TPropertyEditor);
  973.   protected
  974.     procedure EditProperty(PropertyEditor: TPropertyEditor;
  975.       var Continue, FreeEditor: Boolean); virtual;
  976.   public
  977.     procedure Edit; override;
  978.   end;
  979.  
  980. { Global variables initialized internally by the form designer }
  981.  
  982. type
  983.   TFreeCustomModulesProc = procedure (Group: Integer);
  984.  
  985. var
  986.   FreeCustomModulesProc: TFreeCustomModulesProc;
  987.  
  988. { RegisterPropertyEditor
  989.   Registers a new property editor for the given type.  When a component is
  990.   selected the Object Inspector will create a property editor for each
  991.   of the component's properties.  The property editor is created based on
  992.   the type of the property.  If, for example, the property type is an
  993.   Integer, the property editor for Integer will be created (by default
  994.   that would be TIntegerProperty). Most properties do not need specialized
  995.   property editors.  For example, if the property is an ordinal type the
  996.   default property editor will restrict the range to the ordinal subtype
  997.   range (e.g. a property of type TMyRange = 1..10 will only allow values
  998.   between 1 and 10 to be entered into the property).  Enumerated types will
  999.   display a drop-down list of all the enumerated values (e.g. TShapes =
  1000.   (sCircle, sSquare, sTriangle) will be edited by a drop-down list containing
  1001.   only sCircle, sSquare and sTriangle).  A property editor need only be
  1002.   created if default property editor or none of the existing property editors
  1003.   are sufficient to edit the property.  This is typically because the
  1004.   property is an object.  The properties are looked up newest to oldest.
  1005.   This allows and existing property editor replaced by a custom property
  1006.   editor.
  1007.  
  1008.     PropertyType
  1009.       The type information pointer returned by the TypeInfo built-in function
  1010.       (e.g. TypeInfo(TMyRange) or TypeInfo(TShapes)).
  1011.  
  1012.     ComponentClass
  1013.       Type of the component to which to restrict this type editor.  This
  1014.       parameter can be left nil which will mean this type editor applies to all
  1015.       properties of PropertyType.
  1016.  
  1017.     PropertyName
  1018.       The name of the property to which to restrict this type editor.  This
  1019.       parameter is ignored if ComponentClass is nil.  This parameter can be
  1020.       an empty string ('') which will mean that this editor applies to all
  1021.       properties of PropertyType in ComponentClass.
  1022.  
  1023.     EditorClass
  1024.       The class of the editor to be created whenever a property of the type
  1025.       passed in PropertyTypeInfo is displayed in the Object Inspector.  The
  1026.       class will be created by calling EditorClass.Create. }
  1027.  
  1028. procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  1029.   const PropertyName: string; EditorClass: TPropertyEditorClass);
  1030.  
  1031. type
  1032.   TPropertyMapperFunc = function(Obj: TPersistent;
  1033.     PropInfo: PPropInfo): TPropertyEditorClass;
  1034.  
  1035. procedure RegisterPropertyMapper(Mapper: TPropertyMapperFunc);
  1036.  
  1037. procedure GetComponentProperties(Components: TDesignerSelectionList;
  1038.   Filter: TTypeKinds; Designer: IFormDesigner; Proc: TGetPropEditProc);
  1039.  
  1040. procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  1041.   ComponentEditor: TComponentEditorClass);
  1042.  
  1043. function GetComponentEditor(Component: TComponent;
  1044.   Designer: IFormDesigner): TComponentEditor;
  1045.  
  1046. { Custom modules }
  1047. { A custom module allows containers that descend from classes other than TForm
  1048.   to be created and edited by the form designer. This is useful for other form
  1049.   like containers (e.g. a report designer) or for specialized forms (e.g. an
  1050.   ActiveForm) or for generic component containers (e.g. a TDataModule). It is
  1051.   assumed that the base class registered will call InitInheritedComponent in its
  1052.   constructor which will initialize the component from the associated DFM file
  1053.   stored in the programs resources. See the constructors of TDataModule and
  1054.   TForm for examples of how to write such a constructor.
  1055.  
  1056.   The following designer assumptions are made, depending on the base components
  1057.   ancestor,
  1058.  
  1059.     If ComponentBaseClass descends from TForm,
  1060.  
  1061.        it is designed by creating an instance of the component as the form.
  1062.        Allows designing TForm descendants and modifying their properties as
  1063.        well as the form properties
  1064.  
  1065.     If ComponentBaseClass descends from TWinControl (but not TForm),
  1066.  
  1067.        it is designed by creating an instance of the control, placing it into a
  1068.        design-time form.  The form's client size is the default size of the
  1069.        control.
  1070.  
  1071.     If ComponentBaseClass descends from TDataModule,
  1072.  
  1073.        it is designed by creating an instance of the class and creating a
  1074.        special non-visual container designer to edit the components and display
  1075.        the icons of the contained components.
  1076.  
  1077.   The module will appear in the project file with a colon and the base class
  1078.   name appended after the component name (e.g. MyDataModule: TDataModule).
  1079.  
  1080.   Note it is not legal to register anything that does not descend from one of
  1081.   the above.
  1082.  
  1083.   TCustomModule class
  1084.     An instance of this class is created for each custom module that is
  1085.     loaded. This class is also destroyed whenever the module is unloaded.
  1086.     The Saving method is called prior to the file being saved. When the context
  1087.     menu for the module is invoked the GetVerbCount and GetVerb methods are
  1088.     called to build the menu.  If one of the verbs is selected ExecuteVerb is
  1089.     called.
  1090.     
  1091.     ExecuteVerb(Index)
  1092.       The Index'ed verb was selected by the use off the context menu.  The
  1093.       meaning of this is determined by custom module.
  1094.     GetAttributes
  1095.       cmaVirtualSize:  For TWinControl objects only: including this attribute makes
  1096.         the control "client aligned" in the design window.  Without this
  1097.         attribute, the object is sized independently from the design window.
  1098.       Attributes are a set to allow for future expansion of features.
  1099.     GetVerb(Index)
  1100.       The custom module should return a string that will be displayed in the
  1101.       context menu.  It is the responsibility of the custom module to place
  1102.       the & character and the '...' characters as appropriate.
  1103.     GetVerbCount
  1104.       The number of valid indexs to GetVerb and Execute verb.  The index assumed
  1105.       to be zero based (i.e. 0..GetVerbCount - 1).
  1106.     PrepareItem
  1107.       While constructing the context menu PrepareItem will be called for
  1108.       each verb.  It will be passed the menu item that will be used to represent
  1109.       the verb.  The module editor can customize the menu item as it sees fit,
  1110.       including adding subitems.  If you don't want that particular menu item
  1111.       to be shown don't free it, simply set it's Visible property to False.
  1112.     Saving
  1113.       Called prior to the module being saved.
  1114.     ValidateComponent(Component)
  1115.       ValidateComponent is called whenever a component is created by the
  1116.       user for the designer to contain.  The intent is for this procedure to
  1117.       raise an exception with a descriptive message if the component is not
  1118.       applicable for the container. For example, a TComponent module should
  1119.       throw an exception if the component descends from TControl.
  1120.     Root
  1121.       This is the instance being designed.}
  1122.  
  1123. type
  1124.   TCustomModuleAttribute = (cmaVirtualSize);
  1125.   TCustomModuleAttributes = set of TCustomModuleAttribute;
  1126.  
  1127.   TCustomModule = class
  1128.   private
  1129.     FRoot: IComponent;
  1130.   public
  1131.     constructor Create(ARoot: IComponent); virtual;
  1132.     procedure ExecuteVerb(Index: Integer); virtual;
  1133.     function CreateDesignerForm(Designer: IDesigner): TCustomForm; virtual;
  1134.     function GetAttributes: TCustomModuleAttributes; virtual;
  1135.     function GetVerb(Index: Integer): string; virtual;
  1136.     function GetVerbCount: Integer; virtual;
  1137.     procedure PrepareItem(Index: Integer; const AItem: TMenuItem); virtual;
  1138.     procedure Saving; virtual;
  1139.     procedure ValidateComponent(Component: IComponent); virtual;
  1140.     class function Nestable: Boolean; virtual;
  1141.     property Root: IComponent read FRoot;
  1142.   end;
  1143.  
  1144.   TCustomModuleClass = class of TCustomModule;
  1145.  
  1146.   TRegisterCustomModuleProc = procedure (Group: Integer;
  1147.     ComponentBaseClass: TComponentClass;
  1148.     CustomModuleClass: TCustomModuleClass);
  1149.  
  1150.   ICustomModuleSettings = interface
  1151.     ['{50947DAD-E627-11D2-B728-00C04FA35D12}']
  1152.     function IniSection: string;
  1153.   end;
  1154.  
  1155.   ICustomModuleProjectSettings = interface(ICustomModuleSettings)
  1156.     ['{78E12CC2-DBCC-11D2-B727-00C04FA35D12}']
  1157.     procedure SaveProjectState(AFile: TMemIniFile);
  1158.     procedure LoadProjectState(AFile: TMemIniFile);
  1159.   end;
  1160.  
  1161.   ICustomModuleUnitSettings = interface(ICustomModuleSettings)
  1162.     ['{78E12CC1-DBCC-11D2-B727-00C04FA35D12}']
  1163.     procedure SaveUnitState(AFile: TMemIniFile);
  1164.     procedure LoadUnitState(AFile: TMemIniFile);
  1165.   end;
  1166.  
  1167.   IDesignerPersistence = interface
  1168.     ['{D32194C2-EECF-11D2-AAD2-00C04FB16FBC}']
  1169.     procedure Save(const Stream: IStream);
  1170.     procedure Load(const Stream: IStream);
  1171.   end;
  1172.  
  1173. procedure RegisterCustomModule(ComponentBaseClass: TComponentClass;
  1174.   CustomModuleClass: TCustomModuleClass);
  1175.  
  1176. var
  1177.   RegisterCustomModuleProc: TRegisterCustomModuleProc;
  1178.  
  1179. { Routines used by the form designer for package management }
  1180.  
  1181. type
  1182.   TGroupChangeProc = procedure(AGroup: Integer);
  1183.   
  1184. function NewEditorGroup: Integer;
  1185. procedure FreeEditorGroup(Group: Integer);
  1186. procedure NotifyGroupChange(AProc: TGroupChangeProc);
  1187. procedure UnNotifyGroupChange(AProc: TGroupChangeProc);
  1188.  
  1189. var  // number of significant characters in identifiers
  1190.   MaxIdentLength: Byte = 63;
  1191.  
  1192. { Property Categories Classes
  1193.   The following three components make up the category management system.
  1194.   Access to them is usually managed by the following support functions.
  1195.  
  1196.   TPropertyCategoryList
  1197.     Contains and maintains the list of TPropertyCategories.  There are numerous
  1198.     'As a whole' access and manipulation methods for categories as well as
  1199.     simplified access functions.
  1200.   TPropertyCategory
  1201.     Contains and maintains the list of TPropertyFilters.  There are numerous
  1202.     'As a whole' access and manipulation methods for filters as well as data
  1203.     about the category itself.
  1204.   TPropertyFilter
  1205.     Maintains the information about a single filter associated with a particular
  1206.     category.  Along with its filter specific data it also encapsulates the
  1207.     matching algorithm. }
  1208.  
  1209. type
  1210.   TPropertyFilter = class(TObject)
  1211.   private
  1212.     FMask: TMask;
  1213.     FComponentClass: TClass;
  1214.     FPropertyType: PTypeInfo;
  1215.     FGroup: Integer;
  1216.   public
  1217.     constructor Create(const APropertyName: String; AComponentClass: TClass;
  1218.       APropertyType: PTypeInfo);
  1219.     destructor Destroy; override;
  1220.     function Match(const APropertyName: String; AComponentClass: TClass;
  1221.       APropertyType: PTypeInfo): Boolean;
  1222.     property ComponentClass: TClass read FComponentClass;
  1223.     property PropertyType: PTypeInfo read FPropertyType;
  1224.   end;
  1225.  
  1226.   TPropertyCategoryClass = class of TPropertyCategory;
  1227.   TPropertyCategory = class(TObject)
  1228.   private
  1229.     FList: TObjectList;
  1230.     FMatchCount: Integer;
  1231.     FEditor: TPropertyEditor;
  1232.     FEnabled, FVisible: Boolean;
  1233.     FGroup: Integer;
  1234.   protected
  1235.     function GetFilter(Index: Integer): TPropertyFilter;
  1236.   public
  1237.     constructor Create;
  1238.     destructor Destroy; override;
  1239.     function Add(AFilter: TPropertyFilter): TPropertyFilter;
  1240.     function Count: integer;
  1241.     function Match(const APropertyName: String; AComponentClass: TClass;
  1242.       APropertyType: PTypeInfo): Boolean;
  1243.     procedure ClearMatches;
  1244.     procedure FreeEditorGroup(AGroup: Integer);
  1245.     class function Name: string; virtual;
  1246.     class function Description: string; virtual;
  1247.     procedure PropDraw(ACanvas: TCanvas; const ARect: TRect;
  1248.       ASelected: Boolean); dynamic;
  1249.     property Filters[Index: Integer]: TPropertyFilter read GetFilter;
  1250.     property MatchCount: Integer read FMatchCount;
  1251.     property Visible: Boolean read FVisible write FVisible;
  1252.     property Editor: TPropertyEditor read FEditor write FEditor;
  1253.   end;
  1254.  
  1255.   TPropertyCategoryVisibleMode = (pcvAll, pcvToggle, pcvNone, pcvNotListed, pcvOnlyListed);
  1256.   TPropertyCategoryList = class(TObject)
  1257.   private
  1258.     FList: TObjectList;
  1259.     FMiscCategory: TPropertyCategory;
  1260.   protected
  1261.     function GetCategory(Index: Integer): TPropertyCategory;
  1262.     function GetHiddenCategories: string;
  1263.     procedure SetHiddenCategories(const Value: string);
  1264.   public
  1265.     constructor Create;
  1266.     destructor Destroy; override;
  1267.     function FindCategory(ACategoryClass: TPropertyCategoryClass): TPropertyCategory;
  1268.     function IndexOf(ACategoryClass: TPropertyCategoryClass): Integer; overload;
  1269.     function IndexOf(const ACategoryName: string): Integer; overload;
  1270.     procedure ClearMatches;
  1271.     procedure FreeEditorGroup(AGroup: Integer);
  1272.     function MiscCategory: TPropertyCategory;
  1273.     function Count: integer;
  1274.     function Match(const APropertyName: String; AComponentClass: TClass;
  1275.       APropertyType: PTypeInfo = nil): Boolean;
  1276.     function ChangeVisibility(AMode: TPropertyCategoryVisibleMode): Boolean; overload;
  1277.     function ChangeVisibility(AMode: TPropertyCategoryVisibleMode;
  1278.       const AClasses: array of TClass): Boolean; overload;
  1279.     property HiddenCategories: string read GetHiddenCategories write SetHiddenCategories;
  1280.     property Categories[Index: Integer]: TPropertyCategory read GetCategory; default;
  1281.   end;
  1282.  
  1283. { Property Categories Helpers
  1284.  
  1285.   RegisterPropertyInCategory
  1286.     This function comes in four flavors, each taking slightly different set of
  1287.     arguments.  You can specify a category filter by property name; by class
  1288.     type and property name; by property type and property name; and finally
  1289.     just by property type.  Additionally property name may include wild card
  1290.     symbols.  For example: you can add all properties that match 'Data*' to
  1291.     a particular category.  For a full list of what wild card characters
  1292.     are available please refer to the TMask class documentation.
  1293.   RegisterPropertiesInCategory
  1294.     This function will allow you to register a series of property names and/or
  1295.     property types filters in a single statement.
  1296.   IsPropertyInCategory
  1297.     This function comes in two flavors, each taking a slightly different set of
  1298.     arguments.  But in either case you can ask if a property of a certain class
  1299.     falls under the specified category.  The class can be specified by name or
  1300.     by class type.
  1301.   PropertyCategoryList
  1302.     This function will return, and create if necessary, the global property
  1303.     category list.}
  1304.  
  1305. function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  1306.   const APropertyName: string): TPropertyFilter; overload;
  1307. function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  1308.   AComponentClass: TClass; const APropertyName: string): TPropertyFilter; overload;
  1309. function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  1310.   APropertyType: PTypeInfo; const APropertyName: string): TPropertyFilter; overload;
  1311. function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  1312.   APropertyType: PTypeInfo): TPropertyFilter; overload;
  1313.  
  1314. function RegisterPropertiesInCategory(ACategoryClass: TPropertyCategoryClass;
  1315.   const AFilters: array of const): TPropertyCategory; overload;
  1316. function RegisterPropertiesInCategory(ACategoryClass: TPropertyCategoryClass;
  1317.   AComponentClass: TClass; const AFilters: array of string): TPropertyCategory; overload;
  1318. function RegisterPropertiesInCategory(ACategoryClass: TPropertyCategoryClass;
  1319.   APropertyType: PTypeInfo; const AFilters: array of string): TPropertyCategory; overload;
  1320.  
  1321. function IsPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  1322.   AComponentClass: TClass; const APropertyName: String): Boolean; overload;
  1323. function IsPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  1324.   const AClassName: string; const APropertyName: String): Boolean; overload;
  1325.  
  1326. function PropertyCategoryList: TPropertyCategoryList;
  1327.  
  1328. { Property Categories
  1329.   The following class defines the standard categories used by Delphi.  These are
  1330.   general purpose and can be used by component developers for property category
  1331.   registration.  Additionally component developers can create new descedents of
  1332.   TPropertyCategory to add completly new categories. }
  1333.  
  1334. type
  1335.   TActionCategory = class(TPropertyCategory)
  1336.   public
  1337.     class function Name: string; override;
  1338.     class function Description: string; override;
  1339.   end;
  1340.  
  1341.   TDataCategory = class(TPropertyCategory)
  1342.   public
  1343.     class function Name: string; override;
  1344.     class function Description: string; override;
  1345.   end;
  1346.  
  1347.   TDatabaseCategory = class(TPropertyCategory)
  1348.   public
  1349.     class function Name: string; override;
  1350.     class function Description: string; override;
  1351.   end;
  1352.  
  1353.   TDragNDropCategory = class(TPropertyCategory)
  1354.   public
  1355.     class function Name: string; override;
  1356.     class function Description: string; override;
  1357.   end;
  1358.  
  1359.   THelpCategory = class(TPropertyCategory)
  1360.   public
  1361.     class function Name: string; override;
  1362.     class function Description: string; override;
  1363.   end;
  1364.  
  1365.   TLayoutCategory = class(TPropertyCategory)
  1366.   public
  1367.     class function Name: string; override;
  1368.     class function Description: string; override;
  1369.   end;
  1370.  
  1371.   TLegacyCategory = class(TPropertyCategory)
  1372.   public
  1373.     class function Name: string; override;
  1374.     class function Description: string; override;
  1375.   end;
  1376.  
  1377.   TLinkageCategory = class(TPropertyCategory)
  1378.   public
  1379.     class function Name: string; override;
  1380.     class function Description: string; override;
  1381.   end;
  1382.  
  1383.   TLocaleCategory = class(TPropertyCategory)
  1384.   public
  1385.     class function Name: string; override;
  1386.     class function Description: string; override;
  1387.   end;
  1388.  
  1389.   TLocalizableCategory = class(TPropertyCategory)
  1390.   public
  1391.     class function Name: string; override;
  1392.     class function Description: string; override;
  1393.   end;
  1394.  
  1395.   TMiscellaneousCategory = class(TPropertyCategory)
  1396.   public
  1397.     class function Name: string; override;
  1398.     class function Description: string; override;
  1399.   end;
  1400.  
  1401.   TVisualCategory = class(TPropertyCategory)
  1402.   public
  1403.     class function Name: string; override;
  1404.     class function Description: string; override;
  1405.   end;
  1406.  
  1407.   TInputCategory = class(TPropertyCategory)
  1408.   public
  1409.     class function Name: string; override;
  1410.     class function Description: string; override;
  1411.   end;
  1412.  
  1413. var
  1414.   BaseRegistryKey: string = '';
  1415.  
  1416. implementation
  1417.  
  1418. uses Dialogs, Consts, Registry, Math;
  1419.  
  1420. type
  1421.   PPropertyClassRec = ^TPropertyClassRec;
  1422.   TPropertyClassRec = record
  1423.     Group: Integer;
  1424.     PropertyType: PTypeInfo;
  1425.     PropertyName: string;
  1426.     ComponentClass: TClass;
  1427.     EditorClass: TPropertyEditorClass;
  1428.   end;
  1429.  
  1430.   PPropertyMapperRec = ^TPropertyMapperRec;
  1431.   TPropertyMapperRec = record
  1432.     Group: Integer;
  1433.     Mapper: TPropertyMapperFunc;
  1434.   end;
  1435.  
  1436. const
  1437.   PropClassMap: array[TypInfo.TTypeKind] of TPropertyEditorClass = (
  1438.     nil, TIntegerProperty, TCharProperty, TEnumProperty,
  1439.     TFloatProperty, TStringProperty, TSetProperty, TClassProperty,
  1440.     TMethodProperty, TPropertyEditor, TStringProperty, TStringProperty,
  1441.     TPropertyEditor, nil, nil, nil, TInt64Property, nil);
  1442.       (* tkArray, tkRecord, kInterface, tkInt64, tkDynArray *)
  1443.  
  1444. var
  1445.   PropertyClassList: TList = nil;
  1446.   EditorGroupList: TBits = nil;
  1447.   PropertyMapperList: TList = nil;
  1448.   InternalPropertyCategoryList: TPropertyCategoryList = nil;
  1449.  
  1450. const
  1451.  
  1452.   { context ids for the Font editor and the Color Editor, etc. }
  1453.   hcDFontEditor       = 25000;
  1454.   hcDColorEditor      = 25010;
  1455.   hcDMediaPlayerOpen  = 25020;
  1456.  
  1457. { TDesignerSelectionList }
  1458.  
  1459. constructor TDesignerSelectionList.Create;
  1460. begin
  1461.   inherited Create;
  1462.   FList := TList.Create;
  1463. end;
  1464.  
  1465. destructor TDesignerSelectionList.Destroy;
  1466. begin
  1467.   FList.Free;
  1468.   inherited Destroy;
  1469. end;
  1470.  
  1471. function TDesignerSelectionList.Get(Index: Integer): TPersistent;
  1472. begin
  1473.   Result := FList[Index];
  1474. end;
  1475.  
  1476. function TDesignerSelectionList.GetCount: Integer;
  1477. begin
  1478.   Result := FList.Count;
  1479. end;
  1480.  
  1481. function TDesignerSelectionList.Add(Item: TPersistent): Integer;
  1482. begin
  1483.   Result := FList.Add(Item);
  1484. end;
  1485.  
  1486. function TDesignerSelectionList.Equals(List: TDesignerSelectionList): Boolean;
  1487. var
  1488.   I: Integer;
  1489. begin
  1490.   Result := False;
  1491.   if List.Count <> FList.Count then Exit;
  1492.   for I := 0 to List.Count - 1 do if List[I] <> FList[I] then Exit;
  1493.   Result := True;
  1494. end;
  1495.  
  1496. function TDesignerSelectionList.Intf_Add(const Item: IPersistent): Integer;
  1497. begin
  1498.   Result := Add(ExtractPersistent(Item));
  1499. end;
  1500.  
  1501. function TDesignerSelectionList.Intf_Equals(const List: IDesignerSelections): Boolean;
  1502. var
  1503.   I: Integer;
  1504.   CompList: IComponentList;
  1505.   P1, P2: IPersistent;
  1506. begin
  1507.   if List.QueryInterface(IComponentList, CompList) = 0 then
  1508.     Result := CompList.GetComponentList.Equals(Self)
  1509.   else
  1510.   begin
  1511.     Result := False;
  1512.     if List.Count <> FList.Count then Exit;
  1513.     for I := 0 to List.Count - 1 do
  1514.     begin
  1515.       P1 := Intf_Get(I);
  1516.       P2 := List[I];
  1517.       if ((P1 = nil) and (P2 <> nil)) or
  1518.         (P2 = nil) or not P1.Equals(P2) then Exit;
  1519.     end;
  1520.     Result := True;
  1521.   end;
  1522. end;
  1523.  
  1524. function TDesignerSelectionList.Intf_Get(Index: Integer): IPersistent;
  1525. begin
  1526.   Result := MakeIPersistent(TPersistent(FList[Index]));
  1527. end;
  1528.  
  1529. function TDesignerSelectionList.GetComponentList: TDesignerSelectionList;
  1530. begin
  1531.   Result := Self;
  1532. end;
  1533.  
  1534. { TPropertyEditor }
  1535.  
  1536. constructor TPropertyEditor.Create(const ADesigner: IFormDesigner;
  1537.   APropCount: Integer);
  1538. begin
  1539.   FDesigner := ADesigner;
  1540.   GetMem(FPropList, APropCount * SizeOf(TInstProp));
  1541.   FPropCount := APropCount;
  1542. end;
  1543.  
  1544. destructor TPropertyEditor.Destroy;
  1545. begin
  1546.   if FPropList <> nil then
  1547.     FreeMem(FPropList, FPropCount * SizeOf(TInstProp));
  1548. end;
  1549.  
  1550. procedure TPropertyEditor.Activate;
  1551. begin
  1552. end;
  1553.  
  1554. function TPropertyEditor.AllEqual: Boolean;
  1555. begin
  1556.   Result := FPropCount = 1;
  1557. end;
  1558.  
  1559. procedure TPropertyEditor.Edit;
  1560. type
  1561.   TGetStrFunc = function(const Value: string): Integer of object;
  1562. var
  1563.   I: Integer;
  1564.   Values: TStringList;
  1565.   AddValue: TGetStrFunc;
  1566. begin
  1567.   if not AutoFill then Exit;
  1568.   Values := TStringList.Create;
  1569.   Values.Sorted := paSortList in GetAttributes;
  1570.   try
  1571.     AddValue := Values.Add;
  1572.     GetValues(TGetStrProc(AddValue));
  1573.     if Values.Count > 0 then
  1574.     begin
  1575.       I := Values.IndexOf(Value) + 1;
  1576.       if I = Values.Count then I := 0;
  1577.       Value := Values[I];
  1578.     end;
  1579.   finally
  1580.     Values.Free;
  1581.   end;
  1582. end;
  1583.  
  1584. function TPropertyEditor.AutoFill: Boolean;
  1585. begin
  1586.   Result := True;
  1587. end;
  1588.  
  1589. function TPropertyEditor.GetAttributes: TPropertyAttributes;
  1590. begin
  1591.   Result := [paMultiSelect, paRevertable];
  1592. end;
  1593.  
  1594. function TPropertyEditor.GetComponent(Index: Integer): TPersistent;
  1595. begin
  1596.   Result := FPropList^[Index].Instance;
  1597. end;
  1598.  
  1599. function TPropertyEditor.GetFloatValue: Extended;
  1600. begin
  1601.   Result := GetFloatValueAt(0);
  1602. end;
  1603.  
  1604. function TPropertyEditor.GetFloatValueAt(Index: Integer): Extended;
  1605. begin
  1606.   with FPropList^[Index] do Result := GetFloatProp(Instance, PropInfo);
  1607. end;
  1608.  
  1609. function TPropertyEditor.GetMethodValue: TMethod;
  1610. begin
  1611.   Result := GetMethodValueAt(0);
  1612. end;
  1613.  
  1614. function TPropertyEditor.GetMethodValueAt(Index: Integer): TMethod;
  1615. begin
  1616.   with FPropList^[Index] do Result := GetMethodProp(Instance, PropInfo);
  1617. end;
  1618.  
  1619. function TPropertyEditor.GetEditLimit: Integer;
  1620. begin
  1621.   Result := 255;
  1622. end;
  1623.  
  1624. function TPropertyEditor.GetName: string;
  1625. begin
  1626.   Result := FPropList^[0].PropInfo^.Name;
  1627. end;
  1628.  
  1629. function TPropertyEditor.GetOrdValue: Longint;
  1630. begin
  1631.   Result := GetOrdValueAt(0);
  1632. end;
  1633.  
  1634. function TPropertyEditor.GetOrdValueAt(Index: Integer): Longint;
  1635. begin
  1636.   with FPropList^[Index] do Result := GetOrdProp(Instance, PropInfo);
  1637. end;
  1638.  
  1639. function TPropertyEditor.GetPrivateDirectory: string;
  1640. begin
  1641.   Result := '';
  1642.   if Designer <> nil then
  1643.     Result := Designer.GetPrivateDirectory;
  1644. end;
  1645.  
  1646. procedure TPropertyEditor.GetProperties(Proc: TGetPropEditProc);
  1647. begin
  1648. end;
  1649.  
  1650. function TPropertyEditor.GetPropInfo: PPropInfo;
  1651. begin
  1652.   Result := FPropList^[0].PropInfo;
  1653. end;
  1654.  
  1655. function TPropertyEditor.GetPropType: PTypeInfo;
  1656. begin
  1657.   Result := FPropList^[0].PropInfo^.PropType^;
  1658. end;
  1659.  
  1660. function TPropertyEditor.GetStrValue: string;
  1661. begin
  1662.   Result := GetStrValueAt(0);
  1663. end;
  1664.  
  1665. function TPropertyEditor.GetStrValueAt(Index: Integer): string;
  1666. begin
  1667.   with FPropList^[Index] do Result := GetStrProp(Instance, PropInfo);
  1668. end;
  1669.  
  1670. function TPropertyEditor.GetVarValue: Variant;
  1671. begin
  1672.   Result := GetVarValueAt(0);
  1673. end;
  1674.  
  1675. function TPropertyEditor.GetVarValueAt(Index: Integer): Variant;
  1676. begin
  1677.   with FPropList^[Index] do Result := GetVariantProp(Instance, PropInfo);
  1678. end;
  1679.  
  1680. function TPropertyEditor.GetValue: string;
  1681. begin
  1682.   Result := srUnknown;
  1683. end;
  1684.  
  1685. function TPropertyEditor.GetVisualValue: string;
  1686. begin
  1687.   if AllEqual then
  1688.     Result := GetValue
  1689.   else
  1690.     Result := '';
  1691. end;
  1692.  
  1693. procedure TPropertyEditor.GetValues(Proc: TGetStrProc);
  1694. begin
  1695. end;
  1696.  
  1697. procedure TPropertyEditor.Initialize;
  1698. begin
  1699. end;
  1700.  
  1701. procedure TPropertyEditor.Modified;
  1702. begin
  1703.   if Designer <> nil then
  1704.     Designer.Modified;
  1705. end;
  1706.  
  1707. procedure TPropertyEditor.SetFloatValue(Value: Extended);
  1708. var
  1709.   I: Integer;
  1710. begin
  1711.   for I := 0 to FPropCount - 1 do
  1712.     with FPropList^[I] do SetFloatProp(Instance, PropInfo, Value);
  1713.   Modified;
  1714. end;
  1715.  
  1716. procedure TPropertyEditor.SetMethodValue(const Value: TMethod);
  1717. var
  1718.   I: Integer;
  1719. begin
  1720.   for I := 0 to FPropCount - 1 do
  1721.     with FPropList^[I] do SetMethodProp(Instance, PropInfo, Value);
  1722.   Modified;
  1723. end;
  1724.  
  1725. procedure TPropertyEditor.SetOrdValue(Value: Longint);
  1726. var
  1727.   I: Integer;
  1728. begin
  1729.   for I := 0 to FPropCount - 1 do
  1730.     with FPropList^[I] do SetOrdProp(Instance, PropInfo, Value);
  1731.   Modified;
  1732. end;
  1733.  
  1734. procedure TPropertyEditor.SetPropEntry(Index: Integer;
  1735.   AInstance: TPersistent; APropInfo: PPropInfo);
  1736. begin
  1737.   with FPropList^[Index] do
  1738.   begin
  1739.     Instance := AInstance;
  1740.     PropInfo := APropInfo;
  1741.   end;
  1742. end;
  1743.  
  1744. procedure TPropertyEditor.SetStrValue(const Value: string);
  1745. var
  1746.   I: Integer;
  1747. begin
  1748.   for I := 0 to FPropCount - 1 do
  1749.     with FPropList^[I] do SetStrProp(Instance, PropInfo, Value);
  1750.   Modified;
  1751. end;
  1752.  
  1753. procedure TPropertyEditor.SetVarValue(const Value: Variant);
  1754. var
  1755.   I: Integer;
  1756. begin
  1757.   for I := 0 to FPropCount - 1 do
  1758.     with FPropList^[I] do SetVariantProp(Instance, PropInfo, Value);
  1759.   Modified;
  1760. end;
  1761.  
  1762. procedure TPropertyEditor.Revert;
  1763. var
  1764.   I: Integer;
  1765. begin
  1766.   if Designer <> nil then
  1767.     for I := 0 to FPropCount - 1 do
  1768.       with FPropList^[I] do Designer.Revert(Instance, PropInfo);
  1769. end;
  1770.  
  1771. procedure TPropertyEditor.SetValue(const Value: string);
  1772. begin
  1773. end;
  1774.  
  1775. function TPropertyEditor.ValueAvailable: Boolean;
  1776. var
  1777.   I: Integer;
  1778.   S: string;
  1779. begin
  1780.   Result := True;
  1781.   for I := 0 to FPropCount - 1 do
  1782.   begin
  1783.     if (FPropList^[I].Instance is TComponent) and
  1784.       (csCheckPropAvail in TComponent(FPropList^[I].Instance).ComponentStyle) then
  1785.     begin
  1786.       try
  1787.         S := GetValue;
  1788.         AllEqual;
  1789.       except
  1790.         Result := False;
  1791.       end;
  1792.       Exit;
  1793.     end;
  1794.   end;
  1795. end;
  1796.  
  1797. function TPropertyEditor.GetInt64Value: Int64;
  1798. begin
  1799.   Result := GetInt64ValueAt(0);
  1800. end;
  1801.  
  1802. function TPropertyEditor.GetInt64ValueAt(Index: Integer): Int64;
  1803. begin
  1804.   with FPropList^[Index] do Result := GetInt64Prop(Instance, PropInfo);
  1805. end;
  1806.  
  1807. procedure TPropertyEditor.SetInt64Value(Value: Int64);
  1808. var
  1809.   I: Integer;
  1810. begin
  1811.   for I := 0 to FPropCount - 1 do
  1812.     with FPropList^[I] do SetInt64Prop(Instance, PropInfo, Value);
  1813.   Modified;
  1814. end;
  1815.  
  1816. { these three procedures implement the default render behavior of the
  1817.   object/property inspector's drop down list editor.  you don't need to
  1818.   override the two measure procedures if the default width or height don't
  1819.   need to be changed. }
  1820. procedure TPropertyEditor.ListMeasureHeight(const Value: string; ACanvas: TCanvas;
  1821.   var AHeight: Integer);
  1822. begin
  1823. end;
  1824.  
  1825. procedure TPropertyEditor.ListMeasureWidth(const Value: string; ACanvas: TCanvas;
  1826.   var AWidth: Integer);
  1827. begin
  1828. end;
  1829.  
  1830. procedure TPropertyEditor.ListDrawValue(const Value: string; ACanvas: TCanvas;
  1831.   const ARect: TRect; ASelected: Boolean);
  1832. begin
  1833.   ACanvas.TextRect(ARect, ARect.Left + 1, ARect.Top + 1, Value);
  1834. end;
  1835.  
  1836. { these two procedures implement the default render behavior of the
  1837.   object/property inspector }
  1838. procedure TPropertyEditor.PropDrawName(ACanvas: TCanvas; const ARect: TRect;
  1839.   ASelected: Boolean);
  1840. begin
  1841.   ACanvas.TextRect(ARect, ARect.Left + 1, ARect.Top + 1, GetName);
  1842. end;
  1843.  
  1844. procedure TPropertyEditor.PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  1845.   ASelected: Boolean);
  1846. begin
  1847.   ACanvas.TextRect(ARect, ARect.Left + 1, ARect.Top + 1, GetVisualValue)
  1848. end;
  1849.  
  1850. { TOrdinalProperty }
  1851.  
  1852. function TOrdinalProperty.AllEqual: Boolean;
  1853. var
  1854.   I: Integer;
  1855.   V: Longint;
  1856. begin
  1857.   Result := False;
  1858.   if PropCount > 1 then
  1859.   begin
  1860.     V := GetOrdValue;
  1861.     for I := 1 to PropCount - 1 do
  1862.       if GetOrdValueAt(I) <> V then Exit;
  1863.   end;
  1864.   Result := True;
  1865. end;
  1866.  
  1867. function TOrdinalProperty.GetEditLimit: Integer;
  1868. begin
  1869.   Result := 63;
  1870. end;
  1871.  
  1872. { TIntegerProperty }
  1873.  
  1874. function TIntegerProperty.GetValue: string;
  1875. begin
  1876.   with GetTypeData(GetPropType)^ do
  1877.     if OrdType = otULong then // unsigned
  1878.       Result := IntToStr(Cardinal(GetOrdValue))
  1879.     else
  1880.       Result := IntToStr(GetOrdValue);
  1881. end;
  1882.  
  1883. procedure TIntegerProperty.SetValue(const Value: String);
  1884.  
  1885.   procedure Error(const Args: array of const);
  1886.   begin
  1887.     raise EPropertyError.CreateResFmt(@SOutOfRange, Args);
  1888.   end;
  1889.  
  1890. var
  1891.   L: Int64;
  1892. begin
  1893.   L := StrToInt64(Value);
  1894.   with GetTypeData(GetPropType)^ do
  1895.     if OrdType = otULong then
  1896.     begin   // unsigned compare and reporting needed
  1897.       if (L < Cardinal(MinValue)) or (L > Cardinal(MaxValue)) then
  1898.         // bump up to Int64 to get past the %d in the format string
  1899.         Error([Int64(Cardinal(MinValue)), Int64(Cardinal(MaxValue))]);
  1900.     end
  1901.     else if (L < MinValue) or (L > MaxValue) then
  1902.       Error([MinValue, MaxValue]);
  1903.   SetOrdValue(L);
  1904. end;
  1905.  
  1906. { TCharProperty }
  1907.  
  1908. function TCharProperty.GetValue: string;
  1909. var
  1910.   Ch: Char;
  1911. begin
  1912.   Ch := Chr(GetOrdValue);
  1913.   if Ch in [#33..#127] then
  1914.     Result := Ch else
  1915.     FmtStr(Result, '#%d', [Ord(Ch)]);
  1916. end;
  1917.  
  1918. procedure TCharProperty.SetValue(const Value: string);
  1919. var
  1920.   L: Longint;
  1921. begin
  1922.   if Length(Value) = 0 then L := 0 else
  1923.     if Length(Value) = 1 then L := Ord(Value[1]) else
  1924.       if Value[1] = '#' then L := StrToInt(Copy(Value, 2, Maxint)) else
  1925.         raise EPropertyError.CreateRes(@SInvalidPropertyValue);
  1926.   with GetTypeData(GetPropType)^ do
  1927.     if (L < MinValue) or (L > MaxValue) then
  1928.       raise EPropertyError.CreateResFmt(@SOutOfRange, [MinValue, MaxValue]);
  1929.   SetOrdValue(L);
  1930. end;
  1931.  
  1932. { TEnumProperty }
  1933.  
  1934. function TEnumProperty.GetAttributes: TPropertyAttributes;
  1935. begin
  1936.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  1937. end;
  1938.  
  1939. function TEnumProperty.GetValue: string;
  1940. var
  1941.   L: Longint;
  1942. begin
  1943.   L := GetOrdValue;
  1944.   with GetTypeData(GetPropType)^ do
  1945.     if (L < MinValue) or (L > MaxValue) then L := MaxValue;
  1946.   Result := GetEnumName(GetPropType, L);
  1947. end;
  1948.  
  1949. procedure TEnumProperty.GetValues(Proc: TGetStrProc);
  1950. var
  1951.   I: Integer;
  1952.   EnumType: PTypeInfo;
  1953. begin
  1954.   EnumType := GetPropType;
  1955.   with GetTypeData(EnumType)^ do
  1956.     for I := MinValue to MaxValue do Proc(GetEnumName(EnumType, I));
  1957. end;
  1958.  
  1959. procedure TEnumProperty.SetValue(const Value: string);
  1960. var
  1961.   I: Integer;
  1962. begin
  1963.   I := GetEnumValue(GetPropType, Value);
  1964.   if I < 0 then raise EPropertyError.CreateRes(@SInvalidPropertyValue);
  1965.   SetOrdValue(I);
  1966. end;
  1967.  
  1968. { TBoolProperty  }
  1969.  
  1970. function TBoolProperty.GetValue: string;
  1971. begin
  1972.   if GetOrdValue = 0 then
  1973.     Result := 'False'
  1974.   else
  1975.     Result := 'True';
  1976. end;
  1977.  
  1978. procedure TBoolProperty.GetValues(Proc: TGetStrProc);
  1979. begin
  1980.   Proc('False');
  1981.   Proc('True');
  1982. end;
  1983.  
  1984. procedure TBoolProperty.SetValue(const Value: string);
  1985. var
  1986.   I: Integer;
  1987. begin
  1988.   if CompareText(Value, 'False') = 0 then
  1989.     I := 0
  1990.   else if CompareText(Value, 'True') = 0 then
  1991.     I := -1
  1992.   else
  1993.     I := StrToInt(Value);
  1994.   SetOrdValue(I);
  1995. end;
  1996.  
  1997. { TInt64Property }
  1998.  
  1999. function TInt64Property.AllEqual: Boolean;
  2000. var
  2001.   I: Integer;
  2002.   V: Int64;
  2003. begin
  2004.   Result := False;
  2005.   if PropCount > 1 then
  2006.   begin
  2007.     V := GetInt64Value;
  2008.     for I := 1 to PropCount - 1 do
  2009.       if GetInt64ValueAt(I) <> V then Exit;
  2010.   end;
  2011.   Result := True;
  2012. end;
  2013.  
  2014. function TInt64Property.GetEditLimit: Integer;
  2015. begin
  2016.   Result := 63;
  2017. end;
  2018.  
  2019. function TInt64Property.GetValue: string;
  2020. begin
  2021.   Result := IntToStr(GetInt64Value);
  2022. end;
  2023.  
  2024. procedure TInt64Property.SetValue(const Value: string);
  2025. begin
  2026.   SetInt64Value(StrToInt64(Value));
  2027. end;
  2028.  
  2029.  
  2030. { TFloatProperty }
  2031.  
  2032. function TFloatProperty.AllEqual: Boolean;
  2033. var
  2034.   I: Integer;
  2035.   V: Extended;
  2036. begin
  2037.   Result := False;
  2038.   if PropCount > 1 then
  2039.   begin
  2040.     V := GetFloatValue;
  2041.     for I := 1 to PropCount - 1 do
  2042.       if GetFloatValueAt(I) <> V then Exit;
  2043.   end;
  2044.   Result := True;
  2045. end;
  2046.  
  2047. function TFloatProperty.GetValue: string;
  2048. const
  2049.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 18);
  2050. begin
  2051.   Result := FloatToStrF(GetFloatValue, ffGeneral,
  2052.     Precisions[GetTypeData(GetPropType)^.FloatType], 0);
  2053. end;
  2054.  
  2055. procedure TFloatProperty.SetValue(const Value: string);
  2056. begin
  2057.   SetFloatValue(StrToFloat(Value));
  2058. end;
  2059.  
  2060. { TStringProperty }
  2061.  
  2062. function TStringProperty.AllEqual: Boolean;
  2063. var
  2064.   I: Integer;
  2065.   V: string;
  2066. begin
  2067.   Result := False;
  2068.   if PropCount > 1 then
  2069.   begin
  2070.     V := GetStrValue;
  2071.     for I := 1 to PropCount - 1 do
  2072.       if GetStrValueAt(I) <> V then Exit;
  2073.   end;
  2074.   Result := True;
  2075. end;
  2076.  
  2077. function TStringProperty.GetEditLimit: Integer;
  2078. begin
  2079.   if GetPropType^.Kind = tkString then
  2080.     Result := GetTypeData(GetPropType)^.MaxLength else
  2081.     Result := 255;
  2082. end;
  2083.  
  2084. function TStringProperty.GetValue: string;
  2085. begin
  2086.   Result := GetStrValue;
  2087. end;
  2088.  
  2089. procedure TStringProperty.SetValue(const Value: string);
  2090. begin
  2091.   SetStrValue(Value);
  2092. end;
  2093.  
  2094. { TComponentNameProperty }
  2095.  
  2096. function TComponentNameProperty.GetAttributes: TPropertyAttributes;
  2097. begin
  2098.   Result := [];
  2099. end;
  2100.  
  2101. function TComponentNameProperty.GetEditLimit: Integer;
  2102. begin
  2103.   Result := MaxIdentLength;
  2104. end;
  2105.  
  2106. { TNestedProperty }
  2107.  
  2108. constructor TNestedProperty.Create(Parent: TPropertyEditor);
  2109. begin
  2110.   FDesigner := Parent.Designer;
  2111.   FPropList := Parent.FPropList;
  2112.   FPropCount := Parent.PropCount;
  2113. end;
  2114.  
  2115. destructor TNestedProperty.Destroy;
  2116. begin
  2117. end;
  2118.  
  2119. { TSetElementProperty }
  2120.  
  2121. constructor TSetElementProperty.Create(Parent: TPropertyEditor; AElement: Integer);
  2122. begin
  2123.   inherited Create(Parent);
  2124.   FElement := AElement;
  2125. end;
  2126.  
  2127. function TSetElementProperty.AllEqual: Boolean;
  2128. var
  2129.   I: Integer;
  2130.   S: TIntegerSet;
  2131.   V: Boolean;
  2132. begin
  2133.   Result := False;
  2134.   if PropCount > 1 then
  2135.   begin
  2136.     Integer(S) := GetOrdValue;
  2137.     V := FElement in S;
  2138.     for I := 1 to PropCount - 1 do
  2139.     begin
  2140.       Integer(S) := GetOrdValueAt(I);
  2141.       if (FElement in S) <> V then Exit;
  2142.     end;
  2143.   end;
  2144.   Result := True;
  2145. end;
  2146.  
  2147. function TSetElementProperty.GetAttributes: TPropertyAttributes;
  2148. begin
  2149.   Result := [paMultiSelect, paValueList, paSortList];
  2150. end;
  2151.  
  2152. function TSetElementProperty.GetName: string;
  2153. begin
  2154.   Result := GetEnumName(GetTypeData(GetPropType)^.CompType^, FElement);
  2155. end;
  2156.  
  2157. function TSetElementProperty.GetValue: string;
  2158. var
  2159.   S: TIntegerSet;
  2160. begin
  2161.   Integer(S) := GetOrdValue;
  2162.   Result := BooleanIdents[FElement in S];
  2163. end;
  2164.  
  2165. procedure TSetElementProperty.GetValues(Proc: TGetStrProc);
  2166. begin
  2167.   Proc(BooleanIdents[False]);
  2168.   Proc(BooleanIdents[True]);
  2169. end;
  2170.  
  2171. procedure TSetElementProperty.SetValue(const Value: string);
  2172. var
  2173.   S: TIntegerSet;
  2174. begin
  2175.   Integer(S) := GetOrdValue;
  2176.   if CompareText(Value, 'True') = 0 then
  2177.     Include(S, FElement) else
  2178.     Exclude(S, FElement);
  2179.   SetOrdValue(Integer(S));
  2180. end;
  2181.  
  2182. { TSetProperty }
  2183.  
  2184. function TSetProperty.GetAttributes: TPropertyAttributes;
  2185. begin
  2186.   Result := [paMultiSelect, paSubProperties, paReadOnly, paRevertable];
  2187. end;
  2188.  
  2189. procedure TSetProperty.GetProperties(Proc: TGetPropEditProc);
  2190. var
  2191.   I: Integer;
  2192. begin
  2193.   with GetTypeData(GetTypeData(GetPropType)^.CompType^)^ do
  2194.     for I := MinValue to MaxValue do
  2195.       Proc(TSetElementProperty.Create(Self, I));
  2196. end;
  2197.  
  2198. function TSetProperty.GetValue: string;
  2199. var
  2200.   S: TIntegerSet;
  2201.   TypeInfo: PTypeInfo;
  2202.   I: Integer;
  2203. begin
  2204.   Integer(S) := GetOrdValue;
  2205.   TypeInfo := GetTypeData(GetPropType)^.CompType^;
  2206.   Result := '[';
  2207.   for I := 0 to SizeOf(Integer) * 8 - 1 do
  2208.     if I in S then
  2209.     begin
  2210.       if Length(Result) <> 1 then Result := Result + ',';
  2211.       Result := Result + GetEnumName(TypeInfo, I);
  2212.     end;
  2213.   Result := Result + ']';
  2214. end;
  2215.  
  2216. { TClassProperty }
  2217.  
  2218. function TClassProperty.GetAttributes: TPropertyAttributes;
  2219. begin
  2220.   Result := [paMultiSelect, paSubProperties, paReadOnly];
  2221. end;
  2222.  
  2223. procedure TClassProperty.GetProperties(Proc: TGetPropEditProc);
  2224. var
  2225.   I: Integer;
  2226.   Components: TDesignerSelectionList;
  2227. begin
  2228.   Components := TDesignerSelectionList.Create;
  2229.   try
  2230.     for I := 0 to PropCount - 1 do
  2231.       Components.Add(TComponent(GetOrdValueAt(I)));
  2232.     GetComponentProperties(Components, tkProperties, Designer, Proc);
  2233.   finally
  2234.     Components.Free;
  2235.   end;
  2236. end;
  2237.  
  2238. function TClassProperty.GetValue: string;
  2239. begin
  2240.   FmtStr(Result, '(%s)', [GetPropType^.Name]);
  2241. end;
  2242.  
  2243. { TComponentProperty }
  2244.  
  2245. procedure TComponentProperty.Edit;
  2246. begin
  2247.   if (GetKeyState(VK_CONTROL) < 0) and
  2248.      (GetKeyState(VK_LBUTTON) < 0) and
  2249.      (GetOrdValue <> 0) then
  2250.     Designer.SelectComponent(TPersistent(GetOrdValue))
  2251.   else
  2252.     inherited Edit;
  2253. end;
  2254.  
  2255. function TComponentProperty.GetAttributes: TPropertyAttributes;
  2256. begin
  2257.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  2258. end;
  2259.  
  2260. function TComponentProperty.GetEditLimit: Integer;
  2261. begin
  2262.   Result := 127;
  2263. end;
  2264.  
  2265. function TComponentProperty.GetValue: string;
  2266. begin
  2267.   Result := Designer.GetComponentName(TComponent(GetOrdValue));
  2268. end;
  2269.  
  2270. procedure TComponentProperty.GetValues(Proc: TGetStrProc);
  2271. begin
  2272.   Designer.GetComponentNames(GetTypeData(GetPropType), Proc);
  2273. end;
  2274.  
  2275. procedure TComponentProperty.SetValue(const Value: string);
  2276. var
  2277.   Component: TComponent;
  2278. begin
  2279.   if Value = '' then Component := nil else
  2280.   begin
  2281.     Component := Designer.GetComponent(Value);
  2282.     if not (Component is GetTypeData(GetPropType)^.ClassType) then
  2283.       raise EPropertyError.CreateRes(@SInvalidPropertyValue);
  2284.   end;
  2285.   SetOrdValue(Longint(Component));
  2286. end;
  2287.  
  2288. { TMethodProperty }
  2289.  
  2290. function TMethodProperty.AllEqual: Boolean;
  2291. var
  2292.   I: Integer;
  2293.   V, T: TMethod;
  2294. begin
  2295.   Result := False;
  2296.   if PropCount > 1 then
  2297.   begin
  2298.     V := GetMethodValue;
  2299.     for I := 1 to PropCount - 1 do
  2300.     begin
  2301.       T := GetMethodValueAt(I);
  2302.       if (T.Code <> V.Code) or (T.Data <> V.Data) then Exit;
  2303.     end;
  2304.   end;
  2305.   Result := True;
  2306. end;
  2307.  
  2308. procedure TMethodProperty.Edit;
  2309. var
  2310.   FormMethodName: string;
  2311. begin
  2312.   FormMethodName := GetValue;
  2313.   if (FormMethodName = '') or
  2314.     Designer.MethodFromAncestor(GetMethodValue) then
  2315.   begin
  2316.     if FormMethodName = '' then
  2317.       FormMethodName := GetFormMethodName;
  2318.     if FormMethodName = '' then
  2319.       raise EPropertyError.CreateRes(@SCannotCreateName);
  2320.     SetValue(FormMethodName);
  2321.   end;
  2322.   Designer.ShowMethod(FormMethodName);
  2323. end;
  2324.  
  2325. function TMethodProperty.GetAttributes: TPropertyAttributes;
  2326. begin
  2327.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  2328. end;
  2329.  
  2330. function TMethodProperty.GetEditLimit: Integer;
  2331. begin
  2332.   Result := MaxIdentLength;
  2333. end;
  2334.  
  2335. function TMethodProperty.GetFormMethodName: string;
  2336. var
  2337.   I: Integer;
  2338. begin
  2339.   if GetComponent(0) = Designer.GetRoot then
  2340.   begin
  2341.     Result := Designer.GetRootClassName;
  2342.     if (Result <> '') and (Result[1] = 'T') then
  2343.       Delete(Result, 1, 1);
  2344.   end
  2345.   else
  2346.   begin
  2347.     Result := Designer.GetObjectName(GetComponent(0));
  2348.     for I := Length(Result) downto 1 do
  2349.       if Result[I] in ['.','[',']'] then
  2350.         Delete(Result, I, 1);
  2351.   end;
  2352.   if Result = '' then
  2353.     raise EPropertyError.CreateRes(@SCannotCreateName);
  2354.   Result := Result + GetTrimmedEventName;
  2355. end;
  2356.  
  2357. function TMethodProperty.GetTrimmedEventName: string;
  2358. begin
  2359.   Result := GetName;
  2360.   if (Length(Result) >= 2) and
  2361.     (Result[1] in ['O','o']) and (Result[2] in ['N','n']) then
  2362.     Delete(Result,1,2);
  2363. end;
  2364.  
  2365. function TMethodProperty.GetValue: string;
  2366. begin
  2367.   Result := Designer.GetMethodName(GetMethodValue);
  2368. end;
  2369.  
  2370. procedure TMethodProperty.GetValues(Proc: TGetStrProc);
  2371. begin
  2372.   Designer.GetMethods(GetTypeData(GetPropType), Proc);
  2373. end;
  2374.  
  2375. procedure TMethodProperty.SetValue(const AValue: string);
  2376.  
  2377.   procedure CheckChainCall(const MethodName: string; Method: TMethod);
  2378.   var
  2379.     Persistent: TPersistent;
  2380.     Component: TComponent;
  2381.     InstanceMethod: string;
  2382.     Instance: TComponent;
  2383.   begin
  2384.     Persistent := GetComponent(0);
  2385.     if Persistent is TComponent then
  2386.     begin
  2387.       Component := TComponent(Persistent);
  2388.       if (Component.Name <> '') and (Method.Data <> Designer.GetRoot) and
  2389.         (TObject(Method.Data) is TComponent) then
  2390.       begin
  2391.         Instance := TComponent(Method.Data);
  2392.         InstanceMethod := Instance.MethodName(Method.Code);
  2393.         if InstanceMethod <> '' then
  2394.           Designer.ChainCall(MethodName, Instance.Name, InstanceMethod,
  2395.             GetTypeData(GetPropType));
  2396.       end;
  2397.     end;
  2398.   end;
  2399.  
  2400. var
  2401.   NewMethod: Boolean;
  2402.   CurValue: string;
  2403.   OldMethod: TMethod;
  2404. begin
  2405.   CurValue:= GetValue;
  2406.   if (CurValue <> '') and (AValue <> '') and (SameText(CurValue, AValue) or
  2407.     not Designer.MethodExists(AValue)) and not Designer.MethodFromAncestor(GetMethodValue) then
  2408.     Designer.RenameMethod(CurValue, AValue)
  2409.   else
  2410.   begin
  2411.     NewMethod := (AValue <> '') and not Designer.MethodExists(AValue);
  2412.     OldMethod := GetMethodValue;
  2413.     SetMethodValue(Designer.CreateMethod(AValue, GetTypeData(GetPropType)));
  2414.     if NewMethod then
  2415.     begin
  2416.       if (PropCount = 1) and (OldMethod.Data <> nil) and (OldMethod.Code <> nil) then
  2417.         CheckChainCall(AValue, OldMethod);
  2418.       Designer.ShowMethod(AValue);
  2419.     end;
  2420.   end;
  2421. end;
  2422.  
  2423. { TFontNameProperty }
  2424. { Owner draw code has been commented out, see the interface section's for info. }
  2425.  
  2426. function TFontNameProperty.GetAttributes: TPropertyAttributes;
  2427. begin
  2428.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  2429. end;
  2430.  
  2431. procedure TFontNameProperty.GetValues(Proc: TGetStrProc);
  2432. var
  2433.   I: Integer;
  2434. begin
  2435.   for I := 0 to Screen.Fonts.Count - 1 do Proc(Screen.Fonts[I]);
  2436. end;
  2437.  
  2438. procedure TFontNameProperty.ListDrawValue(const Value: string;
  2439.   ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  2440. var
  2441.   vOldFontName: string;
  2442. begin
  2443.   if FontNamePropertyDisplayFontNames then
  2444.     with ACanvas do
  2445.     begin
  2446.       // save off things
  2447.       vOldFontName := Font.Name;
  2448.  
  2449.       // set things up and do work
  2450.       Font.Name := Value;
  2451.       TextRect(ARect, ARect.Left + 2, ARect.Top + 1, Value);
  2452.  
  2453.       // restore things
  2454.       Font.Name := vOldFontName;
  2455.     end
  2456.   else
  2457.     inherited ListDrawValue(Value, ACanvas, ARect, ASelected);
  2458. end;
  2459.  
  2460. procedure TFontNameProperty.ListMeasureHeight(const Value: string;
  2461.   ACanvas: TCanvas; var AHeight: Integer);
  2462. var
  2463.   vOldFontName: string;
  2464. begin
  2465.   if FontNamePropertyDisplayFontNames then
  2466.     with ACanvas do
  2467.     begin
  2468.       // save off things
  2469.       vOldFontName := Font.Name;
  2470.  
  2471.       // set things up and do work
  2472.       Font.Name := Value;
  2473.       AHeight := TextHeight(Value) + 2;
  2474.  
  2475.       // restore things
  2476.       Font.Name := vOldFontName;
  2477.     end
  2478.   else
  2479.     inherited ListMeasureHeight(Value, ACanvas, AHeight);
  2480. end;
  2481.  
  2482. procedure TFontNameProperty.ListMeasureWidth(const Value: string;
  2483.   ACanvas: TCanvas; var AWidth: Integer);
  2484. var
  2485.   vOldFontName: string;
  2486. begin
  2487.   if FontNamePropertyDisplayFontNames then
  2488.     with ACanvas do
  2489.     begin
  2490.       // save off things
  2491.       vOldFontName := Font.Name;
  2492.  
  2493.       // set things up and do work
  2494.       Font.Name := Value;
  2495.       AWidth := TextWidth(Value) + 4;
  2496.  
  2497.       // restore things
  2498.       Font.Name := vOldFontName;
  2499.     end
  2500.   else
  2501.     inherited ListMeasureWidth(Value, ACanvas, AWidth);
  2502. end;
  2503.  
  2504. { TFontCharsetProperty }
  2505.  
  2506. function TFontCharsetProperty.GetAttributes: TPropertyAttributes;
  2507. begin
  2508.   Result := [paMultiSelect, paSortList, paValueList];
  2509. end;
  2510.  
  2511. function TFontCharsetProperty.GetValue: string;
  2512. begin
  2513.   if not CharsetToIdent(TFontCharset(GetOrdValue), Result) then
  2514.     FmtStr(Result, '%d', [GetOrdValue]);
  2515. end;
  2516.  
  2517. procedure TFontCharsetProperty.GetValues(Proc: TGetStrProc);
  2518. begin
  2519.   GetCharsetValues(Proc);
  2520. end;
  2521.  
  2522. procedure TFontCharsetProperty.SetValue(const Value: string);
  2523. var
  2524.   NewValue: Longint;
  2525. begin
  2526.   if IdentToCharset(Value, NewValue) then
  2527.     SetOrdValue(NewValue)
  2528.   else inherited SetValue(Value);
  2529. end;
  2530.  
  2531. { TImeNameProperty }
  2532.  
  2533. function TImeNameProperty.GetAttributes: TPropertyAttributes;
  2534. begin
  2535.   Result := [paValueList, paSortList, paMultiSelect];
  2536. end;
  2537.  
  2538. procedure TImeNameProperty.GetValues(Proc: TGetStrProc);
  2539. var
  2540.   I: Integer;
  2541. begin
  2542.   for I := 0 to Screen.Imes.Count - 1 do Proc(Screen.Imes[I]);
  2543. end;
  2544.  
  2545. { TMPFilenameProperty }
  2546.  
  2547. procedure TMPFilenameProperty.Edit;
  2548. var
  2549.   MPFileOpen: TOpenDialog;
  2550. begin
  2551.   MPFileOpen := TOpenDialog.Create(Application);
  2552.   MPFileOpen.Filename := GetValue;
  2553.   MPFileOpen.Filter := SMPOpenFilter;
  2554.   MPFileOpen.HelpContext := hcDMediaPlayerOpen;
  2555.   MPFileOpen.Options := MPFileOpen.Options + [ofShowHelp, ofPathMustExist,
  2556.     ofFileMustExist];
  2557.   try
  2558.     if MPFileOpen.Execute then SetValue(MPFileOpen.Filename);
  2559.   finally
  2560.     MPFileOpen.Free;
  2561.   end;
  2562. end;
  2563.  
  2564. function TMPFilenameProperty.GetAttributes: TPropertyAttributes;
  2565. begin
  2566.   Result := [paDialog, paRevertable];
  2567. end;
  2568.  
  2569. { TColorProperty }
  2570.  
  2571. procedure TColorProperty.Edit;
  2572. var
  2573.   ColorDialog: TColorDialog;
  2574.   IniFile: TRegIniFile;
  2575.  
  2576.   procedure GetCustomColors;
  2577.   begin
  2578.     if BaseRegistryKey = '' then Exit;
  2579.     IniFile := TRegIniFile.Create(BaseRegistryKey);
  2580.     try
  2581.       IniFile.ReadSectionValues(SCustomColors, ColorDialog.CustomColors);
  2582.     except
  2583.       { Ignore errors reading values }
  2584.     end;
  2585.   end;
  2586.  
  2587.   procedure SaveCustomColors;
  2588.   var
  2589.     I, P: Integer;
  2590.     S: string;
  2591.   begin
  2592.     if IniFile <> nil then
  2593.       with ColorDialog do
  2594.         for I := 0 to CustomColors.Count - 1 do
  2595.         begin
  2596.           S := CustomColors.Strings[I];
  2597.           P := Pos('=', S);
  2598.           if P <> 0 then
  2599.           begin
  2600.             S := Copy(S, 1, P - 1);
  2601.             IniFile.WriteString(SCustomColors, S,
  2602.               CustomColors.Values[S]);
  2603.           end;
  2604.         end;
  2605.   end;
  2606.  
  2607. begin
  2608.   IniFile := nil;
  2609.   ColorDialog := TColorDialog.Create(Application);
  2610.   try
  2611.     GetCustomColors;
  2612.     ColorDialog.Color := GetOrdValue;
  2613.     ColorDialog.HelpContext := hcDColorEditor;
  2614.     ColorDialog.Options := [cdShowHelp];
  2615.     if ColorDialog.Execute then SetOrdValue(ColorDialog.Color);
  2616.     SaveCustomColors;
  2617.   finally
  2618.     IniFile.Free;
  2619.     ColorDialog.Free;
  2620.   end;
  2621. end;
  2622.  
  2623. function TColorProperty.GetAttributes: TPropertyAttributes;
  2624. begin
  2625.   Result := [paMultiSelect, paDialog, paValueList, paRevertable];
  2626. end;
  2627.  
  2628. function TColorProperty.GetValue: string;
  2629. begin
  2630.   Result := ColorToString(TColor(GetOrdValue));
  2631. end;
  2632.  
  2633. procedure TColorProperty.GetValues(Proc: TGetStrProc);
  2634. begin
  2635.   GetColorValues(Proc);
  2636. end;
  2637.  
  2638. procedure TColorProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  2639.   ASelected: Boolean);
  2640. begin
  2641.   if GetVisualValue <> '' then
  2642.     ListDrawValue(GetVisualValue, ACanvas, ARect, True{ASelected})
  2643.   else
  2644.     inherited PropDrawValue(ACanvas, ARect, ASelected);
  2645. end;
  2646.  
  2647. procedure TColorProperty.ListDrawValue(const Value: string; ACanvas: TCanvas;
  2648.   const ARect: TRect; ASelected: Boolean);
  2649.   function ColorToBorderColor(AColor: TColor): TColor;
  2650.   type
  2651.     TColorQuad = record
  2652.       Red,
  2653.       Green,
  2654.       Blue,
  2655.       Alpha: Byte;
  2656.     end;
  2657.   begin
  2658.     if (TColorQuad(AColor).Red > 192) or
  2659.        (TColorQuad(AColor).Green > 192) or
  2660.        (TColorQuad(AColor).Blue > 192) then
  2661.       Result := clBlack
  2662.     else if ASelected then
  2663.       Result := clWhite
  2664.     else
  2665.       Result := AColor;
  2666.   end;
  2667. var
  2668.   vRight: Integer;
  2669.   vOldPenColor, vOldBrushColor: TColor;
  2670. begin
  2671.   vRight := (ARect.Bottom - ARect.Top) {* 2} + ARect.Left;
  2672.   with ACanvas do
  2673.   try
  2674.     // save off things
  2675.     vOldPenColor := Pen.Color;
  2676.     vOldBrushColor := Brush.Color;
  2677.  
  2678.     // frame things
  2679.     Pen.Color := Brush.Color;
  2680.     Rectangle(ARect.Left, ARect.Top, vRight, ARect.Bottom);
  2681.  
  2682.     // set things up and do the work
  2683.     Brush.Color := StringToColor(Value);
  2684.     Pen.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
  2685.     Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, ARect.Bottom - 1);
  2686.  
  2687.     // restore the things we twiddled with
  2688.     Brush.Color := vOldBrushColor;
  2689.     Pen.Color := vOldPenColor;
  2690.   finally
  2691.     inherited ListDrawValue(Value, ACanvas,
  2692.                             Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom),
  2693.                             ASelected);
  2694.   end;
  2695. end;
  2696.  
  2697. procedure TColorProperty.ListMeasureWidth(const Value: string;
  2698.   ACanvas: TCanvas; var AWidth: Integer);
  2699. begin
  2700.   AWidth := AWidth + ACanvas.TextHeight('M') {* 2};
  2701. end;
  2702.  
  2703. procedure TColorProperty.SetValue(const Value: string);
  2704. var
  2705.   NewValue: Longint;
  2706. begin
  2707.   if IdentToColor(Value, NewValue) then
  2708.     SetOrdValue(NewValue)
  2709.   else
  2710.     inherited SetValue(Value);
  2711. end;
  2712.  
  2713. { TBrushStyleProperty }
  2714.  
  2715. procedure TBrushStyleProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  2716.   ASelected: Boolean);
  2717. begin
  2718.   if GetVisualValue <> '' then
  2719.     ListDrawValue(GetVisualValue, ACanvas, ARect, ASelected)
  2720.   else
  2721.     inherited PropDrawValue(ACanvas, ARect, ASelected);
  2722. end;
  2723.  
  2724. procedure TBrushStyleProperty.ListDrawValue(const Value: string;
  2725.   ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  2726. var
  2727.   vRight: Integer;
  2728.   vOldPenColor, vOldBrushColor: TColor;
  2729.   vOldBrushStyle: TBrushStyle;
  2730. begin
  2731.   vRight := (ARect.Bottom - ARect.Top) {* 2} + ARect.Left;
  2732.   with ACanvas do
  2733.   try
  2734.     // save off things
  2735.     vOldPenColor := Pen.Color;
  2736.     vOldBrushColor := Brush.Color;
  2737.     vOldBrushStyle := Brush.Style;
  2738.  
  2739.     // frame things
  2740.     Pen.Color := Brush.Color;
  2741.     Brush.Color := clWindow;
  2742.     Rectangle(ARect.Left, ARect.Top, vRight, ARect.Bottom);
  2743.  
  2744.     // set things up
  2745.     Pen.Color := clWindowText;
  2746.     Brush.Style := TBrushStyle(GetEnumValue(GetPropInfo^.PropType^, Value));
  2747.  
  2748.     // bsClear hack
  2749.     if Brush.Style = bsClear then
  2750.     begin
  2751.       Brush.Color := clWindow;
  2752.       Brush.Style := bsSolid;
  2753.     end
  2754.     else
  2755.       Brush.Color := clWindowText;
  2756.  
  2757.     // ok on with the show
  2758.     Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, ARect.Bottom - 1);
  2759.  
  2760.     // restore the things we twiddled with
  2761.     Brush.Color := vOldBrushColor;
  2762.     Brush.Style := vOldBrushStyle;
  2763.     Pen.Color := vOldPenColor;
  2764.   finally
  2765.     inherited ListDrawValue(Value, ACanvas,
  2766.                             Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom),
  2767.                             ASelected);
  2768.   end;
  2769. end;
  2770.  
  2771. procedure TBrushStyleProperty.ListMeasureWidth(const Value: string;
  2772.   ACanvas: TCanvas; var AWidth: Integer);
  2773. begin
  2774.   AWidth := AWidth + ACanvas.TextHeight('A') {* 2};
  2775. end;
  2776.  
  2777. { TPenStyleProperty }
  2778.  
  2779. procedure TPenStyleProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  2780.   ASelected: Boolean);
  2781. begin
  2782.   if GetVisualValue <> '' then
  2783.     ListDrawValue(GetVisualValue, ACanvas, ARect, ASelected)
  2784.   else
  2785.     inherited PropDrawValue(ACanvas, ARect, ASelected);
  2786. end;
  2787.  
  2788. procedure TPenStyleProperty.ListDrawValue(const Value: string;
  2789.   ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  2790. var
  2791.   vRight, vTop: Integer;
  2792.   vOldPenColor, vOldBrushColor: TColor;
  2793.   vOldPenStyle: TPenStyle;
  2794. begin
  2795.   vRight := (ARect.Bottom - ARect.Top) * 2 + ARect.Left;
  2796.   vTop := (ARect.Bottom - ARect.Top) div 2 + ARect.Top;
  2797.   with ACanvas do
  2798.   try
  2799.     // save off things
  2800.     vOldPenColor := Pen.Color;
  2801.     vOldBrushColor := Brush.Color;
  2802.     vOldPenStyle := Pen.Style;
  2803.  
  2804.     // frame things
  2805.     Pen.Color := Brush.Color;
  2806.     Rectangle(ARect.Left, ARect.Top, vRight, ARect.Bottom);
  2807.  
  2808.     // white out the background
  2809.     Pen.Color := clWindowText;
  2810.     Brush.Color := clWindow;
  2811.     Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, ARect.Bottom - 1);
  2812.  
  2813.     // set thing up and do work
  2814.     Pen.Color := clWindowText;
  2815.     Pen.Style := TPenStyle(GetEnumValue(GetPropInfo^.PropType^, Value));
  2816.     MoveTo(ARect.Left + 1, vTop);
  2817.     LineTo(vRight - 1, vTop);
  2818.     MoveTo(ARect.Left + 1, vTop + 1);
  2819.     LineTo(vRight - 1, vTop + 1);
  2820.  
  2821.     // restore the things we twiddled with
  2822.     Brush.Color := vOldBrushColor;
  2823.     Pen.Style := vOldPenStyle;
  2824.     Pen.Color := vOldPenColor;
  2825.   finally
  2826.     inherited ListDrawValue(Value, ACanvas,
  2827.                             Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom),
  2828.                             ASelected);
  2829.   end;
  2830. end;
  2831.  
  2832. procedure TPenStyleProperty.ListMeasureWidth(const Value: string;
  2833.   ACanvas: TCanvas; var AWidth: Integer);
  2834. begin
  2835.   AWidth := AWidth + ACanvas.TextHeight('X') * 2;
  2836. end;
  2837.  
  2838. { TCursorProperty }
  2839.  
  2840. function TCursorProperty.GetAttributes: TPropertyAttributes;
  2841. begin
  2842.   Result := [paMultiSelect, paValueList, paSortList, paRevertable];
  2843. end;
  2844.  
  2845. function TCursorProperty.GetValue: string;
  2846. begin
  2847.   Result := CursorToString(TCursor(GetOrdValue));
  2848. end;
  2849.  
  2850. procedure TCursorProperty.GetValues(Proc: TGetStrProc);
  2851. begin
  2852.   GetCursorValues(Proc);
  2853. end;
  2854.  
  2855. procedure TCursorProperty.SetValue(const Value: string);
  2856. var
  2857.   NewValue: Longint;
  2858. begin
  2859.   if IdentToCursor(Value, NewValue) then
  2860.     SetOrdValue(NewValue)
  2861.   else inherited SetValue(Value);
  2862. end;
  2863.  
  2864. procedure TCursorProperty.ListDrawValue(const Value: string;
  2865.   ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  2866. var
  2867.   vRight: Integer;
  2868.   CursorIndex: Integer;
  2869.   CursorHandle: THandle;
  2870. begin
  2871.   vRight := ARect.Left + GetSystemMetrics(SM_CXCURSOR) + 4;
  2872.   with ACanvas do
  2873.   try
  2874.     if not IdentToCursor(Value, CursorIndex) then
  2875.       CursorIndex := StrToInt(Value);
  2876.     ACanvas.FillRect(ARect);
  2877.     CursorHandle := Screen.Cursors[CursorIndex];
  2878.     if CursorHandle <> 0 then
  2879.       DrawIconEx(ACanvas.Handle, ARect.Left + 2, ARect.Top + 2, CursorHandle,
  2880.         0, 0, 0, 0, DI_NORMAL or DI_DEFAULTSIZE);
  2881.   finally
  2882.     inherited ListDrawValue(Value, ACanvas,
  2883.                             Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom),
  2884.                             ASelected);
  2885.   end;
  2886. end;
  2887.  
  2888. procedure TCursorProperty.ListMeasureWidth(const Value: string;
  2889.   ACanvas: TCanvas; var AWidth: Integer);
  2890. begin
  2891.   AWidth := AWidth + GetSystemMetrics(SM_CXCURSOR) + 4;
  2892. end;
  2893.  
  2894. procedure TCursorProperty.ListMeasureHeight(const Value: string;
  2895.   ACanvas: TCanvas; var AHeight: Integer);
  2896. begin
  2897.   AHeight := Max(ACanvas.TextHeight('Wg'), GetSystemMetrics(SM_CYCURSOR) + 4);
  2898. end;
  2899.  
  2900. { TFontProperty }
  2901.  
  2902. procedure TFontProperty.Edit;
  2903. var
  2904.   FontDialog: TFontDialog;
  2905. begin
  2906.   FontDialog := TFontDialog.Create(Application);
  2907.   try
  2908.     FontDialog.Font := TFont(GetOrdValue);
  2909.     FontDialog.HelpContext := hcDFontEditor;
  2910.     FontDialog.Options := FontDialog.Options + [fdShowHelp, fdForceFontExist];
  2911.     if FontDialog.Execute then SetOrdValue(Longint(FontDialog.Font));
  2912.   finally
  2913.     FontDialog.Free;
  2914.   end;
  2915. end;
  2916.  
  2917. function TFontProperty.GetAttributes: TPropertyAttributes;
  2918. begin
  2919.   Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
  2920. end;
  2921.  
  2922. { TModalResultProperty }
  2923.  
  2924. const
  2925.   ModalResults: array[mrNone..mrYesToAll] of string = (
  2926.     'mrNone',
  2927.     'mrOk',
  2928.     'mrCancel',
  2929.     'mrAbort',
  2930.     'mrRetry',
  2931.     'mrIgnore',
  2932.     'mrYes',
  2933.     'mrNo',
  2934.     'mrAll',
  2935.     'mrNoToAll',
  2936.     'mrYesToAll');
  2937.  
  2938. function TModalResultProperty.GetAttributes: TPropertyAttributes;
  2939. begin
  2940.   Result := [paMultiSelect, paValueList, paRevertable];
  2941. end;
  2942.  
  2943. function TModalResultProperty.GetValue: string;
  2944. var
  2945.   CurValue: Longint;
  2946. begin
  2947.   CurValue := GetOrdValue;
  2948.   case CurValue of
  2949.     Low(ModalResults)..High(ModalResults):
  2950.       Result := ModalResults[CurValue];
  2951.   else
  2952.     Result := IntToStr(CurValue);
  2953.   end;
  2954. end;
  2955.  
  2956. procedure TModalResultProperty.GetValues(Proc: TGetStrProc);
  2957. var
  2958.   I: Integer;
  2959. begin
  2960.   for I := Low(ModalResults) to High(ModalResults) do Proc(ModalResults[I]);
  2961. end;
  2962.  
  2963. procedure TModalResultProperty.SetValue(const Value: string);
  2964. var
  2965.   I: Integer;
  2966. begin
  2967.   if Value = '' then
  2968.   begin
  2969.     SetOrdValue(0);
  2970.     Exit;
  2971.   end;
  2972.   for I := Low(ModalResults) to High(ModalResults) do
  2973.     if CompareText(ModalResults[I], Value) = 0 then
  2974.     begin
  2975.       SetOrdValue(I);
  2976.       Exit;
  2977.     end;
  2978.   inherited SetValue(Value);
  2979. end;
  2980.  
  2981. { TShortCutProperty }
  2982.  
  2983. const
  2984.   ShortCuts: array[0..108] of TShortCut = (
  2985.     scNone,
  2986.     Byte('A') or scCtrl,
  2987.     Byte('B') or scCtrl,
  2988.     Byte('C') or scCtrl,
  2989.     Byte('D') or scCtrl,
  2990.     Byte('E') or scCtrl,
  2991.     Byte('F') or scCtrl,
  2992.     Byte('G') or scCtrl,
  2993.     Byte('H') or scCtrl,
  2994.     Byte('I') or scCtrl,
  2995.     Byte('J') or scCtrl,
  2996.     Byte('K') or scCtrl,
  2997.     Byte('L') or scCtrl,
  2998.     Byte('M') or scCtrl,
  2999.     Byte('N') or scCtrl,
  3000.     Byte('O') or scCtrl,
  3001.     Byte('P') or scCtrl,
  3002.     Byte('Q') or scCtrl,
  3003.     Byte('R') or scCtrl,
  3004.     Byte('S') or scCtrl,
  3005.     Byte('T') or scCtrl,
  3006.     Byte('U') or scCtrl,
  3007.     Byte('V') or scCtrl,
  3008.     Byte('W') or scCtrl,
  3009.     Byte('X') or scCtrl,
  3010.     Byte('Y') or scCtrl,
  3011.     Byte('Z') or scCtrl,
  3012.     Byte('A') or scCtrl or scAlt,
  3013.     Byte('B') or scCtrl or scAlt,
  3014.     Byte('C') or scCtrl or scAlt,
  3015.     Byte('D') or scCtrl or scAlt,
  3016.     Byte('E') or scCtrl or scAlt,
  3017.     Byte('F') or scCtrl or scAlt,
  3018.     Byte('G') or scCtrl or scAlt,
  3019.     Byte('H') or scCtrl or scAlt,
  3020.     Byte('I') or scCtrl or scAlt,
  3021.     Byte('J') or scCtrl or scAlt,
  3022.     Byte('K') or scCtrl or scAlt,
  3023.     Byte('L') or scCtrl or scAlt,
  3024.     Byte('M') or scCtrl or scAlt,
  3025.     Byte('N') or scCtrl or scAlt,
  3026.     Byte('O') or scCtrl or scAlt,
  3027.     Byte('P') or scCtrl or scAlt,
  3028.     Byte('Q') or scCtrl or scAlt,
  3029.     Byte('R') or scCtrl or scAlt,
  3030.     Byte('S') or scCtrl or scAlt,
  3031.     Byte('T') or scCtrl or scAlt,
  3032.     Byte('U') or scCtrl or scAlt,
  3033.     Byte('V') or scCtrl or scAlt,
  3034.     Byte('W') or scCtrl or scAlt,
  3035.     Byte('X') or scCtrl or scAlt,
  3036.     Byte('Y') or scCtrl or scAlt,
  3037.     Byte('Z') or scCtrl or scAlt,
  3038.     VK_F1,
  3039.     VK_F2,
  3040.     VK_F3,
  3041.     VK_F4,
  3042.     VK_F5,
  3043.     VK_F6,
  3044.     VK_F7,
  3045.     VK_F8,
  3046.     VK_F9,
  3047.     VK_F10,
  3048.     VK_F11,
  3049.     VK_F12,
  3050.     VK_F1 or scCtrl,
  3051.     VK_F2 or scCtrl,
  3052.     VK_F3 or scCtrl,
  3053.     VK_F4 or scCtrl,
  3054.     VK_F5 or scCtrl,
  3055.     VK_F6 or scCtrl,
  3056.     VK_F7 or scCtrl,
  3057.     VK_F8 or scCtrl,
  3058.     VK_F9 or scCtrl,
  3059.     VK_F10 or scCtrl,
  3060.     VK_F11 or scCtrl,
  3061.     VK_F12 or scCtrl,
  3062.     VK_F1 or scShift,
  3063.     VK_F2 or scShift,
  3064.     VK_F3 or scShift,
  3065.     VK_F4 or scShift,
  3066.     VK_F5 or scShift,
  3067.     VK_F6 or scShift,
  3068.     VK_F7 or scShift,
  3069.     VK_F8 or scShift,
  3070.     VK_F9 or scShift,
  3071.     VK_F10 or scShift,
  3072.     VK_F11 or scShift,
  3073.     VK_F12 or scShift,
  3074.     VK_F1 or scShift or scCtrl,
  3075.     VK_F2 or scShift or scCtrl,
  3076.     VK_F3 or scShift or scCtrl,
  3077.     VK_F4 or scShift or scCtrl,
  3078.     VK_F5 or scShift or scCtrl,
  3079.     VK_F6 or scShift or scCtrl,
  3080.     VK_F7 or scShift or scCtrl,
  3081.     VK_F8 or scShift or scCtrl,
  3082.     VK_F9 or scShift or scCtrl,
  3083.     VK_F10 or scShift or scCtrl,
  3084.     VK_F11 or scShift or scCtrl,
  3085.     VK_F12 or scShift or scCtrl,
  3086.     VK_INSERT,
  3087.     VK_INSERT or scShift,
  3088.     VK_INSERT or scCtrl,
  3089.     VK_DELETE,
  3090.     VK_DELETE or scShift,
  3091.     VK_DELETE or scCtrl,
  3092.     VK_BACK or scAlt,
  3093.     VK_BACK or scShift or scAlt);
  3094.  
  3095. function TShortCutProperty.GetAttributes: TPropertyAttributes;
  3096. begin
  3097.   Result := [paMultiSelect, paValueList, paRevertable];
  3098. end;
  3099.  
  3100. function TShortCutProperty.GetValue: string;
  3101. var
  3102.   CurValue: TShortCut;
  3103. begin
  3104.   CurValue := GetOrdValue;
  3105.   if CurValue = scNone then
  3106.     Result := srNone else
  3107.     Result := ShortCutToText(CurValue);
  3108. end;
  3109.  
  3110. procedure TShortCutProperty.GetValues(Proc: TGetStrProc);
  3111. var
  3112.   I: Integer;
  3113. begin
  3114.   Proc(srNone);
  3115.   for I := 1 to High(ShortCuts) do Proc(ShortCutToText(ShortCuts[I]));
  3116. end;
  3117.  
  3118. procedure TShortCutProperty.SetValue(const Value: string);
  3119. var
  3120.   NewValue: TShortCut;
  3121. begin
  3122.   NewValue := 0;
  3123.   if (Value <> '') and (AnsiCompareText(Value, srNone) <> 0) then
  3124.   begin
  3125.     NewValue := TextToShortCut(Value);
  3126.     if NewValue = 0 then
  3127.       raise EPropertyError.CreateRes(@SInvalidPropertyValue);
  3128.   end;
  3129.   SetOrdValue(NewValue);
  3130. end;
  3131.  
  3132. { TTabOrderProperty }
  3133.  
  3134. function TTabOrderProperty.GetAttributes: TPropertyAttributes;
  3135. begin
  3136.   Result := [];
  3137. end;
  3138.  
  3139. { TCaptionProperty }
  3140.  
  3141. function TCaptionProperty.GetAttributes: TPropertyAttributes;
  3142. begin
  3143.   Result := [paMultiSelect, paAutoUpdate, paRevertable];
  3144. end;
  3145.  
  3146. { TDateProperty }
  3147.  
  3148. function TDateProperty.GetAttributes: TPropertyAttributes;
  3149. begin
  3150.   Result := [paMultiSelect, paRevertable];
  3151. end;
  3152.  
  3153. function TDateProperty.GetValue: string;
  3154. var
  3155.   DT: TDateTime;
  3156. begin
  3157.   DT := GetFloatValue;
  3158.   if DT = 0.0 then Result := '' else
  3159.   Result := DateToStr(DT);
  3160. end;
  3161.  
  3162. procedure TDateProperty.SetValue(const Value: string);
  3163. var
  3164.   DT: TDateTime;
  3165. begin
  3166.   if Value = '' then DT := 0.0
  3167.   else DT := StrToDate(Value);
  3168.   SetFloatValue(DT);
  3169. end;
  3170.  
  3171. { TTimeProperty }
  3172.  
  3173. function TTimeProperty.GetAttributes: TPropertyAttributes;
  3174. begin
  3175.   Result := [paMultiSelect, paRevertable];
  3176. end;
  3177.  
  3178. function TTimeProperty.GetValue: string;
  3179. var
  3180.   DT: TDateTime;
  3181. begin
  3182.   DT := GetFloatValue;
  3183.   if DT = 0.0 then Result := '' else
  3184.   Result := TimeToStr(DT);
  3185. end;
  3186.  
  3187. procedure TTimeProperty.SetValue(const Value: string);
  3188. var
  3189.   DT: TDateTime;
  3190. begin
  3191.   if Value = '' then DT := 0.0
  3192.   else DT := StrToTime(Value);
  3193.   SetFloatValue(DT);
  3194. end;
  3195.  
  3196. function TDateTimeProperty.GetAttributes: TPropertyAttributes;
  3197. begin
  3198.   Result := [paMultiSelect, paRevertable];
  3199. end;
  3200.  
  3201. function TDateTimeProperty.GetValue: string;
  3202. var
  3203.   DT: TDateTime;
  3204. begin
  3205.   DT := GetFloatValue;
  3206.   if DT = 0.0 then Result := '' else
  3207.   Result := DateTimeToStr(DT);
  3208. end;
  3209.  
  3210. procedure TDateTimeProperty.SetValue(const Value: string);
  3211. var
  3212.   DT: TDateTime;
  3213. begin
  3214.   if Value = '' then DT := 0.0
  3215.   else DT := StrToDateTime(Value);
  3216.   SetFloatValue(DT);
  3217. end;
  3218.  
  3219. { TPropInfoList }
  3220.  
  3221. type
  3222.   TPropInfoList = class
  3223.   private
  3224.     FList: PPropList;
  3225.     FCount: Integer;
  3226.     FSize: Integer;
  3227.     function Get(Index: Integer): PPropInfo;
  3228.   public
  3229.     constructor Create(Instance: TPersistent; Filter: TTypeKinds);
  3230.     destructor Destroy; override;
  3231.     function Contains(P: PPropInfo): Boolean;
  3232.     procedure Delete(Index: Integer);
  3233.     procedure Intersect(List: TPropInfoList);
  3234.     property Count: Integer read FCount;
  3235.     property Items[Index: Integer]: PPropInfo read Get; default;
  3236.   end;
  3237.  
  3238. constructor TPropInfoList.Create(Instance: TPersistent; Filter: TTypeKinds);
  3239. begin
  3240.   FCount := GetPropList(Instance.ClassInfo, Filter, nil);
  3241.   FSize := FCount * SizeOf(Pointer);
  3242.   GetMem(FList, FSize);
  3243.   GetPropList(Instance.ClassInfo, Filter, FList);
  3244. end;
  3245.  
  3246. destructor TPropInfoList.Destroy;
  3247. begin
  3248.   if FList <> nil then FreeMem(FList, FSize);
  3249. end;
  3250.  
  3251. function TPropInfoList.Contains(P: PPropInfo): Boolean;
  3252. var
  3253.   I: Integer;
  3254. begin
  3255.   for I := 0 to FCount - 1 do
  3256.     with FList^[I]^ do
  3257.       if (PropType^ = P^.PropType^) and (CompareText(Name, P^.Name) = 0) then
  3258.       begin
  3259.         Result := True;
  3260.         Exit;
  3261.       end;
  3262.   Result := False;
  3263. end;
  3264.  
  3265. procedure TPropInfoList.Delete(Index: Integer);
  3266. begin
  3267.   Dec(FCount);
  3268.   if Index < FCount then
  3269.     Move(FList^[Index + 1], FList^[Index],
  3270.       (FCount - Index) * SizeOf(Pointer));
  3271. end;
  3272.  
  3273. function TPropInfoList.Get(Index: Integer): PPropInfo;
  3274. begin
  3275.   Result := FList^[Index];
  3276. end;
  3277.  
  3278. procedure TPropInfoList.Intersect(List: TPropInfoList);
  3279. var
  3280.   I: Integer;
  3281. begin
  3282.   for I := FCount - 1 downto 0 do
  3283.     if not List.Contains(FList^[I]) then Delete(I);
  3284. end;
  3285.  
  3286. { GetComponentProperties }
  3287.  
  3288. procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  3289.   const PropertyName: string; EditorClass: TPropertyEditorClass);
  3290. var
  3291.   P: PPropertyClassRec;
  3292. begin
  3293.   if PropertyClassList = nil then
  3294.     PropertyClassList := TList.Create;
  3295.   New(P);
  3296.   P.Group := CurrentGroup;
  3297.   P.PropertyType := PropertyType;
  3298.   P.ComponentClass := ComponentClass;
  3299.   P.PropertyName := '';
  3300.   if Assigned(ComponentClass) then P^.PropertyName := PropertyName;
  3301.   P.EditorClass := EditorClass;
  3302.   PropertyClassList.Insert(0, P);
  3303. end;
  3304.  
  3305. procedure RegisterPropertyMapper(Mapper: TPropertyMapperFunc);
  3306. var
  3307.   P: PPropertyMapperRec;
  3308. begin
  3309.   if PropertyMapperList = nil then
  3310.     PropertyMapperList := TList.Create;
  3311.   New(P);
  3312.   P^.Group := CurrentGroup;
  3313.   P^.Mapper := Mapper;
  3314.   PropertyMapperList.Insert(0, P);
  3315. end;
  3316.  
  3317. function GetEditorClass(PropInfo: PPropInfo;
  3318.   Obj: TPersistent): TPropertyEditorClass;
  3319. var
  3320.   PropType: PTypeInfo;
  3321.   P, C: PPropertyClassRec;
  3322.   I: Integer;
  3323. begin
  3324.   if PropertyMapperList <> nil then
  3325.   begin
  3326.     for I := 0 to PropertyMapperList.Count -1 do
  3327.       with PPropertyMapperRec(PropertyMapperList[I])^ do
  3328.       begin
  3329.         Result := Mapper(Obj, PropInfo);
  3330.         if Result <> nil then Exit;
  3331.       end;
  3332.   end;
  3333.   PropType := PropInfo^.PropType^;
  3334.   I := 0;
  3335.   C := nil;
  3336.   while I < PropertyClassList.Count do
  3337.   begin
  3338.     P := PropertyClassList[I];
  3339.  
  3340.     if ((P^.PropertyType = PropType) or
  3341.          ((P^.PropertyType^.Kind = PropType.Kind) and
  3342.           (P^.PropertyType^.Name = PropType.Name)
  3343.          )
  3344.        ) or
  3345.        ( (PropType^.Kind = tkClass) and
  3346.          (P^.PropertyType^.Kind = tkClass) and
  3347.          GetTypeData(PropType)^.ClassType.InheritsFrom(GetTypeData(P^.PropertyType)^.ClassType)
  3348.        ) then
  3349.       if ((P^.ComponentClass = nil) or (Obj.InheritsFrom(P^.ComponentClass))) and
  3350.          ((P^.PropertyName = '') or (CompareText(PropInfo^.Name, P^.PropertyName) = 0)) then
  3351.         if (C = nil) or   // see if P is better match than C
  3352.            ((C^.ComponentClass = nil) and (P^.ComponentClass <> nil)) or
  3353.            ((C^.PropertyName = '') and (P^.PropertyName <> ''))
  3354.            or  // P's proptype match is exact, but C's isn't
  3355.            ((C^.PropertyType <> PropType) and (P^.PropertyType = PropType))
  3356.            or  // P's proptype is more specific than C's proptype
  3357.            ((P^.PropertyType <> C^.PropertyType) and
  3358.             (P^.PropertyType^.Kind = tkClass) and
  3359.             (C^.PropertyType^.Kind = tkClass) and
  3360.             GetTypeData(P^.PropertyType)^.ClassType.InheritsFrom(
  3361.               GetTypeData(C^.PropertyType)^.ClassType))
  3362.            or // P's component class is more specific than C's component class
  3363.            ((P^.ComponentClass <> nil) and (C^.ComponentClass <> nil) and
  3364.             (P^.ComponentClass <> C^.ComponentClass) and
  3365.             (P^.ComponentClass.InheritsFrom(C^.ComponentClass))) then
  3366.           C := P;
  3367.     Inc(I);
  3368.   end;
  3369.   if C <> nil then
  3370.     Result := C^.EditorClass else
  3371.     Result := PropClassMap[PropType^.Kind];
  3372. end;
  3373.  
  3374. procedure GetComponentProperties(Components: TDesignerSelectionList;
  3375.   Filter: TTypeKinds; Designer: IFormDesigner; Proc: TGetPropEditProc);
  3376. var
  3377.   I, J, CompCount: Integer;
  3378.   CompType: TClass;
  3379.   Candidates: TPropInfoList;
  3380.   PropLists: TList;
  3381.   Editor: TPropertyEditor;
  3382.   EdClass: TPropertyEditorClass;
  3383.   PropInfo: PPropInfo;
  3384.   AddEditor: Boolean;
  3385.   Obj: TPersistent;
  3386. begin
  3387.   if (Components = nil) or (Components.Count = 0) then Exit;
  3388.   CompCount := Components.Count;
  3389.   Obj := Components[0];
  3390.   CompType := Components[0].ClassType;
  3391.   Candidates := TPropInfoList.Create(Components[0], Filter);
  3392.   try
  3393.     for I := Candidates.Count - 1 downto 0 do
  3394.     begin
  3395.       PropInfo := Candidates[I];
  3396.       EdClass := GetEditorClass(PropInfo, Obj);
  3397.       if EdClass = nil then
  3398.         Candidates.Delete(I)
  3399.       else
  3400.       begin
  3401.         Editor := EdClass.Create(Designer, 1);
  3402.         try
  3403.           Editor.SetPropEntry(0, Components[0], PropInfo);
  3404.           Editor.Initialize;
  3405.           with PropInfo^ do
  3406.             if (GetProc = nil) or ((PropType^.Kind <> tkClass) and
  3407.               (SetProc = nil)) or ((CompCount > 1) and
  3408.               not (paMultiSelect in Editor.GetAttributes)) or
  3409.               not Editor.ValueAvailable then
  3410.               Candidates.Delete(I);
  3411.         finally
  3412.           Editor.Free;
  3413.         end;
  3414.       end;
  3415.     end;
  3416.     PropLists := TList.Create;
  3417.     try
  3418.       PropLists.Capacity := CompCount;
  3419.       for I := 0 to CompCount - 1 do
  3420.         PropLists.Add(TPropInfoList.Create(Components[I], Filter));
  3421.       for I := 0 to CompCount - 1 do
  3422.         Candidates.Intersect(TPropInfoList(PropLists[I]));
  3423.       for I := 0 to CompCount - 1 do
  3424.         TPropInfoList(PropLists[I]).Intersect(Candidates);
  3425.       for I := 0 to Candidates.Count - 1 do
  3426.       begin
  3427.         EdClass := GetEditorClass(Candidates[I], Obj);
  3428.         if EdClass = nil then Continue;
  3429.         Editor := EdClass.Create(Designer, CompCount);
  3430.         try
  3431.           AddEditor := True;
  3432.           for J := 0 to CompCount - 1 do
  3433.           begin
  3434.             if (Components[J].ClassType <> CompType) and
  3435.               (GetEditorClass(TPropInfoList(PropLists[J])[I],
  3436.                 Components[J]) <> Editor.ClassType) then
  3437.             begin
  3438.               AddEditor := False;
  3439.               Break;
  3440.             end;
  3441.             Editor.SetPropEntry(J, Components[J],
  3442.               TPropInfoList(PropLists[J])[I]);
  3443.           end;
  3444.         except
  3445.           Editor.Free;
  3446.           raise;
  3447.         end;
  3448.         if AddEditor then
  3449.         begin
  3450.           Editor.Initialize;
  3451.           if Editor.ValueAvailable then
  3452.             Proc(Editor) else
  3453.             Editor.Free;
  3454.         end
  3455.         else Editor.Free;
  3456.       end;
  3457.     finally
  3458.       for I := 0 to PropLists.Count - 1 do TPropInfoList(PropLists[I]).Free;
  3459.       PropLists.Free;
  3460.     end;
  3461.   finally
  3462.     Candidates.Free;
  3463.   end;
  3464. end;
  3465.  
  3466. { RegisterComponentEditor }
  3467.  
  3468. type
  3469.   PComponentClassRec = ^TComponentClassRec;
  3470.   TComponentClassRec = record
  3471.     Group: Integer;
  3472.     ComponentClass: TComponentClass;
  3473.     EditorClass: TComponentEditorClass;
  3474.   end;
  3475.  
  3476. var
  3477.   ComponentClassList: TList = nil;
  3478.  
  3479. procedure RegisterComponentEditor(ComponentClass: TComponentClass;
  3480.   ComponentEditor: TComponentEditorClass);
  3481. var
  3482.   P: PComponentClassRec;
  3483. begin
  3484.   if ComponentClassList = nil then
  3485.     ComponentClassList := TList.Create;
  3486.   New(P);
  3487.   P.Group := CurrentGroup;
  3488.   P.ComponentClass := ComponentClass;
  3489.   P.EditorClass := ComponentEditor;
  3490.   ComponentClassList.Insert(0, P);
  3491. end;
  3492.  
  3493. { GetComponentEditor }
  3494.  
  3495. function GetComponentEditor(Component: TComponent;
  3496.   Designer: IFormDesigner): TComponentEditor;
  3497. var
  3498.   P: PComponentClassRec;
  3499.   I: Integer;
  3500.   ComponentClass: TComponentClass;
  3501.   EditorClass: TComponentEditorClass;
  3502. begin
  3503.   ComponentClass := TComponentClass(TPersistent);
  3504.   EditorClass := TDefaultEditor;
  3505.   for I := 0 to ComponentClassList.Count-1 do
  3506.   begin
  3507.     P := ComponentClassList[I];
  3508.     if (Component is P^.ComponentClass) and
  3509.       (P^.ComponentClass <> ComponentClass) and
  3510.       (P^.ComponentClass.InheritsFrom(ComponentClass)) then
  3511.     begin
  3512.       EditorClass := P^.EditorClass;
  3513.       ComponentClass := P^.ComponentClass;
  3514.     end;
  3515.   end;
  3516.   Result := EditorClass.Create(Component, Designer);
  3517. end;
  3518.  
  3519. { package management }
  3520.  
  3521. var
  3522.   FGroupNotifyList: TList = nil;
  3523.  
  3524. function NewEditorGroup: Integer;
  3525. begin
  3526.   if EditorGroupList = nil then
  3527.     EditorGroupList := TBits.Create;
  3528.   CurrentGroup := EditorGroupList.OpenBit;
  3529.   EditorGroupList[CurrentGroup] := True;
  3530.   Result := CurrentGroup;
  3531. end;
  3532.  
  3533. procedure NotifyGroupChange(AProc: TGroupChangeProc);
  3534. begin
  3535.   UnNotifyGroupChange(AProc);
  3536.   if not Assigned(FGroupNotifyList) then
  3537.     FGroupNotifyList := TList.Create;
  3538.   FGroupNotifyList.Add(@AProc);
  3539. end;
  3540.  
  3541. procedure UnNotifyGroupChange(AProc: TGroupChangeProc);
  3542. begin
  3543.   if Assigned(FGroupNotifyList) then
  3544.     FGroupNotifyList.Remove(@AProc);
  3545. end;
  3546.  
  3547. procedure FreeEditorGroup(Group: Integer);
  3548. var
  3549.   I: Integer;
  3550.   P: PPropertyClassRec;
  3551.   C: PComponentClassRec;
  3552.   M: PPropertyMapperRec;
  3553. begin
  3554.   I := PropertyClassList.Count - 1;
  3555.   while I > -1 do
  3556.   begin
  3557.     P := PropertyClassList[I];
  3558.     if P.Group = Group then
  3559.     begin
  3560.       PropertyClassList.Delete(I);
  3561.       Dispose(P);
  3562.     end;
  3563.     Dec(I);
  3564.   end;
  3565.   I := ComponentClassList.Count - 1;
  3566.   while I > -1 do
  3567.   begin
  3568.     C := ComponentClassList[I];
  3569.     if C.Group = Group then
  3570.     begin
  3571.       ComponentClassList.Delete(I);
  3572.       Dispose(C);
  3573.     end;
  3574.     Dec(I);
  3575.   end;
  3576.   if PropertyMapperList <> nil then
  3577.     for I := PropertyMapperList.Count-1 downto 0 do
  3578.     begin
  3579.       M := PropertyMapperList[I];
  3580.       if M.Group = Group then
  3581.       begin
  3582.         PropertyMapperList.Delete(I);
  3583.         Dispose(M);
  3584.       end;
  3585.     end;
  3586.   if InternalPropertyCategoryList <> nil then
  3587.     InternalPropertyCategoryList.FreeEditorGroup(Group);
  3588.   if Assigned(FreeCustomModulesProc) then
  3589.     FreeCustomModulesProc(Group);
  3590.   if Assigned(FGroupNotifyList) then
  3591.     for I := FGroupNotifyList.Count - 1 downto 0 do
  3592.       TGroupChangeProc(FGroupNotifyList[I])(Group);
  3593.   if (Group >= 0) and (Group < EditorGroupList.Size) then
  3594.     EditorGroupList[Group] := False;
  3595. end;
  3596.  
  3597. { TComponentEditor }
  3598.  
  3599. constructor TComponentEditor.Create(AComponent: TComponent; ADesigner: IFormDesigner);
  3600. begin
  3601.   inherited Create;
  3602.   FComponent := AComponent;
  3603.   FDesigner := ADesigner;
  3604. end;
  3605.  
  3606. procedure TComponentEditor.Edit;
  3607. begin
  3608.   if GetVerbCount > 0 then ExecuteVerb(0);
  3609. end;
  3610.  
  3611. function TComponentEditor.GetIComponent: IComponent;
  3612. begin
  3613.   Result := MakeIComponent(FComponent);
  3614. end;
  3615.  
  3616. function TComponentEditor.GetDesigner: IFormDesigner;
  3617. begin
  3618.   Result := FDesigner;
  3619. end;
  3620.  
  3621. function TComponentEditor.GetVerbCount: Integer;
  3622. begin
  3623.   Result := 0;
  3624. end;
  3625.  
  3626. function TComponentEditor.GetVerb(Index: Integer): string;
  3627. begin
  3628. end;
  3629.  
  3630. procedure TComponentEditor.ExecuteVerb(Index: Integer);
  3631. begin
  3632. end;
  3633.  
  3634. procedure TComponentEditor.Copy;
  3635. begin
  3636. end;
  3637.  
  3638. function TComponentEditor.IsInInlined: Boolean;
  3639. begin
  3640.   Result := csInline in Component.Owner.ComponentState;
  3641. end;
  3642.  
  3643. procedure TComponentEditor.PrepareItem(Index: Integer; const AItem: TMenuItem);
  3644. begin
  3645. end;
  3646.  
  3647. { TDefaultEditor }
  3648.  
  3649. procedure TDefaultEditor.CheckEdit(PropertyEditor: TPropertyEditor);
  3650. var
  3651.   FreeEditor: Boolean;
  3652. begin
  3653.   FreeEditor := True;
  3654.   try
  3655.     if FContinue then EditProperty(PropertyEditor, FContinue, FreeEditor);
  3656.   finally
  3657.     if FreeEditor then PropertyEditor.Free;
  3658.   end;
  3659. end;
  3660.  
  3661. procedure TDefaultEditor.EditProperty(PropertyEditor: TPropertyEditor;
  3662.   var Continue, FreeEditor: Boolean);
  3663. var
  3664.   PropName: string;
  3665.   BestName: string;
  3666.  
  3667.   procedure ReplaceBest;
  3668.   begin
  3669.     FBest.Free;
  3670.     FBest := PropertyEditor;
  3671.     if FFirst = FBest then FFirst := nil;
  3672.     FreeEditor := False;
  3673.   end;
  3674.  
  3675. begin
  3676.   if not Assigned(FFirst) and (PropertyEditor is TMethodProperty) then
  3677.   begin
  3678.     FreeEditor := False;
  3679.     FFirst := PropertyEditor;
  3680.   end;
  3681.   PropName := PropertyEditor.GetName;
  3682.   BestName := '';
  3683.   if Assigned(FBest) then BestName := FBest.GetName;
  3684.   if CompareText(PropName, 'ONCREATE') = 0 then
  3685.     ReplaceBest
  3686.   else if CompareText(BestName, 'ONCREATE') <> 0 then
  3687.     if CompareText(PropName, 'ONCHANGE') = 0 then
  3688.       ReplaceBest
  3689.     else if CompareText(BestName, 'ONCHANGE') <> 0 then
  3690.       if CompareText(PropName, 'ONCLICK') = 0 then
  3691.         ReplaceBest;
  3692. end;
  3693.  
  3694. procedure TDefaultEditor.Edit;
  3695. var
  3696.   Components: TDesignerSelectionList;
  3697. begin
  3698.   Components := TDesignerSelectionList.Create;
  3699.   try
  3700.     FContinue := True;
  3701.     Components.Add(Component);
  3702.     FFirst := nil;
  3703.     FBest := nil;
  3704.     try
  3705.       GetComponentProperties(Components, tkAny, Designer, CheckEdit);
  3706.       if FContinue then
  3707.         if Assigned(FBest) then
  3708.           FBest.Edit
  3709.         else if Assigned(FFirst) then
  3710.           FFirst.Edit;
  3711.     finally
  3712.       FFirst.Free;
  3713.       FBest.Free;
  3714.     end;
  3715.   finally
  3716.     Components.Free;
  3717.   end;
  3718. end;
  3719.  
  3720. { TCustomModule }
  3721.  
  3722. constructor TCustomModule.Create(ARoot: IComponent);
  3723. begin
  3724.   inherited Create;
  3725.   FRoot := ARoot;
  3726. end;
  3727.  
  3728. procedure TCustomModule.ExecuteVerb(Index: Integer);
  3729. begin
  3730. end;
  3731.  
  3732. function TCustomModule.CreateDesignerForm(Designer: IDesigner): TCustomForm;
  3733. begin
  3734.   Result := nil;
  3735. end;
  3736.  
  3737. function TCustomModule.GetAttributes: TCustomModuleAttributes;
  3738. begin
  3739.   Result := [];
  3740. end;
  3741.  
  3742. function TCustomModule.GetVerb(Index: Integer): string;
  3743. begin
  3744.   Result := '';
  3745. end;
  3746.  
  3747. function TCustomModule.GetVerbCount: Integer;
  3748. begin
  3749.   Result := 0;
  3750. end;
  3751.  
  3752. procedure TCustomModule.Saving;
  3753. begin
  3754. end;
  3755.  
  3756. procedure TCustomModule.ValidateComponent(Component: IComponent);
  3757. begin
  3758. end;
  3759.  
  3760. procedure RegisterCustomModule(ComponentBaseClass: TComponentClass;
  3761.   CustomModuleClass: TCustomModuleClass);
  3762. begin
  3763.   if Assigned(RegisterCustomModuleProc) then
  3764.     RegisterCustomModuleProc(CurrentGroup, ComponentBaseClass, CustomModuleClass);
  3765. end;
  3766.  
  3767. function MakeIPersistent(Instance: TPersistent): IPersistent;
  3768. begin
  3769.   if Assigned(MakeIPersistentProc) then
  3770.     Result := MakeIPersistentProc(Instance);
  3771. end;
  3772.  
  3773. function ExtractPersistent(const Intf: IUnknown): TPersistent;
  3774. begin
  3775.   if Intf = nil then
  3776.     Result := nil
  3777.   else
  3778.     Result := (Intf as IImplementation).GetInstance as TPersistent;
  3779. end;
  3780.  
  3781. function TryExtractPersistent(const Intf: IUnknown): TPersistent;
  3782. var
  3783.   Temp: IImplementation;
  3784. begin
  3785.   Result := nil;
  3786.   if (Intf <> nil) and (Intf.QueryInterface(IImplementation, Temp) = 0) and
  3787.     (Temp.GetInstance <> nil) and (Temp.GetInstance is TPersistent) then
  3788.     Result := TPersistent(Temp.GetInstance);
  3789. end;
  3790.  
  3791. function MakeIComponent(Instance: TComponent): IComponent;
  3792. begin
  3793.   if Assigned(MakeIComponentProc) then
  3794.     Result := MakeIComponentProc(Instance);
  3795. end;
  3796.  
  3797. function ExtractComponent(const Intf: IUnknown): TComponent;
  3798. begin
  3799.   if Intf = nil then
  3800.     Result := nil
  3801.   else
  3802.     Result := (Intf as IImplementation).GetInstance as TComponent;
  3803. end;
  3804.  
  3805. function TryExtractComponent(const Intf: IUnknown): TComponent;
  3806. var
  3807.   Temp: TPersistent;
  3808. begin
  3809.   Temp := TryExtractPersistent(Intf);
  3810.   if (Temp <> nil) and (Temp is TComponent) then
  3811.     Result := TComponent(Temp)
  3812.   else
  3813.     Result := nil;
  3814. end;
  3815.  
  3816. type
  3817.  
  3818.   { TSelectionList  -  implements IDesignerSelections }
  3819.  
  3820.   TSelectionList = class(TInterfacedObject, IDesignerSelections)
  3821.   private
  3822.     FList: IInterfaceList;
  3823.   public
  3824.     constructor Create;
  3825.     function Add(const Item: IPersistent): Integer;
  3826.     function Equals(const List: IDesignerSelections): Boolean;
  3827.     function Get(Index: Integer): IPersistent;
  3828.     function GetCount: Integer;
  3829.   end;
  3830.  
  3831. constructor TSelectionList.Create;
  3832. begin
  3833.   inherited Create;
  3834.   FList := TInterfaceList.Create;
  3835. end;
  3836.  
  3837. function TSelectionList.Add(const Item: IPersistent): Integer;
  3838. begin
  3839.   Result := FList.Add(Item);
  3840. end;
  3841.  
  3842. function TSelectionList.Equals(const List: IDesignerSelections): Boolean;
  3843. var
  3844.   I: Integer;
  3845. begin
  3846.   Result := False;
  3847.   if List.Count <> FList.Count then Exit;
  3848.   for I := 0 to List.Count - 1 do if not List[I].Equals(IPersistent(FList[I])) then Exit;
  3849.   Result := True;
  3850. end;
  3851.  
  3852. function TSelectionList.Get(Index: Integer): IPersistent;
  3853. begin
  3854.   Result := IPersistent(FList[Index]);
  3855. end;
  3856.  
  3857. function TSelectionList.GetCount: Integer;
  3858. begin
  3859.   Result := FList.Count;
  3860. end;
  3861.  
  3862. function CreateSelectionList: IDesignerSelections;
  3863. begin
  3864.   Result := TDesignerSelectionList.Create;
  3865. end;
  3866.  
  3867. class function TCustomModule.Nestable: Boolean;
  3868. begin
  3869.   Result := False;
  3870. end;
  3871.  
  3872. procedure TCustomModule.PrepareItem(Index: Integer; const AItem: TMenuItem);
  3873. begin
  3874. end;
  3875.  
  3876. { TPropertyFilter }
  3877.  
  3878. constructor TPropertyFilter.Create(const APropertyName: String;
  3879.   AComponentClass: TClass; APropertyType: PTypeInfo);
  3880. begin
  3881.   inherited Create;
  3882.   if APropertyName <> '' then
  3883.     FMask := TMask.Create(APropertyName);
  3884.   FComponentClass := AComponentClass;
  3885.   FPropertyType := APropertyType;
  3886.   FGroup := CurrentGroup;
  3887. end;
  3888.  
  3889. destructor TPropertyFilter.Destroy;
  3890. begin
  3891.   FMask.Free;
  3892.   inherited Destroy;
  3893. end;
  3894.  
  3895. function TPropertyFilter.Match(const APropertyName: String;
  3896.   AComponentClass: TClass; APropertyType: PTypeInfo): Boolean;
  3897.   function MatchName: Boolean;
  3898.   begin
  3899.     Result := not Assigned(FMask) or
  3900.               FMask.Matches(APropertyName);
  3901.   end;
  3902.   function MatchClass: Boolean;
  3903.   begin
  3904.     Result := Assigned(AComponentClass) and
  3905.               ((ComponentClass = AComponentClass) or
  3906.                (AComponentClass.InheritsFrom(ComponentClass)));
  3907.   end;
  3908.   function MatchType: Boolean;
  3909.   begin
  3910.     Result := Assigned(APropertyType) and
  3911.               ((PropertyType = APropertyType) or
  3912.                ((PropertyType^.Kind = tkClass) and
  3913.                 (APropertyType^.Kind = tkClass) and
  3914.                 GetTypeData(APropertyType)^.ClassType.InheritsFrom(GetTypeData(PropertyType)^.ClassType)));
  3915.   end;
  3916. begin
  3917.   if Assigned(ComponentClass) then
  3918.     if Assigned(PropertyType) then
  3919.       Result := MatchClass and MatchType and MatchName
  3920.     else
  3921.       Result := MatchClass and MatchName
  3922.   else
  3923.     if Assigned(PropertyType) then
  3924.       Result := MatchType and MatchName
  3925.     else
  3926.       Result := MatchName;
  3927. end;
  3928.  
  3929. { TPropertyCategory }
  3930.  
  3931. function TPropertyCategory.Add(AFilter: TPropertyFilter): TPropertyFilter;
  3932. begin
  3933.   FList.Insert(0, AFilter);
  3934.   Result := AFilter;
  3935. end;
  3936.  
  3937. procedure TPropertyCategory.ClearMatches;
  3938. begin
  3939.   FMatchCount := 0;
  3940. end;
  3941.  
  3942. function TPropertyCategory.Count: integer;
  3943. begin
  3944.   Result := FList.Count;
  3945. end;
  3946.  
  3947. constructor TPropertyCategory.Create;
  3948. begin
  3949.   inherited Create;
  3950.   FList := TObjectList.Create;
  3951.   FVisible := True;
  3952.   FEnabled := True;
  3953.   FGroup := CurrentGroup;
  3954. end;
  3955.  
  3956. class function TPropertyCategory.Description: string;
  3957. begin
  3958.   Result := Name;
  3959. end;
  3960.  
  3961. destructor TPropertyCategory.Destroy;
  3962. begin
  3963.   FList.Free;
  3964.   inherited Destroy;
  3965. end;
  3966.  
  3967. procedure TPropertyCategory.FreeEditorGroup(AGroup: Integer);
  3968. var
  3969.   I: Integer;
  3970. begin
  3971.   for I := Count - 1 downto 0 do
  3972.     if Filters[I].FGroup = AGroup then
  3973.       FList.Delete(I);
  3974. end;
  3975.  
  3976. function TPropertyCategory.GetFilter(Index: Integer): TPropertyFilter;
  3977. begin
  3978.   Result := TPropertyFilter(FList[Index])
  3979. end;
  3980.  
  3981. function TPropertyCategory.Match(const APropertyName: String;
  3982.   AComponentClass: TClass; APropertyType: PTypeInfo): Boolean;
  3983. var
  3984.   I: Integer;
  3985.   vPropInfo: PPropInfo;
  3986. begin
  3987.   Result := False;
  3988.  
  3989.   if not Assigned(APropertyType) and
  3990.      Assigned(AComponentClass) then
  3991.   begin
  3992.     vPropInfo := GetPropInfo(PTypeInfo(AComponentClass.ClassInfo), APropertyName);
  3993.     if Assigned(vPropInfo) then
  3994.       APropertyType := vPropInfo.PropType^;
  3995.   end;
  3996.  
  3997.   for I := 0 to Count - 1 do
  3998.     Result := Result or
  3999.               Filters[I].Match(APropertyName, AComponentClass, APropertyType);
  4000.   if Result then
  4001.     Inc(FMatchCount);
  4002. end;
  4003.  
  4004. class function TPropertyCategory.Name: string;
  4005. begin
  4006.   Result := '';
  4007.   raise EPropertyError.CreateRes(@SInvalidCategory);
  4008. end;
  4009.  
  4010. procedure TPropertyCategory.PropDraw(ACanvas: TCanvas; const ARect: TRect;
  4011.   ASelected: Boolean);
  4012. begin
  4013.   with ACanvas do
  4014.     TextRect(ARect, ARect.Left + 1, ARect.Top + 1, Name);
  4015. end;
  4016.  
  4017. { TPropertyCategoryList }
  4018.  
  4019. function TPropertyCategoryList.ChangeVisibility(AMode: TPropertyCategoryVisibleMode): Boolean;
  4020. begin
  4021.   Result := ChangeVisibility(AMode, [nil]);
  4022. end;
  4023.  
  4024. function TPropertyCategoryList.ChangeVisibility(AMode: TPropertyCategoryVisibleMode;
  4025.   const AClasses: array of TClass): Boolean;
  4026. var
  4027.   I: Integer;
  4028.   vChanged: Boolean;
  4029.   procedure ChangeIfNot(ACategory: TPropertyCategory; Value: Boolean);
  4030.   begin
  4031.     if ACategory.Visible <> Value then
  4032.     begin
  4033.       ACategory.Visible := Value;
  4034.       vChanged := True;
  4035.     end;
  4036.   end;
  4037.   function ListedCategory(AClass: TClass): Boolean;
  4038.   var
  4039.     I: Integer;
  4040.   begin
  4041.     Result := False;
  4042.     if AClasses[Low(AClasses)] <> nil then
  4043.       for I := Low(AClasses) to High(AClasses) do
  4044.         if AClass = AClasses[I] then
  4045.         begin
  4046.           Result := True;
  4047.           break;
  4048.         end;
  4049.   end;
  4050. begin
  4051.   vChanged := False;
  4052.   for I := 0 to Count - 1 do
  4053.     case AMode of
  4054.       pcvAll:        ChangeIfNot(Categories[I], True);
  4055.       pcvToggle:     ChangeIfNot(Categories[I], not Categories[I].Visible);
  4056.       pcvNone:       ChangeIfNot(Categories[I], False);
  4057.       pcvNotListed:  ChangeIfNot(Categories[I], not ListedCategory(Categories[I].ClassType));
  4058.       pcvOnlyListed: ChangeIfNot(Categories[I], ListedCategory(Categories[I].ClassType));
  4059.     end;
  4060.   Result := vChanged;
  4061. end;
  4062.  
  4063. procedure TPropertyCategoryList.ClearMatches;
  4064. var
  4065.   I: Integer;
  4066. begin
  4067.   for I := 0 to Count - 1 do
  4068.     Categories[I].ClearMatches;
  4069. end;
  4070.  
  4071. function TPropertyCategoryList.Count: integer;
  4072. begin
  4073.   Result := FList.Count
  4074. end;
  4075.  
  4076. constructor TPropertyCategoryList.Create;
  4077. begin
  4078.   inherited Create;
  4079.   FList := TObjectList.Create;
  4080. end;
  4081.  
  4082. destructor TPropertyCategoryList.Destroy;
  4083. begin
  4084.   FList.Free;
  4085.   inherited Destroy;
  4086. end;
  4087.  
  4088. function TPropertyCategoryList.FindCategory(ACategoryClass: TPropertyCategoryClass): TPropertyCategory;
  4089. var
  4090.   I: Integer;
  4091. begin
  4092.   I := IndexOf(ACategoryClass);
  4093.   if I <> -1 then
  4094.     Result := Categories[I]
  4095.   else
  4096.   begin
  4097.     Result := ACategoryClass.Create;
  4098.     FList.Insert(0, Result);
  4099.   end;
  4100. end;
  4101.  
  4102. procedure TPropertyCategoryList.FreeEditorGroup(AGroup: Integer);
  4103. var
  4104.   I: Integer;
  4105. begin
  4106.   FMiscCategory := nil;
  4107.   for I := Count - 1 downto 0 do
  4108.     if Categories[I].FGroup = AGroup then
  4109.       FList.Delete(I)
  4110.     else
  4111.       Categories[I].FreeEditorGroup(AGroup);
  4112. end;
  4113.  
  4114. function TPropertyCategoryList.GetCategory(Index: Integer): TPropertyCategory;
  4115. begin
  4116.   Result := TPropertyCategory(FList[Index])
  4117. end;
  4118.  
  4119. function TPropertyCategoryList.GetHiddenCategories: string;
  4120. var
  4121.   vStrings: TStringList;
  4122.   I: Integer;
  4123. begin
  4124.   vStrings := TStringList.Create;
  4125.   try
  4126.     for I := 0 to Count - 1 do
  4127.       if not Categories[I].Visible then
  4128.         vStrings.Add(Categories[I].Name);
  4129.   finally
  4130.     Result := vStrings.CommaText;
  4131.     vStrings.Free;
  4132.   end;
  4133. end;
  4134.  
  4135. function TPropertyCategoryList.IndexOf(const ACategoryName: string): Integer;
  4136. var
  4137.   I: Integer;
  4138. begin
  4139.   Result := -1;
  4140.   for I := 0 to Count - 1 do
  4141.     if Categories[I].Name = ACategoryName then
  4142.     begin
  4143.       Result := I;
  4144.       break;
  4145.     end;
  4146. end;
  4147.  
  4148. function TPropertyCategoryList.IndexOf(ACategoryClass: TPropertyCategoryClass): Integer;
  4149. var
  4150.   I: Integer;
  4151. begin
  4152.   Result := -1;
  4153.   for I := 0 to Count - 1 do
  4154.     if Categories[I].ClassType = ACategoryClass then
  4155.     begin
  4156.       Result := I;
  4157.       break;
  4158.     end;
  4159. end;
  4160.  
  4161. function TPropertyCategoryList.Match(const APropertyName: String;
  4162.   AComponentClass: TClass; APropertyType: PTypeInfo = nil): Boolean;
  4163. var
  4164.   I: Integer;
  4165.   vThisMatch, vAnyMatches: Boolean;
  4166.   vPropInfo: PPropInfo;
  4167. begin
  4168.   // assume the worst
  4169.   Result := False;
  4170.   vAnyMatches := False;
  4171.  
  4172.   // make sure we have good data
  4173.   if not Assigned(APropertyType) and
  4174.      Assigned(AComponentClass) then
  4175.   begin
  4176.     vPropInfo := GetPropInfo(PTypeInfo(AComponentClass.ClassInfo), APropertyName);
  4177.     if Assigned(vPropInfo) then
  4178.       APropertyType := vPropInfo.PropType^;
  4179.   end;
  4180.  
  4181.   // for each category...
  4182.   for I := 0 to Count - 1 do
  4183.     if Categories[I] <> MiscCategory then begin
  4184.  
  4185.       // found something?
  4186.       vThisMatch := Categories[I].Match(APropertyName, AComponentClass, APropertyType);
  4187.       vAnyMatches := vAnyMatches or vThisMatch;
  4188.  
  4189.       // if this is a good match and its visible then...
  4190.       Result := vThisMatch and Categories[I].Visible;
  4191.       if Result then
  4192.         break;
  4193.     end;
  4194.  
  4195.   // if no matches then check the misc category
  4196.   if not vAnyMatches then
  4197.   begin
  4198.     vThisMatch := MiscCategory.Match(APropertyName, AComponentClass, APropertyType);
  4199.     Result := vThisMatch and MiscCategory.Visible;
  4200.   end;
  4201. end;
  4202.  
  4203. function TPropertyCategoryList.MiscCategory: TPropertyCategory;
  4204. begin
  4205.   if FMiscCategory = nil then
  4206.     FMiscCategory := FindCategory(TMiscellaneousCategory);
  4207.   Result := FMiscCategory;
  4208. end;
  4209.  
  4210. procedure TPropertyCategoryList.SetHiddenCategories(const Value: string);
  4211. var
  4212.   vStrings: TStringList;
  4213.   I: Integer;
  4214. begin
  4215.   vStrings := TStringList.Create;
  4216.   try
  4217.     vStrings.CommaText := Value;
  4218.     for I := 0 to Count - 1 do
  4219.       Categories[I].Visible := vStrings.IndexOf(Categories[I].Name) = -1;
  4220.   finally
  4221.     vStrings.Free;
  4222.   end;
  4223. end;
  4224.  
  4225. { Property Categories }
  4226.  
  4227. function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  4228.   const APropertyName: string): TPropertyFilter;
  4229. begin
  4230.   Result := PropertyCategoryList.FindCategory(ACategoryClass).Add(
  4231.     TPropertyFilter.Create(APropertyName, nil, nil));
  4232. end;
  4233.  
  4234. function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  4235.   AComponentClass: TClass; const APropertyName: string): TPropertyFilter; overload;
  4236. begin
  4237.   Result := PropertyCategoryList.FindCategory(ACategoryClass).Add(
  4238.     TPropertyFilter.Create(APropertyName, AComponentClass, nil));
  4239. end;
  4240.  
  4241. function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  4242.   APropertyType: PTypeInfo; const APropertyName: string): TPropertyFilter; overload;
  4243. begin
  4244.   Result := PropertyCategoryList.FindCategory(ACategoryClass).Add(
  4245.     TPropertyFilter.Create(APropertyName, nil, APropertyType));
  4246. end;
  4247.  
  4248. function RegisterPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  4249.   APropertyType: PTypeInfo): TPropertyFilter;
  4250. begin
  4251.   Result := PropertyCategoryList.FindCategory(ACategoryClass).Add(
  4252.     TPropertyFilter.Create('', nil, APropertyType));
  4253. end;
  4254.  
  4255. function RegisterPropertiesInCategory(ACategoryClass: TPropertyCategoryClass;
  4256.   const AFilters: array of const): TPropertyCategory;
  4257. var
  4258.   I: Integer;
  4259. begin
  4260.   Result := PropertyCategoryList.FindCategory(ACategoryClass);
  4261.   for I := Low(AFilters) to High(AFilters) do
  4262.     with AFilters[I], Result do
  4263.       case vType of
  4264.         vtPointer:    Add(TPropertyFilter.Create('', nil, PTypeInfo(vPointer)));
  4265.         vtClass:      Add(TPropertyFilter.Create('', vClass, nil));
  4266.         vtAnsiString: Add(TPropertyFilter.Create(String(vAnsiString), nil, nil));
  4267.       else
  4268.         raise EPropertyError.CreateResFmt(@SInvalidFilter, [I, vType]);
  4269.       end;
  4270. end;
  4271.  
  4272. function RegisterPropertiesInCategory(ACategoryClass: TPropertyCategoryClass;
  4273.   AComponentClass: TClass; const AFilters: array of string): TPropertyCategory;
  4274. var
  4275.   I: Integer;
  4276. begin
  4277.   Result := PropertyCategoryList.FindCategory(ACategoryClass);
  4278.   for I := Low(AFilters) to High(AFilters) do
  4279.     Result.Add(TPropertyFilter.Create(AFilters[I], AComponentClass, nil));
  4280. end;
  4281.  
  4282. function RegisterPropertiesInCategory(ACategoryClass: TPropertyCategoryClass;
  4283.   APropertyType: PTypeInfo; const AFilters: array of string): TPropertyCategory;
  4284. var
  4285.   I: Integer;
  4286. begin
  4287.   Result := PropertyCategoryList.FindCategory(ACategoryClass);
  4288.   for I := Low(AFilters) to High(AFilters) do
  4289.     Result.Add(TPropertyFilter.Create(AFilters[I], nil, APropertyType));
  4290. end;
  4291.  
  4292. function IsPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  4293.   AComponentClass: TClass; const APropertyName: String): Boolean;
  4294. begin
  4295.   Result := PropertyCategoryList.FindCategory(ACategoryClass).Match(
  4296.     APropertyName, AComponentClass, nil);
  4297. end;
  4298.  
  4299. function IsPropertyInCategory(ACategoryClass: TPropertyCategoryClass;
  4300.   const AClassName: string; const APropertyName: String): Boolean;
  4301. begin
  4302.   Result := PropertyCategoryList.FindCategory(ACategoryClass).Match(
  4303.     APropertyName, FindClass(AClassName), nil);
  4304. end;
  4305.  
  4306. function PropertyCategoryList: TPropertyCategoryList;
  4307. begin
  4308.   // if it doesn't exists then make it
  4309.   if not Assigned(InternalPropertyCategoryList) then
  4310.   begin
  4311.     InternalPropertyCategoryList := TPropertyCategoryList.Create;
  4312.  
  4313.     // add the catch all misc category
  4314.     InternalPropertyCategoryList.FindCategory(TMiscellaneousCategory).Add(
  4315.       TPropertyFilter.Create('', nil, nil));
  4316.   end;
  4317.  
  4318.   // ok return it then
  4319.   Result := InternalPropertyCategoryList;
  4320. end;
  4321.  
  4322. { TActionCategory }
  4323.  
  4324. class function TActionCategory.Name: string;
  4325. begin
  4326.   Result := SActionCategoryName;
  4327. end;
  4328.  
  4329. class function TActionCategory.Description: string;
  4330. begin
  4331.   Result := SActionCategoryDesc;
  4332. end;
  4333.  
  4334. { TDataCategory }
  4335.  
  4336. class function TDataCategory.Name: string;
  4337. begin
  4338.   Result := SDataCategoryName;
  4339. end;
  4340.  
  4341. class function TDataCategory.Description: string;
  4342. begin
  4343.   Result := SDataCategoryDesc;
  4344. end;
  4345.  
  4346. { TDatabaseCategory }
  4347.  
  4348. class function TDatabaseCategory.Name: string;
  4349. begin
  4350.   Result := SDatabaseCategoryName;
  4351. end;
  4352.  
  4353. class function TDatabaseCategory.Description: string;
  4354. begin
  4355.   Result := SDatabaseCategoryDesc;
  4356. end;
  4357.  
  4358. { TDragNDropCategory }
  4359.  
  4360. class function TDragNDropCategory.Name: string;
  4361. begin
  4362.   Result := SDragNDropCategoryName;
  4363. end;
  4364.  
  4365. class function TDragNDropCategory.Description: string;
  4366. begin
  4367.   Result := SDragNDropCategoryDesc;
  4368. end;
  4369.  
  4370. { THelpCategory }
  4371.  
  4372. class function THelpCategory.Name: string;
  4373. begin
  4374.   Result := SHelpCategoryName;
  4375. end;
  4376.  
  4377. class function THelpCategory.Description: string;
  4378. begin
  4379.   Result := SHelpCategoryDesc;
  4380. end;
  4381.  
  4382. { TLayoutCategory }
  4383.  
  4384. class function TLayoutCategory.Name: string;
  4385. begin
  4386.   Result := SLayoutCategoryName;
  4387. end;
  4388.  
  4389. class function TLayoutCategory.Description: string;
  4390. begin
  4391.   Result := SLayoutCategoryDesc;
  4392. end;
  4393.  
  4394. { TLegacyCategory }
  4395.  
  4396. class function TLegacyCategory.Name: string;
  4397. begin
  4398.   Result := SLegacyCategoryName;
  4399. end;
  4400.  
  4401. class function TLegacyCategory.Description: string;
  4402. begin
  4403.   Result := SLegacyCategoryDesc;
  4404. end;
  4405.  
  4406. { TLinkageCategory }
  4407.  
  4408. class function TLinkageCategory.Name: string;
  4409. begin
  4410.   Result := SLinkageCategoryName;
  4411. end;
  4412.  
  4413. class function TLinkageCategory.Description: string;
  4414. begin
  4415.   Result := SLinkageCategoryDesc;
  4416. end;
  4417.  
  4418. { TLocaleCategory }
  4419.  
  4420. class function TLocaleCategory.Name: string;
  4421. begin
  4422.   Result := SLocaleCategoryName;
  4423. end;
  4424.  
  4425. class function TLocaleCategory.Description: string;
  4426. begin
  4427.   Result := SLocaleCategoryDesc;
  4428. end;
  4429.  
  4430. { TLocalizableCategory }
  4431.  
  4432. class function TLocalizableCategory.Name: string;
  4433. begin
  4434.   Result := SLocalizableCategoryName;
  4435. end;
  4436.  
  4437. class function TLocalizableCategory.Description: string;
  4438. begin
  4439.   Result := SLocalizableCategoryDesc;
  4440. end;
  4441.  
  4442. { TMiscellaneousCategory }
  4443.  
  4444. class function TMiscellaneousCategory.Name: string;
  4445. begin
  4446.   Result := SMiscellaneousCategoryName;
  4447. end;
  4448.  
  4449. class function TMiscellaneousCategory.Description: string;
  4450. begin
  4451.   Result := SMiscellaneousCategoryDesc;
  4452. end;
  4453.  
  4454. { TVisualCategory }
  4455.  
  4456. class function TVisualCategory.Name: string;
  4457. begin
  4458.   Result := SVisualCategoryName;
  4459. end;
  4460.  
  4461. class function TVisualCategory.Description: string;
  4462. begin
  4463.   Result := SVisualCategoryDesc;
  4464. end;
  4465.  
  4466. { TInputCategory }
  4467.  
  4468. class function TInputCategory.Name: string;
  4469. begin
  4470.   Result := SInputCategoryName;
  4471. end;
  4472.  
  4473. class function TInputCategory.Description: string;
  4474. begin
  4475.   Result := SInputCategoryDesc;
  4476. end;
  4477.  
  4478. initialization
  4479.  
  4480. finalization
  4481.   FreeAndNil(EditorGroupList);
  4482.   FreeAndNil(PropertyClassList);
  4483.   FreeAndNil(ComponentClassList);
  4484.   FreeAndNil(PropertyMapperList);
  4485.   FreeAndNil(InternalPropertyCategoryList);
  4486. end.
  4487.