1 {
2  *****************************************************************************
3   See the file COPYING.modifiedLGPL.txt, included in this distribution,
4   for details about the license.
5  *****************************************************************************
6 
7   Author: Mattias Gaertner
8 
9   Abstract:
10    Provides LCL controls that access properties of TPersistent objects via RTTI
11    - the FreePascal Run Time Type Information.
12    Every published property can be edited in the Object Inspector. There you
13    have a TOIPropertyGrid working with TEdit, TComboBox and TButton.
14    These controls extends the possibilities to edit single properties and the
15    developer can choose how to represent the property.
16 
17   ToDo:
18     - ploReadOnly
19 }
20 unit RTTICtrls;
21 
22 {$mode objfpc}{$H+}
23 
24 interface
25 
26 uses
27   Classes, SysUtils, TypInfo, LResources, LCLProc, LCLType, LCLIntf, Forms,
28   Controls, Graphics, MaskEdit, Calendar, Spin, Dialogs, CheckLst, ComCtrls,
29   StdCtrls, Buttons, ExtCtrls, GraphPropEdits, PropEdits;
30 
31 type
32   { TAliasStrings }
33   { Maps strings to alias strings.
34     Some RTTI controls uses this to map RTTI values to shown values.
35     Eventually accelerate search for Names and Values }
36 
37   TAliasStrings = class(TStringList)
38   public
IndexOfValuenull39     function IndexOfValue(const AValue: string): integer; virtual;
ValueAtnull40     function ValueAt(Index: integer): string; virtual;
ValueToAliasnull41     function ValueToAlias(const AValue: string): string; virtual;
AliasToValuenull42     function AliasToValue(const Alias: string): string; virtual;
43   end;
44 
45 
46   { TPropertyLinkNotifier }
47 
48   TCustomPropertyLink = class;
49 
50   TPropertyLinkNotifier = class(TComponent)
51   private
52     FLink: TCustomPropertyLink;
53   protected
54     procedure Notification(AComponent: TComponent;
55                            Operation: TOperation); override;
56   public
57     constructor Create(TheLink: TCustomPropertyLink); reintroduce;
58     property Link: TCustomPropertyLink read FLink;
59   end;
60 
61 
62   { TCustomPropertyLink
63     The connection between an RTTI control and a property editor }
64 
65   TPropertyLinkOption = (
66     ploReadOnIdle,
67     ploAutoSave // auto save on EditingDone
68     //ToDo: ploDisableOnNil // disable control, if link not connected
69     //ToDo: ploReadOnly
70     );
71   TPropertyLinkOptions = set of TPropertyLinkOption;
72 
73 Const
74   DefaultLinkOptions = [ploReadOnIdle,ploAutoSave];
75 
76 Type
77 
endernull78   TTestEditing = function(Sender: TObject): boolean of object;
79   TBeforeWriteProperty = procedure(Sender: TObject; var AllowWrite: boolean) of object;
80 
81   { TCustomPropertyLink }
82 
83   TCustomPropertyLink = class(TPersistent)
84   private
85     FAliasValues: TAliasStrings;
86     FCollectedValues: TStrings;
87     FCollectValues: boolean;
88     FEditor: TPropertyEditor;
89     FFilter: TTypeKinds;
90     FHook: TPropertyEditorHook;
91     FIdleHandlerConnected: boolean;
92     FLinkNotifier: TPropertyLinkNotifier;
93     FOnAfterWrite: TNotifyEvent;
94     FOnBeforeWrite: TBeforeWriteProperty;
95     FOnEditorChanged: TNotifyEvent;
96     FOnLoadFromProperty: TNotifyEvent;
97     FOnSaveToProperty: TNotifyEvent;
98     FOnTestEditing: TTestEditing;
99     FOnTestEditor: TPropertyEditorFilterFunc;
100     FOptions: TPropertyLinkOptions;
101     FOwner: TComponent;
102     FPropertyLoaded: boolean;
103     FSaveEnabled: boolean;
104     FTIElementName: string;
105     FTIObject: TPersistent;
106     FTIPropertyName: string;
107     procedure SetCollectValues(const AValue: boolean);
108     procedure SetEditor(const AValue: TPropertyEditor);
109     procedure SetFilter(const AValue: TTypeKinds);
110     procedure SetOptions(const NewOptions: TPropertyLinkOptions);
111     procedure SetTIElementName(const AValue: string);
112     procedure SetTIObject(const AValue: TPersistent);
113     procedure SetTIPropertyName(const AValue: string);
114   protected
GetCanModifynull115     function GetCanModify: boolean; virtual;
116     procedure EditorChanged; virtual;
117     procedure SetPropertyEditor(APropertyEditor: TPropertyEditor); virtual;
CheckPropInfonull118     function CheckPropInfo(const APropInfo: PPropInfo): boolean; virtual;
119     procedure CreateHook; virtual;
120     procedure UpdateIdleHandler; virtual;
121     procedure OnApplicationIdle(Sender: TObject; var Done: Boolean); virtual;
122     procedure Notification(AComponent: TComponent;
123                            Operation: TOperation); virtual;
124     procedure GetEditorValues(const NewValue: string); virtual;
125   public
126     constructor Create;
127     constructor Create(TheOwner: TComponent);
128     destructor Destroy; override;
129     procedure Assign(Source: TPersistent); override;
130     procedure SetObjectAndProperty(NewPersistent: TPersistent;
131                                    const NewPropertyName: string);
132     procedure SetObjectAndProperty(NewPersistent: TPersistent;
133                                  const NewPropertyName, NewElementName: string);
134     procedure InvalidateEditor; virtual;
135     procedure CreateEditor; virtual;
136     procedure FetchValues; virtual;
137     procedure LoadFromProperty; virtual;
138     procedure SaveToProperty; virtual;
139     procedure EditingDone; virtual;
140     procedure SetAsText(const NewText: string);
GetAsTextnull141     function GetAsText: string;
142     procedure SetAsInt(const NewInt: integer);
GetAsIntnull143     function GetAsInt: integer;
CheckBeforeWritenull144     function CheckBeforeWrite: boolean;
145     procedure CheckAfterWrite;
146     procedure DoError(Writing: boolean; E: Exception); virtual;
147   public
148     // alias values
149     procedure MapValues(Values, AliasStrings: TStrings;
150                         var MappedValues: TStrings;
151                         UseAllExistingAlias, AddValuesWithoutAlias,
152                         IfNoValuesAvailableAddAllAlias: boolean);
153     procedure MapCollectedValues(AliasStrings: TStrings;
154                                  var MappedValues: TStrings;
155                                  UseAllExistingAlias, AddValuesWithoutAlias,
156                                  IfNoValuesAvailableAddAllAlias: boolean);
157     procedure AssignCollectedAliasValuesTo(DestList: TStrings;
158                                            KeepIfNoneCollected: boolean = true);
HasAliasValuesnull159     function HasAliasValues: boolean;
160     procedure BuildEnumAliasValues(AStringArray: PString);
161   public
162     // for Set property editors
163     procedure AssignSetEnumsAliasTo(DestList: TStrings);
GetSetElementValuenull164     function GetSetElementValue(const AliasName: string): boolean;
165     procedure SetSetElementValue(const AliasName: string; NewValue: boolean);
GetIndexOfSetElementnull166     function GetIndexOfSetElement(const AliasName: string): integer;
GetSetTypeDatanull167     function GetSetTypeData(out CompData: PTypeInfo;
168                             out TypeData: PTypeData): boolean;
169   public
170     property AliasValues: TAliasStrings read FAliasValues;
171     property CanModify: boolean read GetCanModify;
172     property CollectedValues: TStrings read FCollectedValues write FCollectedValues;
173     property CollectValues: boolean read FCollectValues write SetCollectValues;
174     property Editor: TPropertyEditor read FEditor write SetEditor;
175     property Filter: TTypeKinds read FFilter write SetFilter default AllTypeKinds;
176     property Hook: TPropertyEditorHook read FHook;
177     property LinkNotifier: TPropertyLinkNotifier read FLinkNotifier;
178     property OnEditorChanged: TNotifyEvent read FOnEditorChanged write FOnEditorChanged;
179     property OnLoadFromProperty: TNotifyEvent read FOnLoadFromProperty write FOnLoadFromProperty;// do not publish, it is used by the TTI controls
180     property OnSaveToProperty: TNotifyEvent read FOnSaveToProperty write FOnSaveToProperty;// do not publish, it is used by the TTI controls
181     property OnBeforeWrite: TBeforeWriteProperty read FOnBeforeWrite write FOnBeforeWrite;
182     property OnAfterWrite: TNotifyEvent read FOnAfterWrite write FOnAfterWrite;
183     property OnTestEditing: TTestEditing read FOnTestEditing write FOnTestEditing;
184     property OnTestEditor: TPropertyEditorFilterFunc read FOnTestEditor write FOnTestEditor;
185     property Options: TPropertyLinkOptions read FOptions write SetOptions default DefaultLinkOptions;
186     property Owner: TComponent read FOwner;
187     property SaveEnabled: boolean read FSaveEnabled write FSaveEnabled;
188     property PropertyLoaded: boolean read FPropertyLoaded write FPropertyLoaded;
189     property TIObject: TPersistent read FTIObject write SetTIObject;
190     property TIPropertyName: string read FTIPropertyName write SetTIPropertyName;
191     property TIElementName: string read FTIElementName write SetTIElementName;
192   end;
193 
194 
195   { TPropertyLink }
196 
197   TPropertyLink = class(TCustomPropertyLink)
198   private
199     procedure ReadAliasValuesData(Reader: TReader);
200     procedure WriteAliasValuesData(Writer: TWriter);
201   protected
202     procedure DefineProperties(Filer: TFiler); override;
203   published
204     property AliasValues;
205     property OnBeforeWrite;
206     property OnAfterWrite;
207     property Options;
208     property TIObject;
209     property TIPropertyName;
210     property TIElementName;
211   end;
212 
213 
214   { TPropertyLinkPropertyEditor }
215 
216   TPropertyLinkPropertyEditor = class(TClassPropertyEditor)
217   public
GetAttributesnull218     function GetAttributes: TPropertyAttributes; override;
219   end;
220 
221 
222   { TTIObjectPropertyEditor }
223 
224   TTIObjectPropertyEditor = class(TPersistentPropertyEditor)
225   end;
226 
227 
228   { TPropertyNamePropertyEditor
229     Property editor for TCustomPropertyLink.TIPropertyName, showing
230     all compatible properties. }
231 
232   TPropertyNamePropertyEditor = class(TStringPropertyEditor)
233   protected
234     FPropEdits: TList; // list of TPropertyEditor
235     procedure GetCompatiblePropEdits(Prop: TPropertyEditor);
TestEditornull236     function TestEditor(const Prop: TPropertyEditor): boolean;
237   public
GetAttributesnull238     function GetAttributes: TPropertyAttributes; override;
GetEditLimitnull239     function GetEditLimit: Integer; override;
240     procedure GetValues(Proc: TGetStringProc); override;
241   end;
242 
243 
244   { TTIElementNamePropertyEditor
245     Property editor for TCustomPropertyLink.TIElementName, showing
246     all elements. }
247 
248   TTIElementNamePropertyEditor = class(TStringPropertyEditor)
249   protected
250     FPropEdits: TList; // list of TPropertyEditor for TIPropertyName
251     FElementPropEdits: TList; // list of TPropertyEditor for TIElementName
252     procedure GetCompatiblePropEdits(Prop: TPropertyEditor);
253     procedure GetElementPropEdits(Prop: TPropertyEditor);
TestEditornull254     function TestEditor(const Prop: TPropertyEditor): boolean;
255   public
GetAttributesnull256     function GetAttributes: TPropertyAttributes; override;
GetEditLimitnull257     function GetEditLimit: Integer; override;
258     procedure GetValues(Proc: TGetStringProc); override;
259   end;
260 
261 
262   { TAliasStringsPropEditorDlg }
263 
264   TAliasStringsPropEditorDlg = class(TStringsPropEditorDlg)
265     GetDefaultValuesButton: TButton;
266     procedure GetDefaultValuesButtonClick(Sender: TObject);
267   protected
268     FCollectedValues: TAliasStrings;
269     procedure AddValue(const s: string); virtual;
270   public
271     procedure AddButtons; override;
272   end;
273 
274 
275   { TPropLinkAliasPropertyEditor
276     Property Editor for TCustomPropertyLink.AliasValues, providing a dialog
277     to edit }
278 
279   TPropLinkAliasPropertyEditor = class(TStringsPropertyEditor)
280   public
CreateDlgnull281     function CreateDlg(s: TStrings): TStringsPropEditorDlg; override;
282   end;
283 
284 
285   { TMultiPropertyLink
286     A component to switch the TIObjects of multiple RTTI controls at once. }
287 
288   TMultiPropertyLink = class(TComponent)
289   private
290     FTIObject: TPersistent;
291     FMaintainGrandChilds: boolean;
292     FMaintainSiblings: boolean;
293     FOnSetTIObject: TNotifyEvent;
294     FParentControl: TWinControl;
295     FRootComponent: TComponent;
296     procedure SetTIObject(const AValue: TPersistent);
297     procedure SetMaintainGrandChilds(const AValue: boolean);
298     procedure SetMaintainSiblings(const AValue: boolean);
299     procedure SetParentControl(const AValue: TWinControl);
300     procedure SetRootComponent(const AValue: TComponent);
301   public
302     constructor Create(TheOwner: TComponent); override;
303     procedure SetLinks;
304     procedure SetLinksForChildControls(AParent: TWinControl;
305                                        WithGrandChilds: boolean);
306     procedure SetLinksForChildComponents(AComponent: TComponent);
307     procedure Loaded; override;
308   published
309     property TIObject: TPersistent read FTIObject write SetTIObject;
310     property OnSetTIObject: TNotifyEvent Read FOnSetTIObject Write FOnSetTIObject;
311     property ParentControl: TWinControl read FParentControl write SetParentControl;
312     property RootComponent: TComponent read FRootComponent write SetRootComponent;
313     property MaintainGrandChilds: boolean read FMaintainGrandChilds
314                                           write SetMaintainGrandChilds;
315     property MaintainSiblings: boolean read FMaintainSiblings
316                                        write SetMaintainSiblings default true;
317   end;
318 
319 
320   { TTICustomEdit }
321 
322   TTICustomEdit = class(TCustomEdit)
323   private
324     FLink: TPropertyLink;
325     procedure SetLink(const AValue: TPropertyLink);
326   protected
327     procedure LinkLoadFromProperty(Sender: TObject); virtual;
328     procedure LinkSaveToProperty(Sender: TObject); virtual;
329   public
330     constructor Create(TheOwner: TComponent); override;
331     destructor Destroy; override;
332     procedure Loaded; override;
333     procedure EditingDone; override;
334     property Link: TPropertyLink read FLink write SetLink;
335   end;
336 
337 
338   { TTIEdit }
339 
340   TTIEdit = class(TTICustomEdit)
341   published
342     property Action;
343     property Align;
344     property Anchors;
345     property AutoSize;
346     property BorderSpacing;
347     property Constraints;
348     property CharCase;
349     property DragMode;
350     property EchoMode;
351     property Enabled;
352     property Link;
353     property MaxLength;
354     property OnChange;
355     property OnChangeBounds;
356     property OnClick;
357     property OnEditingDone;
358     property OnEnter;
359     property OnExit;
360     Property OnKeyDown;
361     property OnKeyPress;
362     Property OnKeyUp;
363     Property OnMouseDown;
364     Property OnMouseMove;
365     property OnMouseUp;
366     property OnResize;
367     property ParentFont;
368     property ParentShowHint;
369     property PasswordChar;
370     property PopupMenu;
371     property ReadOnly;
372     property ShowHint;
373     property TabStop;
374     property TabOrder;
375     property Visible;
376   end;
377 
378 
379   { TTICustomMaskEdit }
380 
381   TTICustomMaskEdit = class(TCustomMaskEdit)
382   private
383     FLink: TPropertyLink;
384     procedure SetLink(const AValue: TPropertyLink);
385   protected
386     procedure LinkLoadFromProperty(Sender: TObject); virtual;
387     procedure LinkSaveToProperty(Sender: TObject); virtual;
388   public
389     constructor Create(TheOwner: TComponent); override;
390     destructor Destroy; override;
391     procedure Loaded; override;
392     procedure EditingDone; override;
393     property Link: TPropertyLink read FLink write SetLink;
394   end;
395 
396 
397   { TTIMaskEdit }
398 
399   TTIMaskEdit = class(TTICustomMaskEdit)
400   published
401     property Align;
402     property Anchors;
403     property AutoSize;
404     property BorderSpacing;
405     property CharCase;
406     property Color;
407     property Constraints;
408     property DragCursor;
409     property DragKind;
410     property DragMode;
411     property Enabled;
412     property EditMask;
413     property Font;
414     property Link;
415     property MaxLength;
416     property ParentColor;
417     property ParentFont;
418     property ParentShowHint;
419     property PasswordChar;
420     property PopupMenu;
421     property ReadOnly;
422     property ShowHint;
423     property TabOrder;
424     property TabStop;
425     property Visible;
426     property OnChange;
427     property OnClick;
428     property OnDblClick;
429     property OnDragDrop;
430     property OnDragOver;
431     property OnEditingDone;
432     property OnEndDrag;
433     property OnEnter;
434     property OnExit;
435     property OnKeyDown;
436     property OnKeyPress;
437     property OnKeyUp;
438     property OnMouseDown;
439     property OnMouseMove;
440     property OnMouseUp;
441     property OnStartDrag;
442   end;
443 
444 
445   { TTICustomComboBox }
446 
447   TTICustomComboBox = class(TCustomComboBox)
448   private
449     FHistoryCaseSensitive: boolean;
450     FLink: TPropertyLink;
451     FMaxHistoryCount: integer;
452     procedure SetLink(const AValue: TPropertyLink);
453     procedure SetMaxHistoryCount(const AValue: integer);
454   protected
455     procedure LinkLoadFromProperty(Sender: TObject); virtual;
456     procedure LinkSaveToProperty(Sender: TObject); virtual;
457     procedure LinkEditorChanged(Sender: TObject); virtual;
LinkTestEditingnull458     function LinkTestEditing(Sender: TObject): boolean;
459     procedure GetItems; override;
460     procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
461   public
462     constructor Create(TheOwner: TComponent); override;
463     destructor Destroy; override;
464     procedure Loaded; override;
465     procedure EditingDone; override;
466     property Link: TPropertyLink read FLink write SetLink;
467     property MaxHistoryCount: integer read FMaxHistoryCount
468            write SetMaxHistoryCount;// set this to a value > 0 to enable history
469     property HistoryCaseSensitive: boolean read FHistoryCaseSensitive
470                                            write FHistoryCaseSensitive;
471   end;
472 
473 
474   { TTIComboBox }
475 
476   TTIComboBox = class(TTICustomComboBox)
477   public
478     property ItemIndex;
479   published
480     property Align;
481     property Anchors;
482     property ArrowKeysTraverseList;
483     property AutoComplete;
484     property AutoCompleteText;
485     property AutoDropDown;
486     property BorderSpacing;
487     property DropDownCount;
488     property Enabled;
489     property Font;
490     property HistoryCaseSensitive;
491     property Link;
492     property MaxHistoryCount;
493     property MaxLength;
494     property OnChange;
495     property OnChangeBounds;
496     property OnClick;
497     property OnCloseUp;
498     property OnDrawItem;
499     property OnDropDown;
500     property OnEditingDone;
501     property OnEnter;
502     property OnExit;
503     property OnGetItems;
504     property OnKeyDown;
505     property OnKeyPress;
506     property OnKeyUp;
507     property OnMouseDown;
508     property OnMouseMove;
509     property OnMouseUp;
510     property OnSelect;
511     property ParentFont;
512     property ParentShowHint;
513     property ShowHint;
514     property Sorted;
515     property Style;
516     property TabOrder;
517     property TabStop;
518     property Visible;
519   end;
520 
521 
522   { TTICustomRadioGroup }
523 
524   TTICustomRadioGroup = class(TCustomRadioGroup)
525   private
526     FLink: TPropertyLink;
527     procedure SetLink(const AValue: TPropertyLink);
528   protected
529     procedure LinkLoadFromProperty(Sender: TObject); virtual;
530     procedure LinkSaveToProperty(Sender: TObject); virtual;
531     procedure LinkEditorChanged(Sender: TObject); virtual;
532   public
533     constructor Create(TheOwner: TComponent); override;
534     destructor Destroy; override;
535     procedure Loaded; override;
536     procedure EditingDone; override;
537     property Link: TPropertyLink read FLink write SetLink;
538   end;
539 
540 
541   { TTIRadioGroup }
542 
543   TTIRadioGroup = class(TTICustomRadioGroup)
544   published
545     property Align;
546     property Anchors;
547     property BorderSpacing;
548     property Caption;
549     property ChildSizing;
550     property Color;
551     property ColumnLayout;
552     property Columns;
553     property Constraints;
554     property Enabled;
555     property ItemIndex;
556     property Link;
557     property OnChangeBounds;
558     property OnClick;
559     property OnDblClick;
560     property OnEditingDone;
561     property OnEnter;
562     property OnExit;
563     property OnKeyDown;
564     property OnKeyPress;
565     property OnKeyUp;
566     property OnMouseDown;
567     property OnMouseMove;
568     property OnMouseUp;
569     property OnResize;
570     property ParentColor;
571     property ParentShowHint;
572     property PopupMenu;
573     property ShowHint;
574     property Visible;
575   end;
576 
577 
578   { TTICustomCheckGroup }
579 
580   TTICustomCheckGroup = class(TCustomCheckGroup)
581   private
582     FLink: TPropertyLink;
583     procedure SetLink(const AValue: TPropertyLink);
584   protected
585     procedure LinkLoadFromProperty(Sender: TObject); virtual;
586     procedure LinkSaveToProperty(Sender: TObject); virtual;
587     procedure LinkEditorChanged(Sender: TObject); virtual;
588   public
589     constructor Create(TheOwner: TComponent); override;
590     destructor Destroy; override;
591     procedure Loaded; override;
592     procedure EditingDone; override;
593     property Link: TPropertyLink read FLink write SetLink;
594   end;
595 
596 
597   { TTICheckGroup }
598 
599   TTICheckGroup = class(TTICustomCheckGroup)
600   published
601     property Align;
602     property Anchors;
603     property BorderSpacing;
604     property Caption;
605     property Color;
606     property ColumnLayout;
607     property Columns;
608     property Constraints;
609     property Enabled;
610     property Items;
611     property Link;
612     property OnChangeBounds;
613     property OnClick;
614     property OnDblClick;
615     property OnEditingDone;
616     property OnEnter;
617     property OnExit;
618     property OnItemClick;
619     property OnKeyDown;
620     property OnKeyPress;
621     property OnKeyUp;
622     property OnMouseDown;
623     property OnMouseMove;
624     property OnMouseUp;
625     property OnResize;
626     property ParentColor;
627     property ParentShowHint;
628     property PopupMenu;
629     property ShowHint;
630     property Visible;
631   end;
632 
633 
634   { TTICustomCheckListBox }
635 
636   TTICustomCheckListBox = class(TCustomCheckListBox)
637   private
638     FLink: TPropertyLink;
639     procedure SetLink(const AValue: TPropertyLink);
640   protected
641     procedure LinkLoadFromProperty(Sender: TObject); virtual;
642     procedure LinkSaveToProperty(Sender: TObject); virtual;
643     procedure LinkEditorChanged(Sender: TObject); virtual;
644   public
645     constructor Create(TheOwner: TComponent); override;
646     destructor Destroy; override;
647     procedure Loaded; override;
648     procedure EditingDone; override;
649     property Link: TPropertyLink read FLink write SetLink;
650   end;
651 
652 
653   { TTICheckListBox }
654 
655   TTICheckListBox = class(TTICustomCheckListBox)
656   published
657     property Align;
658     property Anchors;
659     property BorderSpacing;
660     property BorderStyle;
661     property Constraints;
662     property ExtendedSelect;
663     property Items;
664     property ItemHeight;
665     property Link;
666     property MultiSelect;
667     property OnClick;
668     property OnDblClick;
669     property OnDrawItem;
670     property OnEditingDone;
671     property OnEnter;
672     property OnExit;
673     property OnKeyPress;
674     property OnKeyDown;
675     property OnKeyUp;
676     property OnMouseMove;
677     property OnMouseDown;
678     property OnMouseUp;
679     property OnResize;
680     property ParentShowHint;
681     property ShowHint;
682     property Sorted;
683     property Style;
684     property TabOrder;
685     property TabStop;
686     property TopIndex;
687     property Visible;
688   end;
689 
690 
691   { TTICustomListBox }
692 
693   TTICustomListBox = class(TCustomListBox)
694   private
695     FLink: TPropertyLink;
696     procedure SetLink(const AValue: TPropertyLink);
697   protected
698     procedure LinkLoadFromProperty(Sender: TObject); virtual;
699     procedure LinkSaveToProperty(Sender: TObject); virtual;
700     procedure LinkEditorChanged(Sender: TObject); virtual;
701     procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
702   public
703     constructor Create(TheOwner: TComponent); override;
704     destructor Destroy; override;
705     procedure Loaded; override;
706     procedure EditingDone; override;
707     property Link: TPropertyLink read FLink write SetLink;
708   end;
709 
710 
711   { TTIListBox }
712 
713   TTIListBox = class(TTICustomListBox)
714   published
715     property Align;
716     property Anchors;
717     property BorderSpacing;
718     property BorderStyle;
719     property ClickOnSelChange;
720     property Constraints;
721     property ExtendedSelect;
722     property Font;
723     property IntegralHeight;
724     property ItemHeight;
725     property MultiSelect;
726     property Link;
727     property OnChangeBounds;
728     property OnClick;
729     property OnDblClick;
730     property OnDrawItem;
731     property OnEditingDone;
732     property OnEnter;
733     property OnExit;
734     property OnKeyPress;
735     property OnKeyDown;
736     property OnKeyUp;
737     property OnMouseMove;
738     property OnMouseDown;
739     property OnMouseUp;
740     property OnMouseEnter;
741     property OnMouseLeave;
742     property OnMouseWheel;
743     property OnMouseWheelDown;
744     property OnMouseWheelUp;
745     property OnResize;
746     property OnSelectionChange;
747     property ParentShowHint;
748     property ParentFont;
749     property PopupMenu;
750     property ShowHint;
751     property Sorted;
752     property Style;
753     property TabOrder;
754     property TabStop;
755     property TopIndex;
756     property Visible;
757   end;
758 
759 
760   { TTICustomCheckBox }
761 
762   TTICustomCheckBox = class(TCustomCheckBox)
763   private
764     FLink: TPropertyLink;
765     FLinkValueFalse: string;
766     FLinkValueTrue: string;
767     FPropertyNameAsCaption: boolean;
768     procedure SetLink(const AValue: TPropertyLink);
769     procedure SetPropertyNameAsCaption(const AValue: boolean);
770   protected
771     procedure LinkLoadFromProperty(Sender: TObject); virtual;
772     procedure LinkSaveToProperty(Sender: TObject); virtual;
773     procedure LinkEditorChanged(Sender: TObject); virtual;
774   public
775     constructor Create(TheOwner: TComponent); override;
776     destructor Destroy; override;
777     procedure Loaded; override;
778     procedure EditingDone; override;
779     property LinkValueTrue: string read FLinkValueTrue;
780     property LinkValueFalse: string read FLinkValueFalse;
781     property Link: TPropertyLink read FLink write SetLink;
782     property PropertyNameAsCaption: boolean read FPropertyNameAsCaption
783                                             write SetPropertyNameAsCaption;
784   end;
785 
786 
787   { TTICheckBox }
788 
789   TTICheckBox = class(TTICustomCheckBox)
790   published
791     property Action;
792     property Align;
793     property AllowGrayed;
794     property Anchors;
795     property AutoSize;
796     property BorderSpacing;
797     property Caption;
798     property Constraints;
799     property DragCursor;
800     property DragKind;
801     property DragMode;
802     property Enabled;
803     property Hint;
804     property Link;
805     property OnChange;
806     property OnChangeBounds;
807     property OnClick;
808     property OnDragDrop;
809     property OnDragOver;
810     property OnEditingDone;
811     property OnEndDrag;
812     property OnEnter;
813     property OnExit;
814     property OnMouseDown;
815     property OnMouseMove;
816     property OnMouseUp;
817     property OnResize;
818     property OnStartDrag;
819     property ParentShowHint;
820     property PopupMenu;
821     property PropertyNameAsCaption;
822     property ShowHint;
823     property State;
824     property TabOrder;
825     property TabStop;
826     property Visible;
827   end;
828 
829 
830   { TTICustomButton }
831 
832   TTICustomButton = class(TCustomButton)
833   private
834     FLink: TPropertyLink;
835     procedure SetLink(const AValue: TPropertyLink);
836   protected
LinkTestEditornull837     function LinkTestEditor(const ATestEditor: TPropertyEditor): Boolean; virtual;
838   public
839     constructor Create(TheOwner: TComponent); override;
840     destructor Destroy; override;
841     procedure Click; override;
842     property Link: TPropertyLink read FLink write SetLink;
843   end;
844 
845 
846   { TTIButton }
847 
848   TTIButton = class(TTICustomButton)
849   published
850     property Action;
851     property Align;
852     property Anchors;
853     property BorderSpacing;
854     property Cancel;
855     property Caption;
856     property Constraints;
857     property Default;
858     property Enabled;
859     property Font;
860     property Link;
861     property ModalResult;
862     property OnClick;
863     property OnEditingDone;
864     property OnEnter;
865     property OnExit;
866     property OnKeyDown;
867     property OnKeyPress;
868     property OnKeyUp;
869     property OnMouseDown;
870     property OnMouseMove;
871     property OnMouseUp;
872     property OnResize;
873     property ParentShowHint;
874     property PopupMenu;
875     property ShowHint;
876     property TabOrder;
877     property TabStop;
878     property Visible;
879   end;
880 
881 
882   { TTICustomLabel }
883 
884   TTICustomLabel = class(TCustomLabel)
885   private
886     FLink: TPropertyLink;
887     procedure SetLink(const AValue: TPropertyLink);
888   protected
GetLabelTextnull889     function GetLabelText: string; override;
890     procedure LinkLoadFromProperty(Sender: TObject); virtual;
891   public
892     constructor Create(TheOwner: TComponent); override;
893     destructor Destroy; override;
894     procedure Loaded; override;
895     property Link: TPropertyLink read FLink write SetLink;
896   end;
897 
898 
899   { TTILabel }
900 
901   TTILabel = class(TTICustomLabel)
902   published
903     property Align;
904     property Alignment;
905     property Anchors;
906     property AutoSize;
907     property BorderSpacing;
908     property Color;
909     property Constraints;
910     property FocusControl;
911     property Font;
912     property Layout;
913     property Link;
914     property OnChangeBounds;
915     property OnClick;
916     property OnDblClick;
917     property OnMouseDown;
918     property OnMouseEnter;
919     property OnMouseLeave;
920     property OnMouseMove;
921     property OnMouseUp;
922     property OnResize;
923     property ParentFont;
924     property ShowAccelChar;
925     property Visible;
926     property WordWrap;
927   end;
928 
929 
930   { TTICustomGroupbox }
931 
932   TTICustomGroupbox = class(TCustomGroupBox)
933   private
934     FLink: TPropertyLink;
935     procedure SetLink(const AValue: TPropertyLink);
936   protected
937     procedure LinkLoadFromProperty(Sender: TObject); virtual;
938   public
939     constructor Create(TheOwner: TComponent); override;
940     destructor Destroy; override;
941     procedure Loaded; override;
942     property Link: TPropertyLink read FLink write SetLink;
943   end;
944 
945 
946   { TTIGroupBox }
947 
948   TTIGroupBox = class(TTICustomGroupbox)
949   published
950     property Align;
951     property Anchors;
952     property BorderSpacing;
953     property ChildSizing;
954     property ClientHeight;
955     property ClientWidth;
956     property Color;
957     property Constraints;
958     property Enabled;
959     property Font;
960     property Link;
961     property OnChangeBounds;
962     property OnClick;
963     property OnDblClick;
964     property OnEditingDone;
965     property OnEnter;
966     property OnExit;
967     property OnKeyDown;
968     property OnKeyPress;
969     property OnKeyUp;
970     property OnMouseDown;
971     property OnMouseMove;
972     property OnMouseUp;
973     property OnResize;
974     property ParentColor;
975     property ParentFont;
976     property ParentShowHint;
977     property PopupMenu;
978     property ShowHint;
979     property TabOrder;
980     property TabStop;
981     property Visible;
982   end;
983 
984 
985   { TTICustomMemo }
986 
987   TTICustomMemo = class(TCustomMemo)
988   private
989     FLink: TPropertyLink;
990     procedure SetLink(const AValue: TPropertyLink);
991   protected
992     procedure LinkLoadFromProperty(Sender: TObject); virtual;
993     procedure LinkSaveToProperty(Sender: TObject); virtual;
LinkTestEditornull994     function LinkTestEditor(const ATestEditor: TPropertyEditor): Boolean; virtual;
995   public
996     constructor Create(TheOwner: TComponent); override;
997     destructor Destroy; override;
998     procedure Loaded; override;
999     procedure EditingDone; override;
1000     property Link: TPropertyLink read FLink write SetLink;
1001   end;
1002 
1003 
1004   { TTIMemo }
1005 
1006   TTIMemo = class(TTICustomMemo)
1007   published
1008     property Align;
1009     property Anchors;
1010     property BorderSpacing;
1011     property Color;
1012     property Constraints;
1013     property Font;
1014     property Lines;
1015     property Link;
1016     property MaxLength;
1017     property OnChange;
1018     property OnEditingDone;
1019     property OnEnter;
1020     property OnExit;
1021     property OnKeyDown;
1022     property OnKeyPress;
1023     property OnKeyUp;
1024     property OnMouseDown;
1025     property OnMouseUp;
1026     property OnMouseMove;
1027     property OnMouseEnter;
1028     property OnMouseLeave;
1029     property ParentFont;
1030     property PopupMenu;
1031     property ReadOnly;
1032     property ScrollBars;
1033     property Tabstop;
1034     property Visible;
1035     property WordWrap;
1036   end;
1037 
1038 
1039   { TTICustomCalendar }
1040 
1041   TTICustomCalendar = class(TCustomCalendar)
1042   private
1043     FLink: TPropertyLink;
1044     procedure SetLink(const AValue: TPropertyLink);
1045   protected
1046     procedure LinkLoadFromProperty(Sender: TObject); virtual;
1047     procedure LinkSaveToProperty(Sender: TObject); virtual;
LinkTestEditornull1048     function LinkTestEditor(const ATestEditor: TPropertyEditor): Boolean;
1049   public
1050     constructor Create(TheOwner: TComponent); override;
1051     destructor Destroy; override;
1052     procedure Loaded; override;
1053     procedure EditingDone; override;
1054     property Link: TPropertyLink read FLink write SetLink;
1055   end;
1056 
1057 
1058   { TTICalendar }
1059 
1060   TTICalendar = class(TTICustomCalendar)
1061   published
1062     property Align;
1063     property Anchors;
1064     property BorderSpacing;
1065     property Constraints;
1066     property DisplaySettings;
1067     property Link;
1068     property OnChange;
1069     property OnChangeBounds;
1070     property OnClick;
1071     property OnDayChanged;
1072     property OnEditingDone;
1073     property OnEnter;
1074     property OnExit;
1075     property OnKeyDown;
1076     property OnKeyPress;
1077     property OnKeyUp;
1078     property OnMonthChanged;
1079     property OnMouseDown;
1080     property OnMouseEnter;
1081     property OnMouseLeave;
1082     property OnMouseMove;
1083     property OnMouseUp;
1084     property OnResize;
1085     property OnYearChanged;
1086     property PopupMenu;
1087     property Tabstop;
1088     property Visible;
1089   end;
1090 
1091 
1092   { TTICustomImage }
1093 
1094   TTICustomImage = class(TCustomImage)
1095   private
1096     FLink: TPropertyLink;
1097     procedure SetLink(const AValue: TPropertyLink);
1098   protected
1099     procedure LinkLoadFromProperty(Sender: TObject); virtual;
LinkTestEditornull1100     function LinkTestEditor(const ATestEditor: TPropertyEditor): Boolean;
1101   public
1102     constructor Create(TheOwner: TComponent); override;
1103     destructor Destroy; override;
1104     procedure Loaded; override;
1105     property Link: TPropertyLink read FLink write SetLink;
1106   end;
1107 
1108 
1109   { TTIImage }
1110 
1111   TTIImage = class(TTICustomImage)
1112   published
1113     property Align;
1114     property Anchors;
1115     property AutoSize;
1116     property BorderSpacing;
1117     property Center;
1118     property Constraints;
1119     property Link;
1120     property OnChangeBounds;
1121     property OnClick;
1122     property OnMouseDown;
1123     property OnMouseEnter;
1124     property OnMouseLeave;
1125     property OnMouseMove;
1126     property OnMouseUp;
1127     property OnPaint;
1128     property OnResize;
1129     property Proportional;
1130     property Stretch;
1131     property Transparent;
1132     property Visible;
1133   end;
1134 
1135 
1136   { TTICustomFloatSpinEdit }
1137 
1138   TTICustomFloatSpinEdit = class(TCustomFloatSpinEdit)
1139   private
1140     FLink: TPropertyLink;
1141     FUseRTTIMinMax: boolean;
1142     procedure SetLink(const AValue: TPropertyLink);
1143     procedure SetUseRTTIMinMax(const AValue: boolean);
1144   protected
1145     procedure LinkLoadFromProperty(Sender: TObject); virtual;
1146     procedure LinkSaveToProperty(Sender: TObject); virtual;
1147     procedure LinkEditorChanged(Sender: TObject); virtual;
1148     procedure GetRTTIMinMax; virtual;
1149   public
1150     constructor Create(TheOwner: TComponent); override;
1151     destructor Destroy; override;
1152     procedure Loaded; override;
1153     procedure EditingDone; override;
1154     property Link: TPropertyLink read FLink write SetLink;
1155     property UseRTTIMinMax: boolean read FUseRTTIMinMax write SetUseRTTIMinMax default true;
1156   end;
1157 
1158 
1159   { TTIFloatSpinEdit }
1160 
1161   TTIFloatSpinEdit = class(TTICustomFloatSpinEdit)
1162   published
1163     property Align;
1164     property Anchors;
1165     property BorderSpacing;
1166     property Constraints;
1167     property DecimalPlaces;
1168     property Enabled;
1169     property Increment;
1170     property Link;
1171     property MaxValue;
1172     property MinValue;
1173     property OnChange;
1174     property OnChangeBounds;
1175     property OnClick;
1176     property OnEditingDone;
1177     property OnEnter;
1178     property OnExit;
1179     Property OnKeyDown;
1180     property OnKeyPress;
1181     Property OnKeyUp;
1182     property OnMouseDown;
1183     property OnMouseMove;
1184     property OnMouseUp;
1185     property OnResize;
1186     property ParentShowHint;
1187     property PopupMenu;
1188     property ShowHint;
1189     property TabStop;
1190     property TabOrder;
1191     property UseRTTIMinMax;
1192     property Visible;
1193   end;
1194 
1195 
1196   { TTICustomSpinEdit }
1197 
1198   TTICustomSpinEdit = class(TCustomSpinEdit)
1199   private
1200     FLink: TPropertyLink;
1201     FUseRTTIMinMax: boolean;
1202     procedure SetLink(const AValue: TPropertyLink);
1203     procedure SetUseRTTIMinMax(const AValue: boolean);
1204   protected
1205     procedure LinkLoadFromProperty(Sender: TObject); virtual;
1206     procedure LinkSaveToProperty(Sender: TObject); virtual;
1207     procedure LinkEditorChanged(Sender: TObject); virtual;
1208     procedure GetRTTIMinMax; virtual;
1209   public
1210     constructor Create(TheOwner: TComponent); override;
1211     destructor Destroy; override;
1212     procedure Loaded; override;
1213     procedure EditingDone; override;
1214     property Link: TPropertyLink read FLink write SetLink;
1215     property UseRTTIMinMax: boolean read FUseRTTIMinMax write SetUseRTTIMinMax default true;
1216   end;
1217 
1218 
1219   { TTISpinEdit }
1220 
1221   TTISpinEdit = class(TTICustomSpinEdit)
1222   published
1223     property Align;
1224     property Anchors;
1225     property BorderSpacing;
1226     property Constraints;
1227     property Enabled;
1228     property Increment;
1229     property Link;
1230     property MaxValue;
1231     property MinValue;
1232     property OnChange;
1233     property OnChangeBounds;
1234     property OnClick;
1235     property OnEditingDone;
1236     property OnEnter;
1237     property OnExit;
1238     Property OnKeyDown;
1239     property OnKeyPress;
1240     Property OnKeyUp;
1241     property OnMouseDown;
1242     property OnMouseMove;
1243     property OnMouseUp;
1244     property OnResize;
1245     property ParentShowHint;
1246     property PopupMenu;
1247     property ShowHint;
1248     property TabStop;
1249     property TabOrder;
1250     property UseRTTIMinMax;
1251     property Visible;
1252   end;
1253 
1254 
1255   { TTICustomTrackBar }
1256 
1257   TTICustomTrackBar = class(TCustomTrackBar)
1258   private
1259     FLink: TPropertyLink;
1260     FUseRTTIMinMax: boolean;
1261     procedure SetLink(const AValue: TPropertyLink);
1262     procedure SetUseRTTIMinMax(const AValue: boolean);
1263   protected
1264     procedure LinkLoadFromProperty(Sender: TObject); virtual;
1265     procedure LinkSaveToProperty(Sender: TObject); virtual;
1266     procedure LinkEditorChanged(Sender: TObject); virtual;
1267     procedure GetRTTIMinMax; virtual;
1268   public
1269     constructor Create(TheOwner: TComponent); override;
1270     destructor Destroy; override;
1271     procedure Loaded; override;
1272     procedure EditingDone; override;
1273     property Link: TPropertyLink read FLink write SetLink;
1274     property UseRTTIMinMax: boolean read FUseRTTIMinMax write SetUseRTTIMinMax default true;
1275   end;
1276 
1277 
1278   { TTITrackBar }
1279 
1280   TTITrackBar = class(TTICustomTrackBar)
1281   published
1282     property Align;
1283     property Anchors;
1284     property BorderSpacing;
1285     property Constraints;
1286     property DragCursor;
1287     property DragMode;
1288     property Enabled;
1289     property Frequency;
1290     property Hint;
1291     property LineSize;
1292     property Link;
1293     property Max;
1294     property Min;
1295     property OnChange;
1296     property OnChangeBounds;
1297     property OnClick;
1298     property OnDragDrop;
1299     property OnDragOver;
1300     property OnEditingDone;
1301     property OnEndDrag;
1302     property OnEnter;
1303     property OnExit;
1304     property OnMouseDown;
1305     property OnMouseEnter;
1306     property OnMouseLeave;
1307     property OnMouseMove;
1308     property OnMouseUp;
1309     property OnKeyDown;
1310     property OnKeyPress;
1311     property OnKeyUp;
1312     property OnResize;
1313     property OnStartDrag;
1314     property Orientation;
1315     property PageSize;
1316     property ParentShowHint;
1317     property PopupMenu;
1318     property ScalePos;
1319     property ShowHint;
1320     property TabOrder;
1321     property TabStop;
1322     property TickMarks;
1323     property TickStyle;
1324     property UseRTTIMinMax;
1325     property Visible;
1326   end;
1327 
1328 
1329   { TTICustomProgressBar }
1330 
1331   TTICustomProgressBar = class(TCustomProgressBar)
1332   private
1333     FLink: TPropertyLink;
1334     FUseRTTIMinMax: boolean;
1335     procedure SetLink(const AValue: TPropertyLink);
1336     procedure SetUseRTTIMinMax(const AValue: boolean);
1337   protected
1338     procedure LinkLoadFromProperty(Sender: TObject); virtual;
1339     procedure LinkSaveToProperty(Sender: TObject); virtual;
1340     procedure LinkEditorChanged(Sender: TObject); virtual;
1341     procedure GetRTTIMinMax; virtual;
1342   public
1343     constructor Create(TheOwner: TComponent); override;
1344     destructor Destroy; override;
1345     procedure Loaded; override;
1346     procedure EditingDone; override;
1347     property Link: TPropertyLink read FLink write SetLink;
1348     property UseRTTIMinMax: boolean read FUseRTTIMinMax write SetUseRTTIMinMax default true;
1349   end;
1350 
1351 
1352   { TTIProgressBar }
1353 
1354   TTIProgressBar = class(TTICustomProgressBar)
1355   published
1356     property Align;
1357     property Anchors;
1358     property BarShowText;
1359     property BorderSpacing;
1360     property BorderWidth;
1361     property Constraints;
1362     property DragCursor;
1363     property DragKind;
1364     property DragMode;
1365     property Enabled;
1366     property Hint;
1367     property Link;
1368     property Max;
1369     property Min;
1370     property OnDragDrop;
1371     property OnDragOver;
1372     property OnEditingDone;
1373     property OnEndDrag;
1374     property OnEnter;
1375     property OnExit;
1376     property OnMouseDown;
1377     property OnMouseMove;
1378     property OnMouseUp;
1379     property OnStartDock;
1380     property OnStartDrag;
1381     property Orientation;
1382     property ParentShowHint;
1383     property PopupMenu;
1384     property Position;
1385     property ShowHint;
1386     property Smooth;
1387     property Step;
1388     property TabOrder;
1389     property TabStop;
1390     property UseRTTIMinMax;
1391     property Visible;
1392   end;
1393 
1394 
1395   { TTICustomColorButton }
1396 
1397   TTICustomColorButton = class(TColorButton)
1398   private
1399     FLink: TPropertyLink;
1400     procedure SetLink(const AValue: TPropertyLink);
1401   protected
1402     procedure LinkLoadFromProperty(Sender: TObject); virtual;
1403     procedure LinkSaveToProperty(Sender: TObject); virtual;
LinkTestEditornull1404     function LinkTestEditor(const ATestEditor: TPropertyEditor): Boolean;
1405     procedure ShowColorDialog; override;
1406   public
1407     constructor Create(TheOwner: TComponent); override;
1408     destructor Destroy; override;
1409     procedure Loaded; override;
1410     procedure EditingDone; override;
1411     property Link: TPropertyLink read FLink write SetLink;
1412   end;
1413 
1414 
1415   { TTIColorButton }
1416 
1417   TTIColorButton = class(TTICustomColorButton)
1418   published
1419     property Align;
1420     property Anchors;
1421     property BorderSpacing;
1422     property BorderWidth;
1423     property ButtonColor;
1424     property Hint;
1425     property Link;
1426     property OnChangeBounds;
1427     property OnColorChanged;
1428     property OnMouseDown;
1429     property OnMouseMove;
1430     property OnMouseUp;
1431     property OnPaint;
1432     property OnResize;
1433     property ParentShowHint;
1434     property PopupMenu;
1435     property ShowHint;
1436     property Visible;
1437   end;
1438 
1439 
GetPropertyLinkOfComponentnull1440 function GetPropertyLinkOfComponent(AComponent: TComponent
1441   ): TCustomPropertyLink;
1442 procedure SaveActivePropertyLink(AForm: TCustomForm);
1443 procedure CreateEnumAliasValues(EnumType: PTypeInfo; List: TStrings;
1444   AStringArray: PString);
1445 
1446 procedure Register;
1447 
1448 
1449 implementation
1450 
1451 {$R rttictrls.res}
1452 
1453 uses
1454   ComponentEditors, MaskPropEdit;
1455 
1456 procedure SaveActivePropertyLink(AForm: TCustomForm);
1457 var
1458   CurControl: TWinControl;
1459   Link: TCustomPropertyLink;
1460 begin
1461   CurControl:=AForm.ActiveControl;
1462   if CurControl<>nil then begin
1463     Link:=GetPropertyLinkOfComponent(CurControl);
1464     if Link<>nil then
1465       Link.SaveToProperty;
1466   end;
1467 end;
1468 
1469 procedure CreateEnumAliasValues(EnumType: PTypeInfo; List: TStrings;
1470   AStringArray: PString);
1471 var
1472   AName: String;
1473   AnAliasName: String;
1474   i: LongInt;
1475 begin
1476   List.BeginUpdate;
1477   List.Clear;
1478   //debugln('CreateEnumAliasValues ',EnumType^.Name);
1479   with GetTypeData(EnumType)^ do
1480     for i := MinValue to MaxValue do begin
1481       AName := GetEnumName(EnumType, i);
1482       AnAliasName := AStringArray[i];
1483       //debugln('CreateEnumAliasValues ',AName+'='+AnAliasName);
1484       List.Add(AName+'='+AnAliasName);
1485     end;
1486   List.EndUpdate;
1487 end;
1488 
GetPropertyLinkOfComponentnull1489 function GetPropertyLinkOfComponent(AComponent: TComponent
1490   ): TCustomPropertyLink;
1491 begin
1492   Result:=nil;
1493   if AComponent=nil then exit;
1494   try
1495     Result:=TCustomPropertyLink(GetObjectProp(AComponent,'Link',
1496                                               TCustomPropertyLink));
1497   except
1498     on E: EPropertyError do ;// ignore exception on not found
1499   end;
1500 end;
1501 
1502 procedure Register;
1503 begin
1504   RegisterComponents('RTTI',[TTIEdit,TTIComboBox,TTIButton,TTICheckBox,
1505     TTILabel,TTIGroupBox,TTIRadioGroup,TTICheckGroup,TTICheckListBox,
1506     TTIListBox,TTIMemo,TTICalendar,TTIImage,TTIFloatSpinEdit,TTISpinEdit,
1507     TTITrackBar,TTIProgressBar,TTIMaskEdit,TTIColorButton,TMultiPropertyLink]);
1508 end;
1509 
1510 { TAliasStrings }
1511 
TAliasStrings.IndexOfValuenull1512 function TAliasStrings.IndexOfValue(const AValue: string): integer;
1513 var
1514   S : String;
1515   Start: Integer;
1516 begin
1517   Result:=Count-1;
1518   while (Result>=0) do begin
1519     S:=Strings[Result];
1520     Start:=pos('=',S)+1;
1521     if (Start>0) and (CompareText(AValue,Copy(S,Start,length(S)))=0) then
1522       exit;
1523     dec(Result);
1524   end;
1525 end;
1526 
ValueAtnull1527 function TAliasStrings.ValueAt(Index: integer): string;
1528 var
1529   S: string;
1530   Start: Integer;
1531 begin
1532   S:=Strings[Index];
1533   Start:=pos('=',S)+1;
1534   if (Start>0) then
1535     Result:=Copy(S,Start,length(S))
1536   else
1537     Result:='';
1538 end;
1539 
TAliasStrings.ValueToAliasnull1540 function TAliasStrings.ValueToAlias(const AValue: string): string;
1541 begin
1542   Result:=Values[AValue];
1543   if Result='' then Result:=AValue;
1544 end;
1545 
AliasToValuenull1546 function TAliasStrings.AliasToValue(const Alias: string): string;
1547 var
1548   i: LongInt;
1549 begin
1550   i:=IndexOfValue(Alias);
1551   if i>=0 then
1552     Result:=Names[i]
1553   else
1554     Result:=Alias;
1555 end;
1556 
1557 { TCustomPropertyLink }
1558 
1559 procedure TCustomPropertyLink.SetEditor(const AValue: TPropertyEditor);
1560 begin
1561   if FEditor=AValue then exit;
1562   FEditor:=AValue;
1563   EditorChanged;
1564 end;
1565 
1566 procedure TCustomPropertyLink.SetCollectValues(const AValue: boolean);
1567 begin
1568   if FCollectValues=AValue then exit;
1569   FCollectValues:=AValue;
1570   if FCollectValues then FetchValues;
1571 end;
1572 
1573 procedure TCustomPropertyLink.SetFilter(const AValue: TTypeKinds);
1574 begin
1575   if FFilter=AValue then exit;
1576   FFilter:=AValue;
1577   InvalidateEditor;
1578 end;
1579 
1580 procedure TCustomPropertyLink.SetOptions(
1581   const NewOptions: TPropertyLinkOptions);
1582 var
1583   ChangedOptions: TPropertyLinkOptions;
1584 begin
1585   if FOptions=NewOptions then exit;
1586   ChangedOptions:=(FOptions-NewOptions)+(NewOptions-FOptions);
1587   //debugln('TCustomPropertyLink.SetOptions Old=',dbgs(ploReadOnIdle in FOptions),
1588   //  ' New=',dbgs(ploReadOnIdle in NewOptions),' Changed=',dbgs(ploReadOnIdle in ChangedOptions));
1589   FOptions:=NewOptions;
1590   if (ploReadOnIdle in ChangedOptions) then UpdateIdleHandler;
1591 end;
1592 
1593 procedure TCustomPropertyLink.SetTIElementName(const AValue: string);
1594 begin
1595   if FTIElementName=AValue then exit;
1596   SetObjectAndProperty(TIObject,TIPropertyName,AValue);
1597 end;
1598 
TCustomPropertyLink.GetCanModifynull1599 function TCustomPropertyLink.GetCanModify: boolean;
1600 begin
1601   Result:=(FEditor<>nil) and (not FEditor.IsReadOnly);
1602 end;
1603 
1604 procedure TCustomPropertyLink.SetTIObject(const AValue: TPersistent);
1605 begin
1606   if FTIObject=AValue then exit;
1607   SetObjectAndProperty(AValue,TIPropertyName,TIElementName);
1608 end;
1609 
1610 procedure TCustomPropertyLink.SetTIPropertyName(const AValue: string);
1611 begin
1612   if FTIPropertyName=AValue then exit;
1613   SetObjectAndProperty(TIObject,AValue,TIElementName);
1614 end;
1615 
1616 procedure TCustomPropertyLink.EditorChanged;
1617 begin
1618   if FEditor=nil then begin
1619     FTIObject:=nil;
1620     FTIPropertyName:='';
1621   end else begin
1622     FTIObject:=FEditor.GetComponent(0);
1623     FTIPropertyName:=FEditor.GetName;
1624   end;
1625 end;
1626 
1627 procedure TCustomPropertyLink.InvalidateEditor;
1628 begin
1629   FreeThenNil(FEditor);
1630 end;
1631 
1632 procedure TCustomPropertyLink.SetPropertyEditor(
1633   APropertyEditor: TPropertyEditor);
1634 begin
1635   if FEditor=nil then
1636     FEditor:=APropertyEditor;
1637 end;
1638 
CheckPropInfonull1639 function TCustomPropertyLink.CheckPropInfo(const APropInfo: PPropInfo): boolean;
1640 begin
1641   Result:=CompareText(APropInfo^.Name,FTIPropertyName)=0;
1642 end;
1643 
1644 destructor TCustomPropertyLink.Destroy;
1645 begin
1646   InvalidateEditor;
1647   if (Application<>nil) and FIdleHandlerConnected then
1648     Application.RemoveOnIdleHandler(@OnApplicationIdle);
1649   FreeThenNil(FLinkNotifier);
1650   FreeThenNil(FAliasValues);
1651   FreeThenNil(FHook);
1652   FreeThenNil(FCollectedValues);
1653   inherited Destroy;
1654 end;
1655 
1656 procedure TCustomPropertyLink.Assign(Source: TPersistent);
1657 var
1658   SrcLink: TCustomPropertyLink;
1659 begin
1660   if Source is TCustomPropertyLink then begin
1661     SrcLink:=TCustomPropertyLink(Source);
1662     SetObjectAndProperty(SrcLink.TIObject,SrcLink.TIPropertyName,
1663                          SrcLink.TIElementName);
1664   end else begin
1665     inherited Assign(Source);
1666   end;
1667 end;
1668 
1669 procedure TCustomPropertyLink.SetObjectAndProperty(NewPersistent: TPersistent;
1670   const NewPropertyName: string);
1671 begin
1672   SetObjectAndProperty(NewPersistent,NewPropertyName,'');
1673 end;
1674 
1675 procedure TCustomPropertyLink.SetObjectAndProperty(NewPersistent: TPersistent;
1676   const NewPropertyName, NewElementName: string);
1677 var
1678   AComponent: TComponent;
1679 begin
1680   // Note: checking for IsValidIdent is not needed, because an identifier
1681   // is only needed for streaming. So every string as Name is allowed.
1682   if (NewPersistent<>TIObject) or (NewPropertyName<>TIPropertyName) then begin
1683     FPropertyLoaded:=false;
1684     if (FTIObject is TComponent) then begin
1685       AComponent:=TComponent(FTIObject);
1686       AComponent.RemoveFreeNotification(FLinkNotifier);
1687     end;
1688     FTIObject:=NewPersistent;
1689     if FTIObject is TComponent then begin
1690       AComponent:=TComponent(FTIObject);
1691       if not (csDestroying in AComponent.ComponentState) then
1692         AComponent.FreeNotification(FLinkNotifier)
1693       else
1694         FTIObject:=nil;
1695     end;
1696     FTIPropertyName:=NewPropertyName;
1697   end
1698   else if FTIElementName=NewElementName then begin
1699     // no change
1700     exit;
1701   end;
1702   FTIElementName:=NewElementName;
1703   InvalidateEditor;
1704   LoadFromProperty;
1705 end;
1706 
1707 procedure TCustomPropertyLink.CreateEditor;
1708 var
1709   Selection: TPersistentSelectionList;
1710   OldEditorExisted: Boolean;
1711 begin
1712   if (FEditor<>nil) or (FTIObject=nil) or (FTIPropertyName='') then exit;
1713   FPropertyLoaded:=false;
1714   //debugln('TCustomPropertyLink.CreateEditor A ',FTIObject.ClassName+':'+FTIPropertyName);
1715   OldEditorExisted:=FEditor<>nil;
1716   CreateHook;
1717   Selection := TPersistentSelectionList.Create;
1718   try
1719     Selection.Add(FTIObject);
1720     GetPersistentProperties(Selection,Filter,Hook,@SetPropertyEditor,
1721       @CheckPropInfo,OnTestEditor);
1722   finally
1723     Selection.Free;
1724   end;
1725   //debugln('TCustomPropertyLink.CreateEditor B ',dbgsName(FEditor));
1726   {if FEditor=nil then begin
1727     raise Exception.Create('Unable to create property editor for '
1728                            +FTIObject.ClassName+':'+FTIPropertyName);
1729   end;}
1730 
1731   //debugln('TCustomPropertyLink.CreateEditor C ',FTIObject.ClassName+':'+FTIPropertyName,' ',dbgs(FCollectValues),' ',dbgsName(FEditor));
1732   if CollectValues then FetchValues;
1733   if ((FEditor<>nil) or OldEditorExisted) and Assigned(OnEditorChanged) then
1734     OnEditorChanged(Self);
1735   UpdateIdleHandler;
1736 end;
1737 
1738 procedure TCustomPropertyLink.FetchValues;
1739 begin
1740   FreeThenNil(FCollectedValues);
1741   //debugln('TCustomPropertyLink.FetchValues A ',dbgsName(Editor));
1742   if Editor<>nil then
1743     Editor.GetValues(@GetEditorValues);
1744 end;
1745 
1746 procedure TCustomPropertyLink.CreateHook;
1747 begin
1748   if FHook=nil then FHook:=TPropertyEditorHook.Create(nil);
1749   FHook.LookupRoot:=TIObject;
1750 end;
1751 
1752 procedure TCustomPropertyLink.UpdateIdleHandler;
1753 begin
1754   if (Application<>nil)
1755   and ((ploReadOnIdle in Options)<>FIdleHandlerConnected) then begin
1756     if ploReadOnIdle in Options then begin
1757       FIdleHandlerConnected:=true;
1758       Application.AddOnIdleHandler(@OnApplicationIdle,true);
1759     end else begin
1760       FIdleHandlerConnected:=false;
1761       Application.RemoveOnIdleHandler(@OnApplicationIdle);
1762     end;
1763     //debugln('TCustomPropertyLink.UpdateIdleHandler ploReadOnIdle=',dbgs(ploReadOnIdle in Options));
1764   end;
1765 end;
1766 
1767 procedure TCustomPropertyLink.OnApplicationIdle(Sender: TObject;
1768   var Done: Boolean);
1769 begin
1770   if Sender=nil then ;
1771   if Done then ;
1772   if (ploReadOnIdle in FOptions) then begin
1773     // only update if not editing
1774     // => check for editing
1775     if Assigned(OnTestEditing) then begin
1776       // custom check
1777       if (OnTestEditing(Self)) then exit;
1778     end else begin
1779       // default checks
1780       if (Owner is TWinControl) and (TWinControl(Owner).Focused) then exit;
1781     end;
1782     LoadFromProperty;
1783   end;
1784 end;
1785 
1786 procedure TCustomPropertyLink.Notification(AComponent: TComponent;
1787   Operation: TOperation);
1788 begin
1789   if (Operation=opRemove) then begin
1790     if (AComponent=FTIObject) then
1791       SetObjectAndProperty(nil,FTIPropertyName,TIElementName);
1792   end;
1793 end;
1794 
1795 procedure TCustomPropertyLink.GetEditorValues(const NewValue: string);
1796 begin
1797   if FCollectedValues=nil then FCollectedValues:=TStringList.Create;
1798   FCollectedValues.Add(NewValue);
1799 end;
1800 
1801 constructor TCustomPropertyLink.Create(TheOwner: TComponent);
1802 begin
1803   inherited Create;
1804   FOwner:=TheOwner;
1805   FSaveEnabled:=true;
1806   FFilter:=AllTypeKinds;
1807   FAliasValues:=TAliasStrings.Create;
1808   FLinkNotifier:=TPropertyLinkNotifier.Create(Self);
1809   FOptions:=DefaultLinkOptions;
1810 end;
1811 
1812 procedure TCustomPropertyLink.SaveToProperty;
1813 begin
1814   if Self=nil then exit;
1815   if (not SaveEnabled) then exit;
1816   if (Owner<>nil)
1817   and ([csDesigning,csDestroying,csLoading]*Owner.ComponentState<>[]) then exit;
1818   CreateEditor;
1819   if Assigned(OnSaveToProperty) then OnSaveToProperty(Self);
1820 end;
1821 
1822 procedure TCustomPropertyLink.EditingDone;
1823 begin
1824   if Self=nil then exit;
1825   if (ploAutoSave in Options) and PropertyLoaded then
1826     SaveToProperty;
1827 end;
1828 
1829 procedure TCustomPropertyLink.SetAsText(const NewText: string);
1830 begin
1831   try
1832     if not CheckBeforeWrite then exit;
1833     if (FTIElementName='') then
1834       FEditor.SetValue(AliasValues.AliasToValue(NewText))
1835     else
1836       SetSetElementValue(FTIElementName,CompareText(NewText,'True')=0);
1837     CheckAfterWrite;
1838   except
1839     on E: Exception do DoError(true,E);
1840   end;
1841 end;
1842 
GetAsTextnull1843 function TCustomPropertyLink.GetAsText: string;
1844 begin
1845   Result:='';
1846   try
1847     if (FTIElementName='') then
1848       Result:=AliasValues.ValueToAlias(FEditor.GetVisualValue)
1849     else begin
1850       if GetSetElementValue(FTIElementName) then
1851         Result:='True'
1852       else
1853         Result:='False';
1854     end;
1855   except
1856     on E: Exception do DoError(false,E);
1857   end;
1858 end;
1859 
1860 procedure TCustomPropertyLink.SetAsInt(const NewInt: integer);
1861 begin
1862   try
1863     if not CheckBeforeWrite then exit;
1864     FEditor.SetValue(IntToStr(NewInt));
1865     CheckAfterWrite;
1866   except
1867     on E: Exception do DoError(true,E);
1868   end;
1869 end;
1870 
GetAsIntnull1871 function TCustomPropertyLink.GetAsInt: integer;
1872 begin
1873   Result:=0;
1874   try
1875     Result:=FEditor.GetOrdValue;
1876   except
1877     on E: Exception do DoError(false,E);
1878   end;
1879 end;
1880 
CheckBeforeWritenull1881 function TCustomPropertyLink.CheckBeforeWrite: boolean;
1882 begin
1883   Result:=true;
1884   if Assigned(OnBeforeWrite) then
1885     OnBeforeWrite(Self,Result);
1886 end;
1887 
1888 procedure TCustomPropertyLink.CheckAfterWrite;
1889 begin
1890   if Assigned(OnAfterWrite) then OnAfterWrite(Self);
1891 end;
1892 
1893 procedure TCustomPropertyLink.DoError(Writing: boolean; E: Exception);
1894 var
1895   ACaption: String;
1896   AText: String;
1897 begin
1898   ACaption:='Error';
1899   if Writing then
1900     AText:='Error while writing property'#13+E.Message
1901   else
1902     AText:='Error while reading property'#13+E.Message;
1903   MessageDlg(ACaption,AText,mtError,[mbCancel],0);
1904   if Writing then
1905     LoadFromProperty;
1906 end;
1907 
1908 constructor TCustomPropertyLink.create;
1909 begin
1910   Create(nil);
1911 end;
1912 
1913 procedure TCustomPropertyLink.MapValues(Values, AliasStrings: TStrings;
1914   var MappedValues: TStrings; UseAllExistingAlias, AddValuesWithoutAlias,
1915   IfNoValuesAvailableAddAllAlias: boolean);
1916 var
1917   AValue: string;
1918   MappedValue: string;
1919   i: Integer;
1920 begin
1921   if (Values=nil) or (Values.Count=0) then begin
1922     // no values provided by current property editor
1923     if IfNoValuesAvailableAddAllAlias and (AliasStrings<>nil) then begin
1924       MappedValues:=TStringList.Create;
1925       for i:=0 to AliasStrings.Count-1 do
1926         MappedValues.Add(AliasStrings.Values[AliasStrings.Names[i]]);
1927     end else begin
1928       MappedValues:=nil;
1929     end;
1930   end else if AliasStrings<>nil then begin
1931     // current property editor has provided values
1932     // => map values via AliasStrings
1933     MappedValues:=TStringList.Create;
1934     if UseAllExistingAlias then begin
1935       // add all existing alias
1936       for i:=0 to AliasStrings.Count-1 do begin
1937         AValue:=AliasStrings.Names[i];
1938         MappedValue:=AliasStrings.Values[AValue];
1939         //writeln('TCustomPropertyLink.MapValues MappedValue=',MappedValue,' AValue=',AValue,' ',Values.IndexOf(AValue));
1940         if Values.IndexOf(AValue)>=0 then
1941           MappedValues.Add(MappedValue);
1942       end;
1943       // add all values without alias
1944       if AddValuesWithoutAlias then begin
1945         for i:=0 to Values.Count-1 do begin
1946           AValue:=Values[i];
1947           MappedValue:=AliasStrings.Values[AValue];
1948           if MappedValue='' then
1949             // value has no alias
1950             MappedValues.Add(AValue);
1951         end;
1952       end;
1953     end else begin
1954       // add all values mapped
1955       for i:=0 to Values.Count-1 do begin
1956         AValue:=Values[i];
1957         MappedValue:=AliasStrings.Values[AValue];
1958         if MappedValue<>'' then
1959           // value has alias
1960           AValue:=MappedValue;
1961         MappedValues.Add(AValue);
1962       end;
1963     end;
1964   end else begin
1965     // no alias => simply return a copy of the values
1966     MappedValues:=TStringList.Create;
1967     MappedValues.Assign(Values);
1968   end;
1969 end;
1970 
1971 procedure TCustomPropertyLink.MapCollectedValues(AliasStrings: TStrings;
1972   var MappedValues: TStrings; UseAllExistingAlias, AddValuesWithoutAlias,
1973   IfNoValuesAvailableAddAllAlias: boolean);
1974 begin
1975   MapValues(FCollectedValues,AliasStrings,MappedValues,UseAllExistingAlias,
1976             AddValuesWithoutAlias,IfNoValuesAvailableAddAllAlias);
1977 end;
1978 
1979 procedure TCustomPropertyLink.AssignCollectedAliasValuesTo(DestList: TStrings;
1980   KeepIfNoneCollected: boolean);
1981 var
1982   MappedValues: TStrings;
1983 begin
1984   MappedValues:=nil;
1985   MapCollectedValues(AliasValues,MappedValues,true,true,true);
1986   try
1987     if (MappedValues.Count>0) or (not KeepIfNoneCollected) then
1988       DestList.Assign(MappedValues);
1989   finally
1990     MappedValues.Free;
1991   end;
1992 end;
1993 
HasAliasValuesnull1994 function TCustomPropertyLink.HasAliasValues: boolean;
1995 begin
1996   Result:=(AliasValues<>nil) and (AliasValues.Count>0);
1997 end;
1998 
1999 procedure TCustomPropertyLink.BuildEnumAliasValues(AStringArray: PString);
2000 { Example:
2001 
2002   type
2003     TMyEnum = (enum1,enum2);
2004   const
2005     MyEnumNamesArray: array[TMyEnum] of string = ('Enum1','Enum2');
2006 
2007   MyTIComboBox.Link.BuildEnumAliasValues(@MyEnumNamesArray[TMyEnum(0)]);
2008 }
2009 begin
2010   CreateEditor;
2011   if (Editor=nil) or (not (Editor is TEnumPropertyEditor)) then exit;
2012   CreateEnumAliasValues(Editor.GetPropType,AliasValues,AStringArray);
2013   if Assigned(OnEditorChanged) then
2014     OnEditorChanged(Self);
2015   LoadFromProperty;
2016 end;
2017 
2018 procedure TCustomPropertyLink.AssignSetEnumsAliasTo(DestList: TStrings);
2019 var
2020   Enums: TStringList;
2021   CompData: PTypeInfo;
2022   TypeData: PTypeData;
2023   MappedValues: TStrings;
2024   i: LongInt;
2025 begin
2026   Enums:=nil;
2027   MappedValues:=nil;
2028   try
2029     // retrieve all set enums
2030     if GetSetTypeData(CompData,TypeData) then begin
2031       Enums:=TStringList.Create;
2032       for i := TypeData^.MinValue to TypeData^.MaxValue do
2033         Enums.Add(GetEnumName(CompData,i));
2034       // map values
2035       MapValues(Enums,AliasValues,MappedValues,true,true,true);
2036     end;
2037     // assign values
2038     if MappedValues<>nil then
2039       DestList.Assign(MappedValues)
2040     else
2041       DestList.Clear;
2042   finally
2043     Enums.Free;
2044     MappedValues.Free;
2045   end;
2046 end;
2047 
TCustomPropertyLink.GetSetElementValuenull2048 function TCustomPropertyLink.GetSetElementValue(const AliasName: string
2049   ): boolean;
2050 var
2051   CompData: PTypeInfo;
2052   TypeData: PTypeData;
2053   i: LongInt;
2054   IntegerSet: TIntegerSet;
2055 begin
2056   Result:=false;
2057   if not GetSetTypeData(CompData,TypeData) then exit;
2058   if (CompData=nil) or (TypeData=nil) then ;
2059   i:=GetIndexOfSetElement(AliasName);
2060   if i>=0 then begin
2061     Integer(IntegerSet) := Editor.GetOrdValue;
2062     Result:=byte(i) in IntegerSet;
2063   end;
2064 end;
2065 
2066 procedure TCustomPropertyLink.SetSetElementValue(const AliasName: string;
2067   NewValue: boolean);
2068 var
2069   CompData: PTypeInfo;
2070   TypeData: PTypeData;
2071   i: LongInt;
2072   IntegerSet: TIntegerSet;
2073 begin
2074   if not GetSetTypeData(CompData,TypeData) then exit;
2075   if (CompData=nil) or (TypeData=nil) then ;
2076   i:=GetIndexOfSetElement(AliasName);
2077   if i>=0 then begin
2078     Integer(IntegerSet) := Editor.GetOrdValue;
2079     if NewValue then
2080       Include(IntegerSet,i)
2081     else
2082       Exclude(IntegerSet,i);
2083     Editor.SetOrdValue(Integer(IntegerSet));
2084   end;
2085 end;
2086 
TCustomPropertyLink.GetIndexOfSetElementnull2087 function TCustomPropertyLink.GetIndexOfSetElement(const AliasName: string
2088   ): integer;
2089 var
2090   CompData: PTypeInfo;
2091   TypeData: PTypeData;
2092 begin
2093   if not GetSetTypeData(CompData,TypeData) then exit;
2094   for Result := TypeData^.MinValue to TypeData^.MaxValue do
2095     if CompareText(AliasName,
2096                    AliasValues.ValueToAlias(GetEnumName(CompData,Result)))=0
2097     then
2098       exit;
2099   Result:=-1;
2100 end;
2101 
GetSetTypeDatanull2102 function TCustomPropertyLink.GetSetTypeData(out CompData: PTypeInfo;
2103   out TypeData: PTypeData): boolean;
2104 begin
2105   Result:=false;
2106   CompData:=nil;
2107   TypeData:=nil;
2108   CreateEditor;
2109   if (Editor=nil) or (not (Editor is TSetPropertyEditor)) then exit;
2110   CompData:=GetTypeData(Editor.GetPropType)^.CompType;
2111   TypeData:=GetTypeData(CompData);
2112   Result:=(CompData<>nil) and (TypeData<>nil);
2113 end;
2114 
2115 procedure TCustomPropertyLink.LoadFromProperty;
2116 begin
2117   if Self=nil then exit;
2118   if (Owner<>nil) and (csDestroying in Owner.ComponentState) then exit;
2119   CreateEditor;
2120   FPropertyLoaded:=true;
2121   if Assigned(OnLoadFromProperty) then OnLoadFromProperty(Self);
2122 end;
2123 
2124 { TPropertyLinkPropertyEditor }
2125 
GetAttributesnull2126 function TPropertyLinkPropertyEditor.GetAttributes: TPropertyAttributes;
2127 begin
2128   Result := [paMultiSelect, paSubProperties, paReadOnly];
2129 end;
2130 
2131 { TPropertyNamePropertyEditor }
2132 
2133 procedure TPropertyNamePropertyEditor.GetCompatiblePropEdits(
2134   Prop: TPropertyEditor);
2135 begin
2136   if FPropEdits=nil then FPropEdits:=TList.Create;
2137   FPropEdits.Add(Prop);
2138 end;
2139 
TPropertyNamePropertyEditor.TestEditornull2140 function TPropertyNamePropertyEditor.TestEditor(const Prop: TPropertyEditor
2141   ): boolean;
2142 var
2143   i: Integer;
2144   CurPersistent: TPersistent;
2145   ALink: TCustomPropertyLink;
2146 begin
2147   Result:=false;
2148   for i:=0 to PropCount-1 do begin
2149     CurPersistent:=GetComponent(i);
2150     if (CurPersistent is TCustomPropertyLink) then begin
2151       ALink:=TCustomPropertyLink(CurPersistent);
2152       if Assigned(ALink.OnTestEditor) and (not ALink.OnTestEditor(Prop)) then
2153         exit;
2154     end;
2155   end;
2156   Result:=true;
2157 end;
2158 
GetAttributesnull2159 function TPropertyNamePropertyEditor.GetAttributes: TPropertyAttributes;
2160 begin
2161   Result:=[paMultiSelect,paValueList,paSortList,paRevertable];
2162 end;
2163 
GetEditLimitnull2164 function TPropertyNamePropertyEditor.GetEditLimit: Integer;
2165 begin
2166   Result:=255;
2167 end;
2168 
2169 procedure TPropertyNamePropertyEditor.GetValues(Proc: TGetStringProc);
2170 var
2171   ALink: TCustomPropertyLink;
2172   ASelection: TPersistentSelectionList;
2173   i: Integer;
2174   CurPersistent: TPersistent;
2175   CurTIObject: TPersistent;
2176   Filter: TTypeKinds;
2177 begin
2178   ASelection:=TPersistentSelectionList.Create;
2179   try
2180     // get every TIObject of every TCustomPropertyLink in the selection
2181     Filter:=AllTypeKinds;
2182     for i:=0 to PropCount-1 do begin
2183       CurPersistent:=GetComponent(i);
2184       if (CurPersistent is TCustomPropertyLink) then begin
2185         ALink:=TCustomPropertyLink(CurPersistent);
2186         CurTIObject:=ALink.TIObject;
2187         if CurTIObject<>nil then begin
2188           ASelection.Add(CurTIObject);
2189           Filter:=Filter*ALink.Filter;
2190         end;
2191       end;
2192     end;
2193     if ASelection.Count=0 then exit;
2194     // get properties of TIObjects
2195     GetPersistentProperties(ASelection,Filter,PropertyHook,
2196       @GetCompatiblePropEdits,nil,@TestEditor);
2197     if FPropEdits<>nil then begin
2198       for i:=0 to FPropEdits.Count-1 do
2199         Proc(TPropertyEditor(FPropEdits[i]).GetName);
2200     end;
2201   finally
2202     ASelection.Free;
2203     if FPropEdits<>nil then begin
2204       for i:=0 to FPropEdits.Count-1 do
2205         TPropertyEditor(FPropEdits[i]).Free;
2206       FreeThenNil(FPropEdits);
2207     end;
2208   end;
2209 end;
2210 
2211 { TAliasStringsPropEditorDlg }
2212 
2213 procedure TAliasStringsPropEditorDlg.GetDefaultValuesButtonClick(Sender: TObject);
2214 var
2215   ALink: TCustomPropertyLink;
2216   i: Integer;
2217   CurPersistent: TPersistent;
2218 begin
2219   if Sender=nil then ;
2220   try
2221     // get every TIObject of every TCustomPropertyLink in the selection
2222     FCollectedValues:=TAliasStrings.Create;
2223     FCollectedValues.Text:=Memo.Text;
2224     for i:=0 to Editor.PropCount-1 do begin
2225       CurPersistent:=Editor.GetComponent(i);
2226       if (CurPersistent is TCustomPropertyLink) then begin
2227         ALink:=TCustomPropertyLink(CurPersistent);
2228         ALink.CreateEditor;
2229         if ALink.Editor<>nil then begin
2230           ALink.Editor.GetValues(@AddValue);
2231         end;
2232       end;
2233     end;
2234     Memo.Text:=FCollectedValues.Text;
2235   finally
2236     FreeThenNil(FCollectedValues);
2237   end;
2238 end;
2239 
2240 procedure TAliasStringsPropEditorDlg.AddValue(const s: string);
2241 begin
2242   if FCollectedValues.IndexOfName(s)<0 then
2243     FCollectedValues.Values[s]:=s;
2244 end;
2245 
2246 procedure TAliasStringsPropEditorDlg.AddButtons;
2247 begin
2248   inherited AddButtons;
2249 
2250   GetDefaultValuesButton := TButton.Create(Self);
2251   with GetDefaultValuesButton do Begin
2252     Parent:=SortButton.Parent;
2253     Caption:='Get Defaults';
2254     OnClick:=@GetDefaultValuesButtonClick;
2255     AutoSize:=true;
2256     AnchorToCompanion(akTop, 6, SortButton);
2257   end;
2258 end;
2259 
2260 { TPropLinkAliasPropertyEditor }
2261 
TPropLinkAliasPropertyEditor.CreateDlgnull2262 function TPropLinkAliasPropertyEditor.CreateDlg(s: TStrings
2263   ): TStringsPropEditorDlg;
2264 begin
2265   if s=nil then ;
2266   Result:=TAliasStringsPropEditorDlg.Create(Application);
2267   Result.Editor:=Self;
2268   Result.Memo.Text:=s.Text;
2269 end;
2270 
2271 { TTICustomEdit }
2272 
2273 procedure TTICustomEdit.LinkLoadFromProperty(Sender: TObject);
2274 begin
2275   if Sender=nil then ;
2276   if (FLink.Editor=nil) then exit;
2277   //writeln('TTICustomEdit.LinkLoadFromProperty A ',Name,
2278   //  ' FLink.GetAsText=',FLink.GetAsText,' Text=',Text,
2279   //  ' PropName=',FLink.TIPropertyName);
2280   Text:=FLink.GetAsText;
2281 end;
2282 
2283 procedure TTICustomEdit.LinkSaveToProperty(Sender: TObject);
2284 begin
2285   if Sender=nil then ;
2286   if FLink.Editor=nil then exit;
2287   //writeln('TTICustomEdit.LinkSaveToProperty A ',Name,
2288   //  ' FLink.GetAsText=',FLink.GetAsText,' Text=',Text,
2289   //  ' PropName=',FLink.TIPropertyName);
2290   FLink.SetAsText(Text);
2291 end;
2292 
2293 procedure TTICustomEdit.SetLink(const AValue: TPropertyLink);
2294 begin
2295   if FLink=AValue then exit;
2296   FLink.Assign(AValue);
2297 end;
2298 
2299 constructor TTICustomEdit.Create(TheOwner: TComponent);
2300 begin
2301   inherited Create(TheOwner);
2302   FLink:=TPropertyLink.Create(Self);
2303   FLink.Filter:=[{tkUnknown,}tkInteger,tkChar,tkEnumeration,
2304                  tkFloat,{tkSet,tkMethod,}tkSString,tkLString,tkAString,
2305                  tkWString,tkVariant,{tkArray,tkRecord,tkInterface,}
2306                  {tkClass,tkObject,}tkWChar,tkBool,tkInt64,
2307                  tkQWord{,tkDynArray,tkInterfaceRaw}];
2308   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
2309   FLink.OnSaveToProperty:=@LinkSaveToProperty;
2310 end;
2311 
2312 destructor TTICustomEdit.Destroy;
2313 begin
2314   FreeThenNil(FLink);
2315   inherited Destroy;
2316 end;
2317 
2318 procedure TTICustomEdit.Loaded;
2319 begin
2320   inherited Loaded;
2321   FLink.LoadFromProperty;
2322 end;
2323 
2324 procedure TTICustomEdit.EditingDone;
2325 begin
2326   inherited EditingDone;
2327   FLink.EditingDone;
2328 end;
2329 
2330 { TTICustomComboBox }
2331 
2332 procedure TTICustomComboBox.LinkEditorChanged(Sender: TObject);
2333 begin
2334   if Sender=nil then ;
2335   if Link=nil then exit;
2336   FLink.AssignCollectedAliasValuesTo(Items);
2337 end;
2338 
2339 procedure TTICustomComboBox.GetItems;
2340 var
2341   MaxItemWidth: LongInt;
2342   Cnt: LongInt;
2343   i: Integer;
2344   ItemValue: string;
2345   CurItemWidth: LongInt;
2346 begin
2347   if (Link.Editor<>nil) and (not Link.HasAliasValues) then begin
2348     MaxItemWidth:=Width;
2349     Cnt:=Items.Count;
2350     for i:=0 to Cnt-1 do begin
2351       ItemValue:=Items[i];
2352       CurItemWidth:=Canvas.TextWidth(ItemValue);
2353       Link.Editor.ListMeasureWidth(ItemValue,i,Canvas,CurItemWidth);
2354       if MaxItemWidth<CurItemWidth then
2355         MaxItemWidth:=CurItemWidth;
2356     end;
2357     ItemWidth:=MaxItemWidth;
2358   end;
2359   inherited GetItems;
2360 end;
2361 
2362 procedure TTICustomComboBox.DrawItem(Index: Integer; ARect: TRect;
2363   State: TOwnerDrawState);
2364 var
2365   AState: TPropEditDrawState;
2366   ItemValue: string;
2367 begin
2368   if (Link.Editor=nil) or Link.HasAliasValues then
2369     inherited DrawItem(Index,ARect,State)
2370   else begin
2371     if (Index>=0) and (Index<Items.Count) then
2372       ItemValue:=Items[Index]
2373     else
2374       ItemValue:=Text;
2375 
2376     AState:=[];
2377     if odSelected in State then Include(AState,pedsSelected);
2378     if odFocused in State then Include(AState,pedsFocused);
2379     if odComboBoxEdit in State then
2380       Include(AState,pedsInEdit)
2381     else
2382       Include(AState,pedsInComboList);
2383 
2384     // clear background
2385     with Canvas do begin
2386       Brush.Color:=clWhite;
2387       Pen.Color:=clBlack;
2388       Font.Color:=Pen.Color;
2389       FillRect(ARect);
2390     end;
2391 
2392     Link.Editor.ListDrawValue(ItemValue,Index,Canvas,ARect,AState);
2393 
2394     // custom draw
2395     if Assigned(OnDrawItem) then
2396       OnDrawItem(Self, Index, ARect, State);
2397   end;
2398 end;
2399 
TTICustomComboBox.LinkTestEditingnull2400 function TTICustomComboBox.LinkTestEditing(Sender: TObject): boolean;
2401 begin
2402   if Sender=nil then ;
2403   Result:=Focused or DroppedDown;
2404   //DebugLn(['TTICustomComboBox.LinkTestEditing ',dbgsName(Self),' Result=',Result,' CanTab=',CanTab,' Handle=',HandleAllocated,' ',dbgsname(FindOwnerControl(GetFocus))]);
2405 end;
2406 
2407 procedure TTICustomComboBox.SetLink(const AValue: TPropertyLink);
2408 begin
2409   if FLink=AValue then exit;
2410   FLink.Assign(AValue);
2411 end;
2412 
2413 procedure TTICustomComboBox.SetMaxHistoryCount(const AValue: integer);
2414 begin
2415   if FMaxHistoryCount=AValue then exit;
2416   FMaxHistoryCount:=AValue;
2417 end;
2418 
2419 procedure TTICustomComboBox.LinkLoadFromProperty(Sender: TObject);
2420 begin
2421   if Sender=nil then ;
2422   //writeln('TTICustomComboBox.LinkLoadFromProperty A FLink.GetAsText=',FLink.GetAsText,' Text=',Text);
2423   if (FLink.Editor=nil) then exit;
2424   //debugln('TTICustomComboBox.LinkLoadFromProperty B ',dbgsName(Self),' FLink.Editor=',FLink.Editor.ClassName,' FLink.GetAsText=',FLink.GetAsText);
2425   Text:=FLink.GetAsText;
2426 end;
2427 
2428 procedure TTICustomComboBox.LinkSaveToProperty(Sender: TObject);
2429 var
2430   i: Integer;
2431   s: String;
2432 begin
2433   if Sender=nil then ;
2434   //debugln('TTICustomComboBox.LinkSaveToProperty ',dbgsName(Self),' FLink.GetAsText=',FLink.GetAsText,' Text=',Text);
2435   if (FLink.Editor=nil) then exit;
2436   s:=Text;
2437   FLink.SetAsText(s);
2438 
2439   // update history
2440   if (MaxHistoryCount>0) and ((Items.Count=0) or (Items[0]<>s)) then begin
2441     Items.BeginUpdate;
2442     Items.Insert(0,s);
2443     for i:=Items.Count-1 downto 1 do
2444       if (i>=MaxHistoryCount) or (Items[i]=s)
2445       or ((not HistoryCaseSensitive) and (AnsiCompareText(Items[i],s)=0))
2446       then
2447         Items.Delete(i);
2448     Items.EndUpdate;
2449   end;
2450 end;
2451 
2452 constructor TTICustomComboBox.Create(TheOwner: TComponent);
2453 begin
2454   inherited Create(TheOwner);
2455   FLink:=TPropertyLink.Create(Self);
2456   FLink.Filter:=[{tkUnknown,}tkInteger,tkChar,tkEnumeration,
2457                  tkFloat,{tkSet,}tkMethod,tkSString,tkLString,tkAString,
2458                  tkWString,tkVariant,{tkArray,tkRecord,tkInterface,}
2459                  tkClass,tkObject,tkWChar,tkBool,tkInt64,
2460                  tkQWord{,tkDynArray,tkInterfaceRaw}];
2461   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
2462   FLink.OnSaveToProperty:=@LinkSaveToProperty;
2463   FLink.OnEditorChanged:=@LinkEditorChanged;
2464   FLink.CollectValues:=true;
2465   FLink.OnTestEditing:=@LinkTestEditing;
2466 end;
2467 
2468 destructor TTICustomComboBox.Destroy;
2469 begin
2470   FreeThenNil(FLink);
2471   inherited Destroy;
2472 end;
2473 
2474 procedure TTICustomComboBox.Loaded;
2475 begin
2476   inherited Loaded;
2477   FLink.LoadFromProperty;
2478 end;
2479 
2480 procedure TTICustomComboBox.EditingDone;
2481 begin
2482   inherited EditingDone;
2483   FLink.EditingDone;
2484 end;
2485 
2486 { TTICustomCheckBox }
2487 
2488 procedure TTICustomCheckBox.LinkEditorChanged(Sender: TObject);
2489 begin
2490   if Sender=nil then ;
2491   if (FLink<>nil) and (FLink.Editor<>nil) then begin
2492     if (FLink.Editor is TBoolPropertyEditor)
2493     or (FLink.Editor is TSetPropertyEditor) then begin
2494       FLinkValueFalse:='False';
2495       FLinkValueTrue:='True';
2496     end else if FLink.Editor is TOrdinalPropertyEditor then begin
2497       FLinkValueFalse:='0';
2498       FLinkValueTrue:='-1';
2499     end else begin
2500       FLinkValueFalse:='';
2501       FLinkValueTrue:='True';
2502     end;
2503   end;
2504 end;
2505 
2506 procedure TTICustomCheckBox.SetLink(const AValue: TPropertyLink);
2507 begin
2508   if FLink=AValue then exit;
2509   FLink.Assign(AValue);
2510 end;
2511 
2512 procedure TTICustomCheckBox.SetPropertyNameAsCaption(const AValue: boolean);
2513 begin
2514   if FPropertyNameAsCaption=AValue then exit;
2515   FPropertyNameAsCaption:=AValue;
2516   if FPropertyNameAsCaption and (FLink.Editor<>nil) then
2517     Caption:=FLink.Editor.GetName;
2518 end;
2519 
2520 procedure TTICustomCheckBox.LinkLoadFromProperty(Sender: TObject);
2521 begin
2522   if Sender=nil then ;
2523   if (FLink.Editor=nil) then exit;
2524   Checked:=FLink.GetAsText<>FLinkValueFalse;
2525   if FPropertyNameAsCaption then
2526     Caption:=FLink.Editor.GetName;
2527 end;
2528 
2529 procedure TTICustomCheckBox.LinkSaveToProperty(Sender: TObject);
2530 begin
2531   if Sender=nil then ;
2532   if FLink.Editor=nil then exit;
2533   if Checked then
2534     FLink.SetAsText(FLinkValueTrue)
2535   else
2536     FLink.SetAsText(FLinkValueFalse);
2537 end;
2538 
2539 constructor TTICustomCheckBox.Create(TheOwner: TComponent);
2540 begin
2541   inherited Create(TheOwner);
2542   FLinkValueFalse:='False';
2543   FLinkValueTrue:='True';
2544   FLink:=TPropertyLink.Create(Self);
2545   FLink.Filter:=[{tkUnknown,}tkInteger{,tkChar},tkEnumeration,
2546                  {tkFloat,}tkSet,{tkMethod,}tkSString,tkLString,tkAString,
2547                  tkWString,tkVariant,{tkArray,tkRecord,tkInterface,}
2548                  {tkClass,tkObject,}tkWChar,tkBool,tkInt64,
2549                  tkQWord{,tkDynArray,tkInterfaceRaw}];
2550   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
2551   FLink.OnSaveToProperty:=@LinkSaveToProperty;
2552   FLink.OnEditorChanged:=@LinkEditorChanged;
2553 end;
2554 
2555 destructor TTICustomCheckBox.Destroy;
2556 begin
2557   FreeThenNil(FLink);
2558   inherited Destroy;
2559 end;
2560 
2561 procedure TTICustomCheckBox.Loaded;
2562 begin
2563   inherited Loaded;
2564   FLink.LoadFromProperty;
2565 end;
2566 
2567 procedure TTICustomCheckBox.EditingDone;
2568 begin
2569   inherited EditingDone;
2570   FLink.EditingDone;
2571 end;
2572 
2573 { TTICustomLabel }
2574 
2575 procedure TTICustomLabel.SetLink(const AValue: TPropertyLink);
2576 begin
2577   if FLink=AValue then exit;
2578   FLink.Assign(AValue);
2579 end;
2580 
GetLabelTextnull2581 function TTICustomLabel.GetLabelText: string;
2582 begin
2583   Result := inherited GetLabelText;
2584   if csDesigning in ComponentState then begin
2585     // At design-time show PropertyName or Name in caption,
2586     // otherwise it would stay empty when TIObject is not set.
2587     if Result = '' then begin
2588       Result := FLink.TIPropertyName;      // FLink.GetAsText gives an error
2589       if Result = '' then
2590         Result := Name;
2591     end;
2592   end;
2593 end;
2594 
2595 procedure TTICustomLabel.LinkLoadFromProperty(Sender: TObject);
2596 begin
2597   if Sender=nil then ;
2598   if (FLink.Editor=nil) then exit;
2599   Caption:=FLink.GetAsText;
2600 end;
2601 
2602 constructor TTICustomLabel.Create(TheOwner: TComponent);
2603 begin
2604   inherited Create(TheOwner);
2605   FLink:=TPropertyLink.Create(Self);
2606   FLink.Filter:=[{tkUnknown,}tkInteger,tkChar,tkEnumeration,
2607                  tkFloat,{tkSet,tkMethod,}tkSString,tkLString,tkAString,
2608                  tkWString,tkVariant,{tkArray,tkRecord,tkInterface,}
2609                  {tkClass,tkObject,}tkWChar,tkBool,tkInt64,
2610                  tkQWord{,tkDynArray,tkInterfaceRaw}];
2611   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
2612 end;
2613 
2614 destructor TTICustomLabel.Destroy;
2615 begin
2616   FreeThenNil(FLink);
2617   inherited Destroy;
2618 end;
2619 
2620 procedure TTICustomLabel.Loaded;
2621 begin
2622   inherited Loaded;
2623   FLink.LoadFromProperty;
2624 end;
2625 
2626 { TTICustomGroupbox }
2627 
2628 procedure TTICustomGroupbox.SetLink(const AValue: TPropertyLink);
2629 begin
2630   if FLink=AValue then exit;
2631   FLink.Assign(AValue);
2632 end;
2633 
2634 procedure TTICustomGroupbox.LinkLoadFromProperty(Sender: TObject);
2635 begin
2636   if Sender=nil then ;
2637   if (FLink.Editor=nil) then exit;
2638   Caption:=FLink.GetAsText;
2639 end;
2640 
2641 constructor TTICustomGroupbox.Create(TheOwner: TComponent);
2642 begin
2643   inherited Create(TheOwner);
2644   FLink:=TPropertyLink.Create(Self);
2645   FLink.Filter:=[{tkUnknown,}tkInteger,tkChar,tkEnumeration,
2646                  tkFloat,{tkSet,tkMethod,}tkSString,tkLString,tkAString,
2647                  tkWString,tkVariant,{tkArray,tkRecord,tkInterface,}
2648                  {tkClass,tkObject,}tkWChar,tkBool,tkInt64,
2649                  tkQWord{,tkDynArray,tkInterfaceRaw}];
2650   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
2651 end;
2652 
2653 destructor TTICustomGroupbox.Destroy;
2654 begin
2655   FreeThenNil(FLink);
2656   inherited Destroy;
2657 end;
2658 
2659 procedure TTICustomGroupbox.Loaded;
2660 begin
2661   inherited Loaded;
2662   FLink.LoadFromProperty;
2663 end;
2664 
2665 { TTICustomRadioGroup }
2666 
2667 procedure TTICustomRadioGroup.SetLink(const AValue: TPropertyLink);
2668 begin
2669   if FLink=AValue then exit;
2670   FLink.Assign(AValue);
2671 end;
2672 
2673 procedure TTICustomRadioGroup.LinkLoadFromProperty(Sender: TObject);
2674 begin
2675   if Sender=nil then ;
2676   if (FLink.Editor=nil) then exit;
2677   ItemIndex:=Items.IndexOf(FLink.GetAsText);
2678 end;
2679 
2680 procedure TTICustomRadioGroup.LinkSaveToProperty(Sender: TObject);
2681 begin
2682   if Sender=nil then ;
2683   if (FLink.Editor=nil) then exit;
2684   if ItemIndex>=0 then
2685     FLink.SetAsText(Items[ItemIndex]);
2686 end;
2687 
2688 procedure TTICustomRadioGroup.LinkEditorChanged(Sender: TObject);
2689 begin
2690   if Sender=nil then ;
2691   if Link=nil then exit;
2692   FLink.AssignCollectedAliasValuesTo(Items);
2693 end;
2694 
2695 constructor TTICustomRadioGroup.Create(TheOwner: TComponent);
2696 begin
2697   inherited Create(TheOwner);
2698   FLink:=TPropertyLink.Create(Self);
2699   FLink.Filter:=[{tkUnknown,}tkInteger,{tkChar,}tkEnumeration,
2700                  {tkFloat,tkSet,tkMethod,}tkSString,tkLString,tkAString,
2701                  tkWString,{tkVariant,tkArray,tkRecord,tkInterface,}
2702                  {tkClass,tkObject,tkWChar,}tkBool{,tkInt64,}
2703                  {tkQWord,tkDynArray,tkInterfaceRaw}];
2704   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
2705   FLink.OnSaveToProperty:=@LinkSaveToProperty;
2706   FLink.CollectValues:=true;
2707   FLink.OnEditorChanged:=@LinkEditorChanged;
2708 end;
2709 
2710 destructor TTICustomRadioGroup.Destroy;
2711 begin
2712   FreeThenNil(FLink);
2713   inherited Destroy;
2714 end;
2715 
2716 procedure TTICustomRadioGroup.Loaded;
2717 begin
2718   inherited Loaded;
2719   FLink.LoadFromProperty;
2720 end;
2721 
2722 procedure TTICustomRadioGroup.EditingDone;
2723 begin
2724   inherited EditingDone;
2725   FLink.EditingDone;
2726 end;
2727 
2728 { TTICustomCheckGroup }
2729 
2730 procedure TTICustomCheckGroup.SetLink(const AValue: TPropertyLink);
2731 begin
2732   if FLink=AValue then exit;
2733   FLink.Assign(AValue);
2734 end;
2735 
2736 procedure TTICustomCheckGroup.LinkLoadFromProperty(Sender: TObject);
2737 var
2738   i: Integer;
2739 begin
2740   if Sender=nil then ;
2741   if Link.Editor=nil then exit;
2742   for i:=0 to Items.Count-1 do
2743     Checked[i]:=Link.GetSetElementValue(Items[i]);
2744 end;
2745 
2746 procedure TTICustomCheckGroup.LinkSaveToProperty(Sender: TObject);
2747 var
2748   i: Integer;
2749 begin
2750   if Sender=nil then ;
2751   if Link.Editor=nil then exit;
2752   for i:=0 to Items.Count-1 do
2753     Link.SetSetElementValue(Items[i],Checked[i]);
2754 end;
2755 
2756 procedure TTICustomCheckGroup.LinkEditorChanged(Sender: TObject);
2757 begin
2758   if Sender=nil then ;
2759   if Link=nil then exit;
2760   Link.AssignSetEnumsAliasTo(Items);
2761 end;
2762 
2763 constructor TTICustomCheckGroup.Create(TheOwner: TComponent);
2764 begin
2765   inherited Create(TheOwner);
2766   FLink:=TPropertyLink.Create(Self);
2767   FLink.Filter:=[{tkUnknown,tkInteger,tkChar,tkEnumeration,}
2768                  {tkFloat,}tkSet{,tkMethod,tkSString,tkLString,tkAString,}
2769                  {tkWString,tkVariant,tkArray,tkRecord,tkInterface,}
2770                  {tkClass,tkObject,tkWChar,tkBool,tkInt64,}
2771                  {tkQWord,tkDynArray,tkInterfaceRaw}];
2772   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
2773   FLink.OnSaveToProperty:=@LinkSaveToProperty;
2774   FLink.CollectValues:=true;
2775   FLink.OnEditorChanged:=@LinkEditorChanged;
2776 end;
2777 
2778 destructor TTICustomCheckGroup.Destroy;
2779 begin
2780   FreeThenNil(FLink);
2781   inherited Destroy;
2782 end;
2783 
2784 procedure TTICustomCheckGroup.Loaded;
2785 begin
2786   inherited Loaded;
2787   FLink.LoadFromProperty;
2788 end;
2789 
2790 procedure TTICustomCheckGroup.EditingDone;
2791 begin
2792   inherited EditingDone;
2793   FLink.EditingDone;
2794 end;
2795 
2796 { TTICustomMemo }
2797 
TTICustomMemo.LinkTestEditornull2798 function TTICustomMemo.LinkTestEditor(const ATestEditor: TPropertyEditor
2799   ): Boolean;
2800 begin
2801   Result:=(ATestEditor is TStringPropertyEditor)
2802        or (ATestEditor is TStringsPropertyEditor);
2803 end;
2804 
2805 procedure TTICustomMemo.SetLink(const AValue: TPropertyLink);
2806 begin
2807   if FLink=AValue then exit;
2808   FLink.Assign(AValue);
2809 end;
2810 
2811 procedure TTICustomMemo.LinkLoadFromProperty(Sender: TObject);
2812 var
2813   PropKind: TTypeKind;
2814   CurObject: TObject;
2815 begin
2816   if Sender=nil then ;
2817   if (FLink.Editor=nil) then exit;
2818   PropKind:=FLink.Editor.GetPropType^.Kind;
2819   if PropKind=tkClass then begin
2820     CurObject:=FLink.Editor.GetObjectValue;
2821     if CurObject is TStrings then
2822       Lines.Assign(TStrings(CurObject))
2823     else
2824       Lines.Clear;
2825   end else if PropKind in [tkSString,tkLString,tkAString,tkWString] then begin
2826     Lines.Text:=FLink.GetAsText;
2827   end else
2828     Lines.Clear;
2829 end;
2830 
2831 procedure TTICustomMemo.LinkSaveToProperty(Sender: TObject);
2832 var
2833   PropKind: TTypeKind;
2834   CurObject: TObject;
2835 begin
2836   if Sender=nil then ;
2837   if (FLink.Editor=nil) then exit;
2838   PropKind:=FLink.Editor.GetPropType^.Kind;
2839   if PropKind=tkClass then begin
2840     CurObject:=FLink.Editor.GetObjectValue;
2841     if CurObject is TStrings then
2842       TStrings(CurObject).Assign(Lines);
2843   end else if PropKind in [tkSString,tkLString,tkAString,tkWString] then begin
2844     FLink.SetAsText(Lines.Text);
2845   end;
2846 end;
2847 
2848 constructor TTICustomMemo.Create(TheOwner: TComponent);
2849 begin
2850   inherited Create(TheOwner);
2851   FLink:=TPropertyLink.Create(Self);
2852   FLink.Filter:=[{tkUnknown,tkInteger,tkChar,tkEnumeration,}
2853                  {tkFloat,tkSet,tkMethod,}tkSString,tkLString,tkAString,
2854                  tkWString,{tkVariant,tkArray,tkRecord,tkInterface,}
2855                  tkClass{,tkObject,tkWChar,tkBool,tkInt64,}
2856                  {tkQWord,tkDynArray,tkInterfaceRaw}];
2857   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
2858   FLink.OnSaveToProperty:=@LinkSaveToProperty;
2859   FLink.OnTestEditor:=@LinkTestEditor;
2860 end;
2861 
2862 destructor TTICustomMemo.Destroy;
2863 begin
2864   FreeThenNil(FLink);
2865   inherited Destroy;
2866 end;
2867 
2868 procedure TTICustomMemo.Loaded;
2869 begin
2870   inherited Loaded;
2871   FLink.LoadFromProperty;
2872 end;
2873 
2874 procedure TTICustomMemo.EditingDone;
2875 begin
2876   inherited EditingDone;
2877   FLink.EditingDone;
2878 end;
2879 
2880 { TTICustomCalendar }
2881 
LinkTestEditornull2882 function TTICustomCalendar.LinkTestEditor(const ATestEditor: TPropertyEditor
2883   ): Boolean;
2884 begin
2885   Result:=(ATestEditor is TDatePropertyEditor)
2886        or (ATestEditor is TDateTimePropertyEditor)
2887        or (ATestEditor is TStringPropertyEditor);
2888 end;
2889 
2890 procedure TTICustomCalendar.SetLink(const AValue: TPropertyLink);
2891 begin
2892   if FLink=AValue then exit;
2893   FLink.Assign(AValue);
2894 end;
2895 
2896 procedure TTICustomCalendar.LinkLoadFromProperty(Sender: TObject);
2897 begin
2898   if Sender=nil then ;
2899   if (FLink.Editor=nil) then exit;
2900   try
2901     Date:=FLink.GetAsText;
2902   except
2903     // ignore invalid dates
2904     on E: EInvalidDate do ;
2905   end;
2906 end;
2907 
2908 procedure TTICustomCalendar.LinkSaveToProperty(Sender: TObject);
2909 begin
2910   if Sender=nil then ;
2911   if (FLink.Editor=nil) then exit;
2912   FLink.SetAsText(Date);
2913 end;
2914 
2915 constructor TTICustomCalendar.Create(TheOwner: TComponent);
2916 begin
2917   inherited Create(TheOwner);
2918   FLink:=TPropertyLink.Create(Self);
2919   FLink.Filter:=[{tkUnknown,tkInteger,tkChar,tkEnumeration,}
2920                  tkFloat,{tkSet,tkMethod,}tkSString,tkLString,tkAString,
2921                  tkWString{,tkVariant,tkArray,tkRecord,tkInterface,}
2922                  {tkClass,tkObject,tkWChar,tkBool,tkInt64,}
2923                  {tkQWord,tkDynArray,tkInterfaceRaw}];
2924   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
2925   FLink.OnSaveToProperty:=@LinkSaveToProperty;
2926   FLink.OnTestEditor:=@LinkTestEditor;
2927 end;
2928 
2929 destructor TTICustomCalendar.Destroy;
2930 begin
2931   FreeThenNil(FLink);
2932   inherited Destroy;
2933 end;
2934 
2935 procedure TTICustomCalendar.Loaded;
2936 begin
2937   inherited Loaded;
2938   FLink.LoadFromProperty;
2939 end;
2940 
2941 procedure TTICustomCalendar.EditingDone;
2942 begin
2943   inherited EditingDone;
2944   FLink.EditingDone;
2945 end;
2946 
2947 { TTICustomFloatSpinEdit }
2948 
2949 procedure TTICustomFloatSpinEdit.SetLink(const AValue: TPropertyLink);
2950 begin
2951   if FLink=AValue then exit;
2952   FLink.Assign(AValue);
2953 end;
2954 
2955 procedure TTICustomFloatSpinEdit.SetUseRTTIMinMax(const AValue: boolean);
2956 begin
2957   if FUseRTTIMinMax=AValue then exit;
2958   FUseRTTIMinMax:=AValue;
2959   if UseRTTIMinMax then GetRTTIMinMax;
2960 end;
2961 
2962 procedure TTICustomFloatSpinEdit.LinkLoadFromProperty(Sender: TObject);
2963 begin
2964   if Sender=nil then ;
2965   if (FLink.Editor=nil) then exit;
2966   try
2967     Value:=Single(StrToFloat(FLink.GetAsText));
2968   except
2969   end;
2970 end;
2971 
2972 procedure TTICustomFloatSpinEdit.LinkSaveToProperty(Sender: TObject);
2973 begin
2974   if Sender=nil then ;
2975   if FLink.Editor=nil then exit;
2976   FLink.SetAsText(FloatToStr(Value));
2977 end;
2978 
2979 procedure TTICustomFloatSpinEdit.LinkEditorChanged(Sender: TObject);
2980 var
2981   TypeData: PTypeData;
2982   PropKind: TTypeKind;
2983   OldLinkSaveEnabled: Boolean;
2984   f: Extended;
2985 begin
2986   if Sender=nil then ;
2987   if FLink.Editor=nil then exit;
2988   OldLinkSaveEnabled:=FLink.SaveEnabled;
2989   FLink.SaveEnabled:=false;
2990   try
2991     PropKind:=FLink.Editor.GetPropType^.Kind;
2992     case PropKind of
2993 
2994     tkInteger,tkChar,tkEnumeration,tkWChar:
2995       begin
2996         TypeData:=GetTypeData(FLink.Editor.GetPropType);
2997         MinValue:=TypeData^.MinValue;
2998         MaxValue:=TypeData^.MaxValue;
2999         Increment:=1;
3000         DecimalPlaces:=0;
3001       end;
3002 
3003     tkInt64:
3004       begin
3005         TypeData:=GetTypeData(FLink.Editor.GetPropType);
3006         MinValue:=single(TypeData^.MinInt64Value);
3007         MaxValue:=single(TypeData^.MaxInt64Value);
3008         Increment:=1;
3009         DecimalPlaces:=0;
3010       end;
3011 
3012     tkQWord:
3013       begin
3014         TypeData:=GetTypeData(FLink.Editor.GetPropType);
3015         MinValue:=single(TypeData^.MinQWordValue);
3016         MaxValue:=single(TypeData^.MaxQWordValue);
3017         Increment:=1;
3018         DecimalPlaces:=0;
3019       end;
3020 
3021     else
3022       begin
3023         try
3024           f:=StrToFloat(FLink.GetAsText);
3025         except
3026         end;
3027         if f<MinValue then MinValue:=Single(f);
3028         if f>MaxValue then MaxValue:=Single(f);
3029       end;
3030 
3031     end;
3032   finally
3033     FLink.SaveEnabled:=OldLinkSaveEnabled;
3034   end;
3035 end;
3036 
3037 procedure TTICustomFloatSpinEdit.GetRTTIMinMax;
3038 begin
3039   if UseRTTIMinMax then GetRTTIMinMax;
3040 end;
3041 
3042 constructor TTICustomFloatSpinEdit.Create(TheOwner: TComponent);
3043 begin
3044   inherited Create(TheOwner);
3045   FUseRTTIMinMax:=true;
3046   FLink:=TPropertyLink.Create(Self);
3047   FLink.Filter:=[{tkUnknown,}tkInteger,{tkChar,tkEnumeration,}
3048                  tkFloat,{tkSet,tkMethod,}tkSString,tkLString,tkAString,
3049                  tkWString{,tkVariant,tkArray,tkRecord,tkInterface,}
3050                  {tkClass,tkObject,tkWChar,tkBool},tkInt64,
3051                  tkQWord{,tkDynArray,tkInterfaceRaw}];
3052   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
3053   FLink.OnSaveToProperty:=@LinkSaveToProperty;
3054   FLink.OnEditorChanged:=@LinkEditorChanged;
3055 end;
3056 
3057 destructor TTICustomFloatSpinEdit.Destroy;
3058 begin
3059   FreeThenNil(FLink);
3060   inherited Destroy;
3061 end;
3062 
3063 procedure TTICustomFloatSpinEdit.Loaded;
3064 begin
3065   inherited Loaded;
3066   FLink.LoadFromProperty;
3067 end;
3068 
3069 procedure TTICustomFloatSpinEdit.EditingDone;
3070 begin
3071   inherited EditingDone;
3072   FLink.EditingDone;
3073 end;
3074 
3075 { TTICustomSpinEdit }
3076 
3077 procedure TTICustomSpinEdit.SetLink(const AValue: TPropertyLink);
3078 begin
3079   if FLink=AValue then exit;
3080   FLink.Assign(AValue);
3081 end;
3082 
3083 procedure TTICustomSpinEdit.SetUseRTTIMinMax(const AValue: boolean);
3084 begin
3085   if FUseRTTIMinMax=AValue then exit;
3086   FUseRTTIMinMax:=AValue;
3087   if UseRTTIMinMax then GetRTTIMinMax;
3088 end;
3089 
3090 procedure TTICustomSpinEdit.LinkLoadFromProperty(Sender: TObject);
3091 begin
3092   if Sender=nil then ;
3093   if (FLink.Editor=nil) then exit;
3094   try
3095     Value:=StrToInt(FLink.GetAsText);
3096   except
3097   end;
3098 end;
3099 
3100 procedure TTICustomSpinEdit.LinkSaveToProperty(Sender: TObject);
3101 begin
3102   if Sender=nil then ;
3103   if FLink.Editor=nil then exit;
3104   FLink.SetAsText(IntToStr(Value));
3105 end;
3106 
3107 procedure TTICustomSpinEdit.LinkEditorChanged(Sender: TObject);
3108 var
3109   TypeData: PTypeData;
3110   PropKind: TTypeKind;
3111   OldLinkSaveEnabled: Boolean;
3112   f: integer;
3113 begin
3114   if Sender=nil then ;
3115   if FLink.Editor=nil then exit;
3116   OldLinkSaveEnabled:=FLink.SaveEnabled;
3117   FLink.SaveEnabled:=false;
3118   try
3119     PropKind:=FLink.Editor.GetPropType^.Kind;
3120     case PropKind of
3121 
3122     tkInteger,tkChar,tkEnumeration,tkWChar:
3123       begin
3124         TypeData:=GetTypeData(FLink.Editor.GetPropType);
3125         MinValue:=TypeData^.MinValue;
3126         MaxValue:=TypeData^.MaxValue;
3127         Increment:=1;
3128         DecimalPlaces:=0;
3129       end;
3130 
3131     tkInt64:
3132       begin
3133         TypeData:=GetTypeData(FLink.Editor.GetPropType);
3134         MinValue:=integer(TypeData^.MinInt64Value);
3135         MaxValue:=integer(TypeData^.MaxInt64Value);
3136         Increment:=1;
3137         DecimalPlaces:=0;
3138       end;
3139 
3140     tkQWord:
3141       begin
3142         TypeData:=GetTypeData(FLink.Editor.GetPropType);
3143         MinValue:=integer(TypeData^.MinQWordValue);
3144         MaxValue:=integer(TypeData^.MaxQWordValue);
3145         Increment:=1;
3146         DecimalPlaces:=0;
3147       end;
3148 
3149     else
3150       begin
3151         try
3152           f:=StrToInt(FLink.GetAsText);
3153         except
3154         end;
3155         if f<MinValue then MinValue:=f;
3156         if f>MaxValue then MaxValue:=f;
3157       end;
3158 
3159     end;
3160   finally
3161     FLink.SaveEnabled:=OldLinkSaveEnabled;
3162   end;
3163 end;
3164 
3165 procedure TTICustomSpinEdit.GetRTTIMinMax;
3166 begin
3167   if UseRTTIMinMax then GetRTTIMinMax;
3168 end;
3169 
3170 constructor TTICustomSpinEdit.Create(TheOwner: TComponent);
3171 begin
3172   inherited Create(TheOwner);
3173   FUseRTTIMinMax:=true;
3174   FLink:=TPropertyLink.Create(Self);
3175   FLink.Filter:=[{tkUnknown,}tkInteger,{tkChar,tkEnumeration,}
3176                  tkFloat,{tkSet,tkMethod,}tkSString,tkLString,tkAString,
3177                  tkWString{,tkVariant,tkArray,tkRecord,tkInterface,}
3178                  {tkClass,tkObject,tkWChar,tkBool},tkInt64,
3179                  tkQWord{,tkDynArray,tkInterfaceRaw}];
3180   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
3181   FLink.OnSaveToProperty:=@LinkSaveToProperty;
3182   FLink.OnEditorChanged:=@LinkEditorChanged;
3183 end;
3184 
3185 destructor TTICustomSpinEdit.Destroy;
3186 begin
3187   FreeThenNil(FLink);
3188   inherited Destroy;
3189 end;
3190 
3191 procedure TTICustomSpinEdit.Loaded;
3192 begin
3193   inherited Loaded;
3194   FLink.LoadFromProperty;
3195 end;
3196 
3197 procedure TTICustomSpinEdit.EditingDone;
3198 begin
3199   inherited EditingDone;
3200   FLink.EditingDone;
3201 end;
3202 
3203 { TTICustomImage }
3204 
TTICustomImage.LinkTestEditornull3205 function TTICustomImage.LinkTestEditor(const ATestEditor: TPropertyEditor
3206   ): Boolean;
3207 begin
3208   Result:=(ATestEditor is TGraphicPropertyEditor);
3209 end;
3210 
3211 procedure TTICustomImage.SetLink(const AValue: TPropertyLink);
3212 begin
3213   if FLink=AValue then exit;
3214   FLink.Assign(AValue);
3215 end;
3216 
3217 procedure TTICustomImage.LinkLoadFromProperty(Sender: TObject);
3218 var
3219   AnObject: TObject;
3220 begin
3221   if Sender=nil then ;
3222   if (FLink.Editor=nil) then exit;
3223   if FLink.Editor is TClassPropertyEditor then begin
3224     AnObject:=FLink.Editor.GetObjectValue;
3225     if AnObject is TImage then begin
3226       Picture.Assign(TImage(AnObject).Picture);
3227     end else if AnObject is TPicture then begin
3228       Picture.Assign(TPicture(AnObject));
3229     end else if AnObject is TGraphic then begin
3230       Picture.Assign(TGraphic(AnObject));
3231     end;
3232   end;
3233 end;
3234 
3235 constructor TTICustomImage.Create(TheOwner: TComponent);
3236 begin
3237   inherited Create(TheOwner);
3238   FLink:=TPropertyLink.Create(Self);
3239   FLink.Filter:=[{tkUnknown,tkInteger,tkChar,tkEnumeration,}
3240                  {tkFloat,tkSet,tkMethod,tkSString,tkLString,tkAString,}
3241                  {tkWString,tkVariant,tkArray,tkRecord,tkInterface,}
3242                  tkClass{,tkObject,tkWChar,tkBool,tkInt64,}
3243                  {tkQWord,tkDynArray,tkInterfaceRaw}];
3244   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
3245   FLink.OnTestEditor:=@LinkTestEditor;
3246 end;
3247 
3248 destructor TTICustomImage.Destroy;
3249 begin
3250   FreeThenNil(FLink);
3251   inherited Destroy;
3252 end;
3253 
3254 procedure TTICustomImage.Loaded;
3255 begin
3256   inherited Loaded;
3257   FLink.LoadFromProperty;
3258 end;
3259 
3260 { TTICustomTrackBar }
3261 
3262 procedure TTICustomTrackBar.SetLink(const AValue: TPropertyLink);
3263 begin
3264   if FLink=AValue then exit;
3265   FLink.Assign(AValue);
3266 end;
3267 
3268 procedure TTICustomTrackBar.SetUseRTTIMinMax(const AValue: boolean);
3269 begin
3270   if FUseRTTIMinMax=AValue then exit;
3271   FUseRTTIMinMax:=AValue;
3272   if UseRTTIMinMax then GetRTTIMinMax;
3273 end;
3274 
3275 procedure TTICustomTrackBar.LinkLoadFromProperty(Sender: TObject);
3276 begin
3277   if Sender=nil then ;
3278   if (FLink.Editor=nil) then exit;
3279   try
3280     Position:=StrToInt(FLink.GetAsText);
3281   except
3282   end;
3283 end;
3284 
3285 procedure TTICustomTrackBar.LinkSaveToProperty(Sender: TObject);
3286 begin
3287   if Sender=nil then ;
3288   if (FLink.Editor=nil) then exit;
3289   FLink.SetAsText(IntToStr(Position));
3290 end;
3291 
3292 procedure TTICustomTrackBar.LinkEditorChanged(Sender: TObject);
3293 begin
3294   if Sender=nil then ;
3295   if UseRTTIMinMax then GetRTTIMinMax;
3296 end;
3297 
3298 procedure TTICustomTrackBar.GetRTTIMinMax;
3299 var
3300   TypeData: PTypeData;
3301   PropKind: TTypeKind;
3302   OldLinkSaveEnabled: Boolean;
3303   i: Integer;
3304 begin
3305   if FLink.Editor=nil then exit;
3306   OldLinkSaveEnabled:=FLink.SaveEnabled;
3307   FLink.SaveEnabled:=false;
3308   try
3309     PropKind:=FLink.Editor.GetPropType^.Kind;
3310     case PropKind of
3311 
3312     tkInteger,tkChar,tkEnumeration,tkWChar:
3313       begin
3314         TypeData:=GetTypeData(FLink.Editor.GetPropType);
3315         Min:=TypeData^.MinValue;
3316         Max:=TypeData^.MaxValue;
3317       end;
3318 
3319     else
3320       begin
3321         try
3322           i:=StrToInt(FLink.GetAsText);
3323         except
3324         end;
3325         if i<Min then Min:=i;
3326         if i>Max then Max:=i;
3327       end;
3328 
3329     end;
3330   finally
3331     FLink.SaveEnabled:=OldLinkSaveEnabled;
3332   end;
3333 end;
3334 
3335 constructor TTICustomTrackBar.Create(TheOwner: TComponent);
3336 begin
3337   inherited Create(TheOwner);
3338   FUseRTTIMinMax:=true;
3339   FLink:=TPropertyLink.Create(Self);
3340   FLink.Filter:=[{tkUnknown,}tkInteger,{tkChar,tkEnumeration,}
3341                  tkFloat,{tkSet,tkMethod,}tkSString,tkLString,tkAString,
3342                  tkWString{,tkVariant,tkArray,tkRecord,tkInterface,}
3343                  {tkClass,tkObject,tkWChar,tkBool,tkInt64,}
3344                  {tkQWord,tkDynArray,tkInterfaceRaw}];
3345   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
3346   FLink.OnSaveToProperty:=@LinkSaveToProperty;
3347   FLink.OnEditorChanged:=@LinkEditorChanged;
3348 end;
3349 
3350 destructor TTICustomTrackBar.Destroy;
3351 begin
3352   FreeThenNil(FLink);
3353   inherited Destroy;
3354 end;
3355 
3356 procedure TTICustomTrackBar.Loaded;
3357 begin
3358   inherited Loaded;
3359   FLink.LoadFromProperty;
3360 end;
3361 
3362 procedure TTICustomTrackBar.EditingDone;
3363 begin
3364   inherited EditingDone;
3365   FLink.EditingDone;
3366 end;
3367 
3368 { TTICustomMaskEdit }
3369 
3370 procedure TTICustomMaskEdit.LinkLoadFromProperty(Sender: TObject);
3371 begin
3372   if Sender=nil then ;
3373   if (FLink.Editor=nil) then exit;
3374   Text:=FLink.GetAsText;
3375 end;
3376 
3377 procedure TTICustomMaskEdit.LinkSaveToProperty(Sender: TObject);
3378 begin
3379   if Sender=nil then ;
3380   if FLink.Editor=nil then exit;
3381   FLink.SetAsText(Text);
3382 end;
3383 
3384 procedure TTICustomMaskEdit.SetLink(const AValue: TPropertyLink);
3385 begin
3386   if FLink=AValue then exit;
3387   FLink.Assign(AValue);
3388 end;
3389 
3390 constructor TTICustomMaskEdit.Create(TheOwner: TComponent);
3391 begin
3392   inherited Create(TheOwner);
3393   FLink:=TPropertyLink.Create(Self);
3394   FLink.Filter:=[{tkUnknown,}tkInteger,tkChar,tkEnumeration,
3395                  tkFloat,{tkSet,tkMethod,}tkSString,tkLString,tkAString,
3396                  tkWString,tkVariant,{tkArray,tkRecord,tkInterface,}
3397                  {tkClass,tkObject,}tkWChar,tkBool,tkInt64,
3398                  tkQWord{,tkDynArray,tkInterfaceRaw}];
3399   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
3400   FLink.OnSaveToProperty:=@LinkSaveToProperty;
3401 end;
3402 
3403 destructor TTICustomMaskEdit.Destroy;
3404 begin
3405   FreeThenNil(FLink);
3406   inherited Destroy;
3407 end;
3408 
3409 procedure TTICustomMaskEdit.Loaded;
3410 begin
3411   inherited Loaded;
3412   FLink.LoadFromProperty;
3413 end;
3414 
3415 procedure TTICustomMaskEdit.EditingDone;
3416 begin
3417   inherited EditingDone;
3418   FLink.EditingDone;
3419 end;
3420 
3421 { TTICustomButton }
3422 
TTICustomButton.LinkTestEditornull3423 function TTICustomButton.LinkTestEditor(const ATestEditor: TPropertyEditor
3424   ): Boolean;
3425 begin
3426   Result:=paDialog in ATestEditor.GetAttributes;
3427 end;
3428 
3429 procedure TTICustomButton.SetLink(const AValue: TPropertyLink);
3430 begin
3431   if FLink=AValue then exit;
3432   FLink.Assign(AValue);
3433 end;
3434 
3435 procedure TTICustomButton.Click;
3436 begin
3437   inherited Click;
3438   if Link.Editor<>nil then
3439     Link.Editor.Edit;
3440 end;
3441 
3442 constructor TTICustomButton.Create(TheOwner: TComponent);
3443 begin
3444   inherited Create(TheOwner);
3445   FLink:=TPropertyLink.Create(Self);
3446   FLink.Filter:=AllTypeKinds;
3447   FLink.OnTestEditor:=@LinkTestEditor;
3448 end;
3449 
3450 destructor TTICustomButton.Destroy;
3451 begin
3452   FreeThenNil(FLink);
3453   inherited Destroy;
3454 end;
3455 
3456 { TTICustomCheckListBox }
3457 
3458 procedure TTICustomCheckListBox.SetLink(const AValue: TPropertyLink);
3459 begin
3460   if FLink=AValue then exit;
3461   FLink.Assign(AValue);
3462 end;
3463 
3464 procedure TTICustomCheckListBox.LinkLoadFromProperty(Sender: TObject);
3465 var
3466   i: Integer;
3467 begin
3468   if Sender=nil then ;
3469   if Link.Editor=nil then exit;
3470   for i:=0 to Items.Count-1 do
3471     Checked[i]:=Link.GetSetElementValue(Items[i]);
3472 end;
3473 
3474 procedure TTICustomCheckListBox.LinkSaveToProperty(Sender: TObject);
3475 var
3476   i: Integer;
3477 begin
3478   if Sender=nil then ;
3479   if Link.Editor=nil then exit;
3480   for i:=0 to Items.Count-1 do
3481     Link.SetSetElementValue(Items[i],Checked[i]);
3482 end;
3483 
3484 procedure TTICustomCheckListBox.LinkEditorChanged(Sender: TObject);
3485 begin
3486   if Sender=nil then ;
3487   if Link=nil then exit;
3488   Link.AssignSetEnumsAliasTo(Items);
3489 end;
3490 
3491 constructor TTICustomCheckListBox.Create(TheOwner: TComponent);
3492 begin
3493   inherited Create(TheOwner);
3494   FLink:=TPropertyLink.Create(Self);
3495   FLink.Filter:=[{tkUnknown,tkInteger,tkChar,tkEnumeration,}
3496                  {tkFloat,}tkSet{,tkMethod,tkSString,tkLString,tkAString,}
3497                  {tkWString,tkVariant,tkArray,tkRecord,tkInterface,}
3498                  {tkClass,tkObject,tkWChar,tkBool,tkInt64,}
3499                  {tkQWord,tkDynArray,tkInterfaceRaw}];
3500   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
3501   FLink.OnSaveToProperty:=@LinkSaveToProperty;
3502   FLink.CollectValues:=true;
3503   FLink.OnEditorChanged:=@LinkEditorChanged;
3504 end;
3505 
3506 destructor TTICustomCheckListBox.Destroy;
3507 begin
3508   FreeThenNil(FLink);
3509   inherited Destroy;
3510 end;
3511 
3512 procedure TTICustomCheckListBox.Loaded;
3513 begin
3514   inherited Loaded;
3515   FLink.LoadFromProperty;
3516 end;
3517 
3518 procedure TTICustomCheckListBox.EditingDone;
3519 begin
3520   inherited EditingDone;
3521   FLink.EditingDone;
3522 end;
3523 
3524 { TTICustomListBox }
3525 
3526 procedure TTICustomListBox.SetLink(const AValue: TPropertyLink);
3527 begin
3528   if FLink=AValue then exit;
3529   FLink.Assign(AValue);
3530 end;
3531 
3532 procedure TTICustomListBox.LinkLoadFromProperty(Sender: TObject);
3533 var
3534   i: Integer;
3535 begin
3536   if Sender=nil then ;
3537   if Link.Editor=nil then exit;
3538   if Link.Editor is TSetPropertyEditor then begin
3539     for i:=0 to Items.Count-1 do
3540       Selected[i]:=Link.GetSetElementValue(Items[i]);
3541   end else begin
3542     ItemIndex:=Items.IndexOf(Link.GetAsText);
3543   end;
3544 end;
3545 
3546 procedure TTICustomListBox.LinkSaveToProperty(Sender: TObject);
3547 var
3548   i: Integer;
3549 begin
3550   if Sender=nil then ;
3551   if Link.Editor=nil then exit;
3552   if Link.Editor is TSetPropertyEditor then begin
3553     for i:=0 to Items.Count-1 do
3554       Link.SetSetElementValue(Items[i],Selected[i]);
3555   end else begin
3556     if ItemIndex>=0 then
3557       Link.SetAsText(Items[ItemIndex]);
3558   end;
3559 end;
3560 
3561 procedure TTICustomListBox.LinkEditorChanged(Sender: TObject);
3562 begin
3563   if Sender=nil then ;
3564   if Link=nil then exit;
3565   if Link.Editor is TSetPropertyEditor then begin
3566     MultiSelect:=true;
3567     Link.AssignSetEnumsAliasTo(Items);
3568   end else begin
3569     Link.AssignCollectedAliasValuesTo(Items);
3570   end;
3571 end;
3572 
3573 procedure TTICustomListBox.DrawItem(Index: Integer; ARect: TRect;
3574   State: TOwnerDrawState);
3575 var
3576   AState: TPropEditDrawState;
3577   ItemValue: string;
3578 begin
3579   if (Link.Editor=nil) or Link.HasAliasValues then
3580     inherited DrawItem(Index,ARect,State)
3581   else begin
3582     if (Index>=0) and (Index<Items.Count) then
3583       ItemValue:=Items[Index]
3584     else
3585       ItemValue:=Text;
3586 
3587     AState:=[];
3588     if odSelected in State then Include(AState,pedsSelected);
3589     if odFocused in State then Include(AState,pedsFocused);
3590     Include(AState,pedsInEdit);
3591 
3592     // clear background
3593     with Canvas do begin
3594       if odSelected in State then
3595         Brush.Color:=clLtGray
3596       else
3597         Brush.Color:=clWhite;
3598       Pen.Color:=clBlack;
3599       Font.Color:=Pen.Color;
3600       FillRect(ARect);
3601     end;
3602 
3603     Link.Editor.ListDrawValue(ItemValue,Index,Canvas,ARect,AState);
3604 
3605     // custom draw
3606     if Assigned(OnDrawItem) then
3607       OnDrawItem(Self, Index, ARect, State);
3608   end;
3609 end;
3610 
3611 constructor TTICustomListBox.Create(TheOwner: TComponent);
3612 begin
3613   inherited Create(TheOwner);
3614   FLink:=TPropertyLink.Create(Self);
3615   FLink.Filter:=[tkUnknown,tkInteger,tkChar,tkEnumeration,
3616                  tkFloat,tkSet,tkMethod,tkSString,tkLString,tkAString,
3617                  tkWString,tkVariant,tkArray,tkRecord,tkInterface,
3618                  tkClass,tkObject,tkWChar,tkBool,tkInt64,
3619                  tkQWord,tkDynArray,tkInterfaceRaw];
3620   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
3621   FLink.OnSaveToProperty:=@LinkSaveToProperty;
3622   FLink.CollectValues:=true;
3623   FLink.OnEditorChanged:=@LinkEditorChanged;
3624 end;
3625 
3626 destructor TTICustomListBox.Destroy;
3627 begin
3628   FreeThenNil(FLink);
3629   inherited Destroy;
3630 end;
3631 
3632 procedure TTICustomListBox.Loaded;
3633 begin
3634   inherited Loaded;
3635   FLink.LoadFromProperty;
3636 end;
3637 
3638 procedure TTICustomListBox.EditingDone;
3639 begin
3640   inherited EditingDone;
3641   FLink.EditingDone;
3642 end;
3643 
3644 { TPropertyLinkNotifier }
3645 
3646 procedure TPropertyLinkNotifier.Notification(AComponent: TComponent;
3647   Operation: TOperation);
3648 begin
3649   inherited Notification(AComponent, Operation);
3650   if FLink<>nil then FLink.Notification(AComponent,Operation);
3651 end;
3652 
3653 constructor TPropertyLinkNotifier.Create(TheLink: TCustomPropertyLink);
3654 begin
3655   inherited Create(nil);
3656   FLink:=TheLink;
3657 end;
3658 
3659 { TTICustomColorButton }
3660 
3661 procedure TTICustomColorButton.SetLink(const AValue: TPropertyLink);
3662 begin
3663   if FLink=AValue then exit;
3664   FLink.Assign(AValue);
3665 end;
3666 
3667 procedure TTICustomColorButton.LinkLoadFromProperty(Sender: TObject);
3668 begin
3669   if Sender=nil then ;
3670   if (FLink.Editor=nil) then exit;
3671   ButtonColor:=TColor(FLink.GetAsInt);
3672 end;
3673 
3674 procedure TTICustomColorButton.LinkSaveToProperty(Sender: TObject);
3675 begin
3676   if Sender=nil then ;
3677   if (FLink.Editor=nil) then exit;
3678   FLink.SetAsInt(ButtonColor);
3679 end;
3680 
TTICustomColorButton.LinkTestEditornull3681 function TTICustomColorButton.LinkTestEditor(const ATestEditor: TPropertyEditor
3682   ): Boolean;
3683 begin
3684   Result:=(ATestEditor is TColorPropertyEditor)
3685           and (paDialog in ATestEditor.GetAttributes);
3686 end;
3687 
3688 procedure TTICustomColorButton.ShowColorDialog;
3689 begin
3690   if Link.Editor<>nil then
3691     Link.Editor.Edit;
3692   FLink.LoadFromProperty;
3693 end;
3694 
3695 constructor TTICustomColorButton.Create(TheOwner: TComponent);
3696 begin
3697   inherited Create(TheOwner);
3698   FLink:=TPropertyLink.Create(Self);
3699   FLink.Filter:=[{tkUnknown,}tkInteger{,tkChar,tkEnumeration,
3700                  tkFloat,tkSet,tkMethod,tkSString,tkLString,tkAString,
3701                  tkWString,tkVariant,tkArray,tkRecord,tkInterface,
3702                  tkClass,tkObject,tkWChar,tkBool,tkInt64,
3703                  tkQWord,tkDynArray,tkInterfaceRaw}];
3704   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
3705   FLink.OnSaveToProperty:=@LinkSaveToProperty;
3706   FLink.OnTestEditor:=@LinkTestEditor;
3707 end;
3708 
3709 destructor TTICustomColorButton.Destroy;
3710 begin
3711   FreeThenNil(FLink);
3712   inherited Destroy;
3713 end;
3714 
3715 procedure TTICustomColorButton.Loaded;
3716 begin
3717   inherited Loaded;
3718   FLink.LoadFromProperty;
3719 end;
3720 
3721 procedure TTICustomColorButton.EditingDone;
3722 begin
3723   inherited EditingDone;
3724   FLink.EditingDone;
3725 end;
3726 
3727 { TMultiPropertyLink }
3728 
3729 procedure TMultiPropertyLink.SetTIObject(const AValue: TPersistent);
3730 begin
3731   if FTIObject=AValue then exit;
3732   FTIObject:=AValue;
3733   if Assigned(OnSetTIObject) then OnSetTIObject(Self);
3734   SetLinks;
3735 end;
3736 
3737 procedure TMultiPropertyLink.SetMaintainGrandChilds(const AValue: boolean);
3738 begin
3739   if FMaintainGrandChilds=AValue then exit;
3740   FMaintainGrandChilds:=AValue;
3741   if FMaintainGrandChilds then SetLinks;
3742 end;
3743 
3744 procedure TMultiPropertyLink.SetMaintainSiblings(const AValue: boolean);
3745 begin
3746   if FMaintainSiblings=AValue then exit;
3747   FMaintainSiblings:=AValue;
3748   if FMaintainSiblings then SetLinks;
3749 end;
3750 
3751 procedure TMultiPropertyLink.SetParentControl(const AValue: TWinControl);
3752 begin
3753   if FParentControl=AValue then exit;
3754   FParentControl:=AValue;
3755   if FParentControl<>nil then SetLinks;
3756 end;
3757 
3758 procedure TMultiPropertyLink.SetRootComponent(const AValue: TComponent);
3759 begin
3760   if FRootComponent=AValue then exit;
3761   FRootComponent:=AValue;
3762   if FRootComponent<>nil then SetLinks;
3763 end;
3764 
3765 constructor TMultiPropertyLink.Create(TheOwner: TComponent);
3766 begin
3767   inherited Create(TheOwner);
3768   FMaintainSiblings:=true;
3769 end;
3770 
3771 procedure TMultiPropertyLink.SetLinks;
3772 begin
3773   if [csLoading,csDestroying]*ComponentState<>[] then exit;
3774   if RootComponent<>nil then
3775     SetLinksForChildComponents(RootComponent);
3776   if ParentControl<>nil then
3777     SetLinksForChildControls(ParentControl,MaintainGrandChilds);
3778   if MaintainSiblings and (Owner<>nil) then
3779     SetLinksForChildComponents(Owner);
3780 end;
3781 
3782 procedure TMultiPropertyLink.SetLinksForChildControls(AParent: TWinControl;
3783   WithGrandChilds: boolean);
3784 var
3785   i: Integer;
3786   CurControl: TControl;
3787   CurLink: TCustomPropertyLink;
3788 begin
3789   if AParent<>nil then begin
3790     for i:=0 to AParent.ControlCount-1 do begin
3791       CurControl:=AParent.Controls[i];
3792       CurLink:=GetPropertyLinkOfComponent(CurControl);
3793       if CurLink<>nil then
3794         CurLink.TIObject:=TIObject;
3795       if WithGrandChilds and (CurControl is TWinControl) then
3796         SetLinksForChildControls(TWinControl(CurControl),true);
3797     end;
3798   end;
3799 end;
3800 
3801 procedure TMultiPropertyLink.SetLinksForChildComponents(AComponent: TComponent);
3802 var
3803   i: Integer;
3804   CurComponent: TComponent;
3805   CurLink: TCustomPropertyLink;
3806 begin
3807   if AComponent<>nil then begin
3808     for i:=0 to AComponent.ComponentCount-1 do begin
3809       CurComponent:=AComponent.Components[i];
3810       CurLink:=GetPropertyLinkOfComponent(CurComponent);
3811       if CurLink<>nil then
3812         CurLink.TIObject:=TIObject;
3813     end;
3814   end;
3815 end;
3816 
3817 procedure TMultiPropertyLink.Loaded;
3818 begin
3819   inherited Loaded;
3820   SetLinks;
3821 end;
3822 
3823 { TTIElementNamePropertyEditor }
3824 
3825 procedure TTIElementNamePropertyEditor.GetCompatiblePropEdits(
3826   Prop: TPropertyEditor);
3827 begin
3828   if FPropEdits=nil then FPropEdits:=TList.Create;
3829   FPropEdits.Add(Prop);
3830 end;
3831 
3832 procedure TTIElementNamePropertyEditor.GetElementPropEdits(Prop: TPropertyEditor);
3833 begin
3834   if FElementPropEdits=nil then FElementPropEdits:=TList.Create;
3835   FElementPropEdits.Add(Prop);
3836 end;
3837 
TTIElementNamePropertyEditor.TestEditornull3838 function TTIElementNamePropertyEditor.TestEditor(const Prop: TPropertyEditor
3839   ): boolean;
3840 var
3841   i: Integer;
3842   CurPersistent: TPersistent;
3843   ALink: TCustomPropertyLink;
3844 begin
3845   Result:=false;
3846   for i:=0 to PropCount-1 do begin
3847     CurPersistent:=GetComponent(i);
3848     if (CurPersistent is TCustomPropertyLink) then begin
3849       ALink:=TCustomPropertyLink(CurPersistent);
3850       //debugln('TTIElementNamePropertyEditor.TestEditor ',ALink.TIPropertyName,' ',Prop.GetName);
3851       if (CompareText(ALink.TIPropertyName,Prop.GetName)<>0) then exit;
3852       if Assigned(ALink.OnTestEditor) and (not ALink.OnTestEditor(Prop)) then
3853         exit;
3854       //debugln('TTIElementNamePropertyEditor.TestEditor ok ',ALink.TIPropertyName);
3855     end;
3856   end;
3857   Result:=true;
3858 end;
3859 
GetAttributesnull3860 function TTIElementNamePropertyEditor.GetAttributes: TPropertyAttributes;
3861 begin
3862   Result:=[paMultiSelect,paValueList,paSortList,paRevertable];
3863 end;
3864 
TTIElementNamePropertyEditor.GetEditLimitnull3865 function TTIElementNamePropertyEditor.GetEditLimit: Integer;
3866 begin
3867   Result:=255;
3868 end;
3869 
3870 procedure TTIElementNamePropertyEditor.GetValues(Proc: TGetStringProc);
3871 var
3872   ALink: TCustomPropertyLink;
3873   ASelection: TPersistentSelectionList;
3874   i: Integer;
3875   CurPersistent: TPersistent;
3876   CurTIObject: TPersistent;
3877   Filter: TTypeKinds;
3878   CurPropEdit: TPropertyEditor;
3879   j: Integer;
3880 begin
3881   ASelection:=TPersistentSelectionList.Create;
3882   try
3883     // get every TIObject of every TCustomPropertyLink in the selection
3884     Filter:=AllTypeKinds;
3885     for i:=0 to PropCount-1 do begin
3886       CurPersistent:=GetComponent(i);
3887       if (CurPersistent is TCustomPropertyLink) then begin
3888         ALink:=TCustomPropertyLink(CurPersistent);
3889         CurTIObject:=ALink.TIObject;
3890         if CurTIObject<>nil then begin
3891           ASelection.Add(CurTIObject);
3892           Filter:=Filter*ALink.Filter;
3893         end;
3894       end;
3895     end;
3896     if ASelection.Count=0 then exit;
3897     // get properties of all TIObjects
3898     GetPersistentProperties(ASelection,Filter,PropertyHook,
3899       @GetCompatiblePropEdits,nil,@TestEditor);
3900     if FPropEdits<>nil then begin
3901       // get the possible element values:
3902       for i:=0 to FPropEdits.Count-1 do begin
3903         CurPropEdit:=TPropertyEditor(FPropEdits[i]);
3904         if paValueList in CurPropEdit.GetAttributes then
3905         begin
3906           // get value list
3907           CurPropEdit.GetValues(Proc);
3908           break;
3909         end else if paSubProperties in CurPropEdit.GetAttributes then begin
3910           // get names of sub property editors
3911           CurPropEdit.GetProperties(@GetElementPropEdits);
3912           if FElementPropEdits<>nil then begin
3913             for j:=0 to FElementPropEdits.Count-1 do
3914               Proc(TPropertyEditor(FElementPropEdits[j]).GetName);
3915             break;
3916           end;
3917         end;
3918       end;
3919     end;
3920   finally
3921     ASelection.Free;
3922     if FPropEdits<>nil then begin
3923       for i:=0 to FPropEdits.Count-1 do
3924         TPropertyEditor(FPropEdits[i]).Free;
3925       FreeThenNil(FPropEdits);
3926     end;
3927     if FElementPropEdits<>nil then begin
3928       for i:=0 to FElementPropEdits.Count-1 do
3929         TPropertyEditor(FElementPropEdits[i]).Free;
3930       FreeThenNil(FElementPropEdits);
3931     end;
3932   end;
3933 end;
3934 
3935 { TTICustomProgressBar }
3936 
3937 procedure TTICustomProgressBar.SetLink(const AValue: TPropertyLink);
3938 begin
3939   if FLink=AValue then exit;
3940   FLink.Assign(AValue);
3941 end;
3942 
3943 procedure TTICustomProgressBar.SetUseRTTIMinMax(const AValue: boolean);
3944 begin
3945   if FUseRTTIMinMax=AValue then exit;
3946   FUseRTTIMinMax:=AValue;
3947   if UseRTTIMinMax then GetRTTIMinMax;
3948 end;
3949 
3950 procedure TTICustomProgressBar.LinkLoadFromProperty(Sender: TObject);
3951 begin
3952   if Sender=nil then ;
3953   if (FLink.Editor=nil) then exit;
3954   try
3955     Position:=StrToInt(FLink.GetAsText);
3956   except
3957   end;
3958 end;
3959 
3960 procedure TTICustomProgressBar.LinkSaveToProperty(Sender: TObject);
3961 begin
3962   if Sender=nil then ;
3963   if (FLink.Editor=nil) then exit;
3964   FLink.SetAsText(IntToStr(Position));
3965 end;
3966 
3967 procedure TTICustomProgressBar.LinkEditorChanged(Sender: TObject);
3968 begin
3969   if Sender=nil then ;
3970   if UseRTTIMinMax then GetRTTIMinMax;
3971 end;
3972 
3973 procedure TTICustomProgressBar.GetRTTIMinMax;
3974 var
3975   TypeData: PTypeData;
3976   PropKind: TTypeKind;
3977   OldLinkSaveEnabled: Boolean;
3978   i: Integer;
3979 begin
3980   if FLink.Editor=nil then exit;
3981   OldLinkSaveEnabled:=FLink.SaveEnabled;
3982   FLink.SaveEnabled:=false;
3983   try
3984     PropKind:=FLink.Editor.GetPropType^.Kind;
3985     case PropKind of
3986 
3987     tkInteger,tkChar,tkEnumeration,tkWChar:
3988       begin
3989         TypeData:=GetTypeData(FLink.Editor.GetPropType);
3990         Min:=TypeData^.MinValue;
3991         Max:=TypeData^.MaxValue;
3992       end;
3993 
3994     else
3995       begin
3996         try
3997           i:=StrToInt(FLink.GetAsText);
3998         except
3999         end;
4000         if i<Min then Min:=i;
4001         if i>Max then Max:=i;
4002       end;
4003 
4004     end;
4005   finally
4006     FLink.SaveEnabled:=OldLinkSaveEnabled;
4007   end;
4008 end;
4009 
4010 constructor TTICustomProgressBar.Create(TheOwner: TComponent);
4011 begin
4012   inherited Create(TheOwner);
4013   FUseRTTIMinMax:=true;
4014   FLink:=TPropertyLink.Create(Self);
4015   FLink.Filter:=[{tkUnknown,}tkInteger,{tkChar,tkEnumeration,}
4016                  tkFloat,{tkSet,tkMethod,}tkSString,tkLString,tkAString,
4017                  tkWString{,tkVariant,tkArray,tkRecord,tkInterface,}
4018                  {tkClass,tkObject,tkWChar,tkBool,tkInt64,}
4019                  {tkQWord,tkDynArray,tkInterfaceRaw}];
4020   FLink.OnLoadFromProperty:=@LinkLoadFromProperty;
4021   FLink.OnSaveToProperty:=@LinkSaveToProperty;
4022   FLink.OnEditorChanged:=@LinkEditorChanged;
4023 end;
4024 
4025 destructor TTICustomProgressBar.Destroy;
4026 begin
4027   FreeThenNil(FLink);
4028   inherited Destroy;
4029 end;
4030 
4031 procedure TTICustomProgressBar.Loaded;
4032 begin
4033   inherited Loaded;
4034   FLink.LoadFromProperty;
4035 end;
4036 
4037 procedure TTICustomProgressBar.EditingDone;
4038 begin
4039   inherited EditingDone;
4040   FLink.EditingDone;
4041 end;
4042 
4043 { TPropertyLink }
4044 
4045 procedure TPropertyLink.ReadAliasValuesData(Reader: TReader);
4046 begin
4047   Reader.ReadListBegin;
4048   AliasValues.BeginUpdate;
4049   try
4050     AliasValues.Clear;
4051     while not Reader.EndOfList do
4052       AliasValues.Add(Reader.ReadString);
4053   finally
4054     AliasValues.EndUpdate;
4055   end;
4056   Reader.ReadListEnd;
4057 end;
4058 
4059 procedure TPropertyLink.WriteAliasValuesData(Writer: TWriter);
4060 var
4061   i: Integer;
4062 begin
4063   Writer.WriteListBegin;
4064   for i := 0 to AliasValues.Count - 1 do
4065     Writer.WriteString(AliasValues[i]);
4066   Writer.WriteListEnd;
4067 end;
4068 
4069 procedure TPropertyLink.DefineProperties(Filer: TFiler);
4070 var
4071   HasAliasValuesData: Boolean;
4072   AncestorPropList: TCustomPropertyLink;
4073 begin
4074   inherited DefineProperties(Filer);
4075   HasAliasValuesData := AliasValues.Count > 0;
4076   if Assigned(Filer.Ancestor) then begin
4077     // Only serialize if string list is different from ancestor
4078     if Filer.Ancestor.InheritsFrom(TCustomPropertyLink) then begin
4079       AncestorPropList:=TCustomPropertyLink(Filer.Ancestor);
4080       HasAliasValuesData := not AliasValues.Equals(AncestorPropList.AliasValues);
4081     end;
4082   end;
4083   Filer.DefineProperty('AliasValuesStrings',
4084                @ReadAliasValuesData, @WriteAliasValuesData, HasAliasValuesData);
4085 end;
4086 
4087 initialization
4088   // TPropertyLink
4089   RegisterPropertyEditor(ClassTypeInfo(TPropertyLink),
4090     nil, '', TPropertyLinkPropertyEditor);
4091   // property editor for TCustomPropertyLink.TIObject
4092   RegisterPropertyEditor(ClassTypeInfo(TPersistent),
4093     TCustomPropertyLink, 'TIObject', TTIObjectPropertyEditor);
4094   // property editor for TCustomPropertyLink.TIPropertyName
4095   RegisterPropertyEditor(TypeInfo(string),
4096     TCustomPropertyLink, 'TIPropertyName', TPropertyNamePropertyEditor);
4097   // property editor for TCustomPropertyLink.TIElementName
4098   RegisterPropertyEditor(TypeInfo(string),
4099     TCustomPropertyLink, 'TIElementName', TTIElementNamePropertyEditor);
4100   // property editor for TCustomPropertyLink.AliasValues
4101   RegisterPropertyEditor(ClassTypeInfo(TAliasStrings),
4102     TCustomPropertyLink, 'AliasValues', TPropLinkAliasPropertyEditor);
4103   // property editor for TMultiPropertyLink.TIObject
4104   RegisterPropertyEditor(ClassTypeInfo(TPersistent),
4105     TMultiPropertyLink, 'TIObject', TTIObjectPropertyEditor);
4106   RegisterComponentEditor(TTIMaskEdit, TMaskEditEditor);
4107 end.
4108